organized

Monpar.hs

@@ -0,0 +1,78 @@
+{-# LANGUAGE LambdaCase #-}
+module Monpar where
+
+import qualified Control.Applicative as Ap
+import Control.Applicative ((<|>), Alternative, many, some)
+import Data.Char (isDigit, digitToInt)
+import Control.Monad ( MonadPlus(mzero), void ) 
+import Text.Printf (printf)
+newtype Parser a = Parser {runParser :: String -> [(a, String)]}
+
+instance Functor Parser where
+    fmap f p = Parser $ \inp -> [ (f x,xs) | (x,xs) <- runParser p inp ]
+
+instance Applicative Parser where
+    pure v = Parser $ \inp -> [(v,inp)]
+    d <*> e = d >>= (<$> e)
+
+instance Monad Parser where
+    return = pure
+    p >>= f = Parser $ \inp -> concat [runParser (f v) out | (v,out) <- runParser p inp]
+
+instance Alternative Parser where
+    empty = Parser $ const []
+    p <|> q = Parser $ \inp -> runParser p inp ++ runParser q inp
+    many p = do { x <- p; xs <- many p; return $ x:xs } <|> return []
+    some p = do
+        x <- p
+        xs <- many p
+        return $ x:xs
+
+instance MonadPlus Parser
+
+instance MonadFail Parser where
+    fail _ = mzero
+
+(<++) :: Parser a -> Parser a -> Parser a
+p <++ q = Parser $ \inp -> let r1 = runParser p inp in
+    if null r1 then runParser q inp else r1
+
+get :: Parser Char 
+get = Parser $ \case
+    [] -> [] 
+    x:xs -> [(x,xs)]
+
+
+look :: Parser Char 
+look = Parser $ \case
+    [] -> []
+    x:xs -> [(x,x:xs)]
+
+sat :: (Char -> Bool) -> Parser Char 
+sat p = do
+    c <- get
+    if p c then return c else mzero
+
+char :: Char -> Parser Char
+char c = sat (== c)
+
+string :: String -> Parser String
+string "" = return "" 
+string (x:xs) = do
+    char x
+    string xs
+    return (x:xs)
+
+eof :: Parser () 
+eof = Parser $ \inp -> [((), inp) | null inp]
+
+option :: a -> Parser a -> Parser a
+option x p = p <|> return x
+
+word :: Parser String
+word = neWord <|> return ""
+    where 
+        neWord = do
+            x <- sat (\x -> x /= '\n' && x /= ' ')
+            xs <- word
+            return $ x:xs