Lambda Parser with long ids, Haskell

Lambda Parser with long ids

--ghc 8.0.2

import Control.Applicative

main = print $ parse parseLe "(lx01.(x10) (ly.y)) (ly.(x) (x))"

newtype Parser a = P (String -> [(a, String)])
parse :: Parser a -> String -> [(a, String)]
parse (P p) inp = p inp

instance Functor Parser where
  -- fmap :: (a -> b) -> Parser a -> Parser b
  fmap g p = P (\inp -> map (\(v,out) -> (g v, out)) (parse p inp))

instance Applicative Parser where
  -- pure :: a -> Parser a
  pure v = P (\inp -> [(v,inp)])
  -- <*> :: Parser (a -> b) -> Parser a -> Parser b
  pg <*> px = P (\inp -> [(f v, sv) | (f, sf) <- parse pg $ inp, (v, sv) <- parse px $ sf])

instance Alternative Parser where
  empty = P (const [])
  px <|> py = P (\s -> (parse px s) ++ (parse py s))

findSuccessParse :: [(a,String)] -> Maybe a
findSuccessParse [] = Nothing
findSuccessParse ((h,t):xs) = if (t == "") then (Just h) else (findSuccessParse xs)

parseString :: String -> Parser a -> Maybe a
parseString s (P p) = (findSuccessParse (p s))

predP :: (Char -> Bool) -> Parser Char
predP p = P f
  where
    f "" = []
    f (c : cs) | p c = [(c, cs)]
               | otherwise = []

predStr :: (String -> Bool) -> Parser String
predStr p = P f
  where
    f "" = []
    f (c : cs) | str /= "" = [(str, suff)]
               | otherwise = []
            where (str, suff) = splitGreedy [] p (c : cs)

splitGreedy :: String -> (String -> Bool) -> String -> (String, String)

splitGreedy pref cond [] | cond pref = (pref, [])
                         | otherwise = ("", "")
splitGreedy pref cond (s:suff) | (cond pref) && q = (pref, s:suff)
                               | otherwise = splitGreedy (pref++[s]) cond suff
                where q = not (cond (pref++[s]))

stringP :: String -> Parser String
stringP s = P f
  where
    f s1 | s == s1 = [(s, "")]
         | otherwise = []

isDigit :: Char -> Bool
isDigit c = ((c >= '0') && (c <= '9'))

digitParser = (predP isDigit)
    
numberParser = (some digitParser)

charP = predP . (==)

data Le = VarExpr String | Lambb String Le | App Le Le deriving (Eq, Show)

parseLe :: Parser Le
parseLe = parseLetter <|> parseLambda <|> parseApp

parseLambda =
  charP 'l' *>
    (Lambb <$> (predStr isId) <*>
                (charP '.' *> parseLe))

parseApp =
  charP '(' *>
    (App <$> parseLe
    <*> (charP ')' *> charP ' '*> charP '('*> 
    parseLe))<* charP ')'

isId (s:str) | (s>='a' && s<='z') && (isNumeric str) = True
           | otherwise = False
isId _ = False

isNumeric "" = True 
isNumeric (c:cs) | (c >= '0') && (c <= '9') = isNumeric cs
               | otherwise = False

parseLetter = VarExpr <$> (predStr isId)

isLet x | (x>='a' && x<='z') = True
        | otherwise = False


run \| edit \| history \| help	0