3-1

1 files changed, 57 insertions, 0 deletions

diff --git a/3-1.hs b/3-1.hs
new file mode 100644
index 0000000..337b4f8
--- /dev/null
+++ b/3-1.hs
@@ -0,0 +1,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