type Rx = (String, [Int])
type Memo = M.Map Rx Int


countRecursive :: (Memo, Int) -> Rx -> (Memo, Int)
countRecursive (m, i) rx = putInMap . countCorrect m $ rx
  where
   putInMap (m, i) = (Map.insert rx i m, i)

countCorrect :: Memo -> Rx -> (Memo, Int)
countCorrect m rx
  | M.member rx m                   = (m, m M.! rx)
countCorrect m    ([],        [])   = (m, 1)
countCorrect m    ([],         _)   = (m, 0)
countCorrect m rx@(s,         [])   = if noHashs s then (m, 1) else (m, 0)
countCorrect m rx@(('#':s), (x:xs)) = if noDots (x-1) s && noHashAtPos (x-1) s then countRecursive m ((drop x s), xs) else (m, 0)
countCorrect m rx@(('.':s),   xs)   = countCorrect m (s, xs)
countCorrect m rx@(('?':s),   xs)   = mergeResults (countRecursive m (s, xs)) (countRecursive m (('#':s), xs))
  where
    mergeResults (m1, i1) (m2, i2) = (Map.union m1 m2, i1 + i2)