1 files changed, 72 insertions, 0 deletions
diff --git a/src/K/NanoParsec.hs b/src/K/NanoParsec.hs
new file mode 100644
index 0000000..864b79f
--- /dev/null
+++ b/src/K/NanoParsec.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+module K.NanoParsec where
+
+import qualified Data.Text as T
+import Control.Monad (when, MonadPlus(..))
+import Control.Applicative ((<$>), Alternative(..))
+import Control.Lens (_1, (&), (%~))
+
+newtype Parser a = Parser { parse :: T.Text -> [(a, T.Text)] }
+
+runParser :: Parser a -> T.Text -> Either T.Text a
+runParser m t = case parse m t of
+    [(r, t')] -> do
+        when (not (T.null  t')) (consumptionError t')
+        return r
+    _ -> Left "Parser error."
+
+    where consumptionError t =
+              Left ("Parser did not consume input: " `T.append` t)
+
+bind :: Parser a -> (a -> Parser b) -> Parser b
+bind p f = Parser $ \t -> (concat . fmap fp) (parse p t)
+    where fp (x, t') = parse (f x) t'
+
+unit :: a -> Parser a
+unit x = Parser (\t -> [(x, t)])
+
+failure :: Parser a
+failure = Parser (const [])
+
+combine :: Parser a -> Parser a -> Parser a
+combine p q = Parser $ \t -> parse p t ++ parse q t
+
+option :: Parser a -> Parser a -> Parser a
+option p q = Parser $ \t ->
+    case parse p t of
+      [] -> parse q t
+      res -> res
+
+instance Functor Parser where
+    fmap f p = Parser $ \t -> f' <$> parse p t
+        where f' (x, t) = (f x, t)
+
+instance Applicative Parser where
+    pure = unit
+    (Parser p1) <*> (Parser p2) = Parser $ \t ->
+        [(f x, t'') | (f, t') <- p1 t, (x, t'') <- p2 t']
+
+instance Monad Parser where
+    return = unit
+    (>>=) = bind
+
+instance Alternative Parser where
+    empty = mzero
+    (<|>) = option
+
+instance MonadPlus Parser where
+    mzero = failure
+    mplus = combine
+        
+item :: Parser Char
+item = Parser $ \t -> case T.uncons t of
+    Nothing -> []
+    Just (c, t) -> [(c, t)]
+
+satisfy :: (Char -> Bool) -> Parser Char
+satisfy p = do
+  c <- item
+  if p c
+  then unit c
+  else failure