import Control.Monad.Memo
import Data.List

splitX :: Eq a => [a] -> [a] -> [[a]]
splitX xs = go
    where
        go [] = [[]]
        go ys@(y : ys') = case stripPrefix xs ys of
            Just ys'' -> [] : go ys''
            Nothing   -> let (zs : zss) = go ys' in (y : zs) : zss

parse :: String -> ([String], [String])
parse s =
    let (patterns : _ : designs) = lines s
    in  (splitX ", " patterns, takeWhile (not . null) designs)

countPatterns :: (Eq a, Ord a) => [[a]] -> [a] -> Memo [a] Int Int
countPatterns yss = go
    where
        go [] = return 1
        go xs = sum <$> sequence
            [memo go xs' | Just xs' <- map (\ys -> stripPrefix ys xs) yss]

main :: IO ()
main = do
    (patterns, designs) <- parse <$> getContents
    let ns = startEvalMemo $ mapM (countPatterns patterns) designs
    print $ length $ filter (> 0) ns
    print $ sum ns