summaryrefslogtreecommitdiff
path: root/3-1.hs
blob: 337b4f88e37c246d23e5d53a0603c3666f38c54b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
import Data.Bifunctor
import Data.Char

newtype Parser a b = Parser {parse :: a -> Maybe (b,a)}

instance Functor (Parser a) where
  fmap f p = Parser (fmap (first f) . parse p)

instance Monoid a => Applicative (Parser a) where
  pure x = Parser . const . Just $ (x, mempty)
  p <*> q = Parser $ \ x -> let r = parse p x
    in case r of
         Nothing    -> Nothing
         Just (a,b) -> let s = parse q b
           in case s of
                Nothing    -> Nothing
                Just (c,d) -> Just (a c, d)

string :: String -> Parser String String
string s = Parser $ \ r -> if take (length s) r == s
                           then Just (s, drop (length s) r)
                           else Nothing

while :: (a -> Bool) -> Parser [a] [a]
while p = Parser $ \ xs -> case while' xs of
                             ([], _) -> Nothing
                             a -> Just a
  where
    while' [] = ([], [])
    while' (x:xs) | p x = first (x:) (while' xs)
                  | otherwise = ([], x:xs)


number :: Parser String Integer
number = read <$> while isDigit

scan :: Parser [a] b -> [a] -> [b]
scan _ [] = []
scan p s@(_:xs) = case parse p s of
  Nothing    -> scan p xs
  Just (a,b) -> a : scan p b

instruction :: Parser String (Integer, Integer)
instruction = (,)
  <$  string "mul("
  <*> number
  <*  string ","
  <*> number
  <*  string ")"

result :: String -> Integer
result = sum . map (uncurry (*)) . scan instruction

main :: IO ()
main = do
  s <- getContents
  print $ result s