3-2

1 files changed, 69 insertions, 0 deletions

diff --git a/3-2.hs b/3-2.hs
new file mode 100644
index 0000000..877fc98
--- /dev/null
+++ b/3-2.hs
@@ -0,0 +1,69 @@
+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
+
+exclude :: String -> String -> String -> String
+exclude _ _ [] = []
+exclude from to s@(x:xs) = case parse (string from) s of
+  Nothing -> x : exclude from to xs
+  Just (_,b) -> exclude' from to b
+
+exclude' :: String -> String -> String -> String
+exclude' _ _ [] = []
+exclude' from to s@(_:xs) = case parse (string to) s of
+  Nothing -> exclude' from to xs
+  Just (_,b) -> exclude from to 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
+  let s' = exclude "don't()" "do()" s
+  print $ result s'