{-# LANGUAGE DeriveFunctor #-}

-- |Simple List Parser, used for both line and test parsing.
module Ide.Plugin.Eval.Parse.Parser (
    Parser,
    runParser,
    satisfy,
    alphaNumChar,
    letterChar,
    space,
    string,
    char,
    tillEnd,
) where

import Control.Applicative (Alternative)
import Control.Monad (MonadPlus, (>=>))
import Control.Monad.Combinators (
    empty,
    (<|>),
 )
import Data.Char (
    isAlphaNum,
    isLetter,
 )
import Data.List (isPrefixOf)

type CharParser = Parser Char

{- $setup
 >>> import Control.Monad.Combinators
-}

{- |
>>> runParser  (string "aa" <|> string "bb") "bb"
Right "bb"

>>> runParser  (some (string "aa")) "aaaaaa"
Right ["aa","aa","aa"]
-}
string :: String -> CharParser String
string :: String -> CharParser String
string String
t = (String -> Maybe (String, String)) -> CharParser String
forall t a. ([t] -> Maybe (a, [t])) -> Parser t a
Parser ((String -> Maybe (String, String)) -> CharParser String)
-> (String -> Maybe (String, String)) -> CharParser String
forall a b. (a -> b) -> a -> b
$
    \String
s -> if String
t String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s then (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
t, Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
t) String
s) else Maybe (String, String)
forall a. Maybe a
Nothing

letterChar :: Parser Char Char
letterChar :: Parser Char Char
letterChar = (Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isLetter

alphaNumChar :: Parser Char Char
alphaNumChar :: Parser Char Char
alphaNumChar = (Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isAlphaNum

space :: Parser Char Char
space :: Parser Char Char
space = Char -> Parser Char Char
char Char
' '

{- |
 >>> runParser (some $ char 'a') "aa"
 Right "aa"
-}
char :: Char -> CharParser Char
char :: Char -> Parser Char Char
char Char
ch = (Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
ch)

{- |
>>> runParser tillEnd "abc\ndef"
Right "abc\ndef"
-}
tillEnd :: Parser t [t]
tillEnd :: Parser t [t]
tillEnd = ([t] -> Maybe ([t], [t])) -> Parser t [t]
forall t a. ([t] -> Maybe (a, [t])) -> Parser t a
Parser (([t] -> Maybe ([t], [t])) -> Parser t [t])
-> ([t] -> Maybe ([t], [t])) -> Parser t [t]
forall a b. (a -> b) -> a -> b
$ \[t]
s -> ([t], [t]) -> Maybe ([t], [t])
forall a. a -> Maybe a
Just ([t]
s, [])

satisfy :: (t -> Bool) -> Parser t t
satisfy :: (t -> Bool) -> Parser t t
satisfy t -> Bool
f = ([t] -> Maybe (t, [t])) -> Parser t t
forall t a. ([t] -> Maybe (a, [t])) -> Parser t a
Parser [t] -> Maybe (t, [t])
sel
  where
    sel :: [t] -> Maybe (t, [t])
sel [] = Maybe (t, [t])
forall a. Maybe a
Nothing
    sel (t
t : [t]
ts)
        | t -> Bool
f t
t = (t, [t]) -> Maybe (t, [t])
forall a. a -> Maybe a
Just (t
t, [t]
ts)
        | Bool
otherwise = Maybe (t, [t])
forall a. Maybe a
Nothing

newtype Parser t a = Parser {Parser t a -> [t] -> Maybe (a, [t])
parse :: [t] -> Maybe (a, [t])} deriving (a -> Parser t b -> Parser t a
(a -> b) -> Parser t a -> Parser t b
(forall a b. (a -> b) -> Parser t a -> Parser t b)
-> (forall a b. a -> Parser t b -> Parser t a)
-> Functor (Parser t)
forall a b. a -> Parser t b -> Parser t a
forall a b. (a -> b) -> Parser t a -> Parser t b
forall t a b. a -> Parser t b -> Parser t a
forall t a b. (a -> b) -> Parser t a -> Parser t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Parser t b -> Parser t a
$c<$ :: forall t a b. a -> Parser t b -> Parser t a
fmap :: (a -> b) -> Parser t a -> Parser t b
$cfmap :: forall t a b. (a -> b) -> Parser t a -> Parser t b
Functor)

instance Applicative (Parser t) where
    pure :: a -> Parser t a
pure a
a = ([t] -> Maybe (a, [t])) -> Parser t a
forall t a. ([t] -> Maybe (a, [t])) -> Parser t a
Parser (\[t]
s -> (a, [t]) -> Maybe (a, [t])
forall a. a -> Maybe a
Just (a
a, [t]
s))
    (Parser [t] -> Maybe (a -> b, [t])
p1) <*> :: Parser t (a -> b) -> Parser t a -> Parser t b
<*> (Parser [t] -> Maybe (a, [t])
p2) =
        ([t] -> Maybe (b, [t])) -> Parser t b
forall t a. ([t] -> Maybe (a, [t])) -> Parser t a
Parser ([t] -> Maybe (a -> b, [t])
p1 ([t] -> Maybe (a -> b, [t]))
-> ((a -> b, [t]) -> Maybe (b, [t])) -> [t] -> Maybe (b, [t])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\(a -> b
f, [t]
s1) -> [t] -> Maybe (a, [t])
p2 [t]
s1 Maybe (a, [t]) -> ((a, [t]) -> Maybe (b, [t])) -> Maybe (b, [t])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
a, [t]
s2) -> (b, [t]) -> Maybe (b, [t])
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a, [t]
s2)))

instance Alternative (Parser t) where
    empty :: Parser t a
empty = ([t] -> Maybe (a, [t])) -> Parser t a
forall t a. ([t] -> Maybe (a, [t])) -> Parser t a
Parser (Maybe (a, [t]) -> [t] -> Maybe (a, [t])
forall a b. a -> b -> a
const Maybe (a, [t])
forall a. Maybe a
Nothing)
    Parser t a
p <|> :: Parser t a -> Parser t a -> Parser t a
<|> Parser t a
q = ([t] -> Maybe (a, [t])) -> Parser t a
forall t a. ([t] -> Maybe (a, [t])) -> Parser t a
Parser (([t] -> Maybe (a, [t])) -> Parser t a)
-> ([t] -> Maybe (a, [t])) -> Parser t a
forall a b. (a -> b) -> a -> b
$ \[t]
s -> Parser t a -> [t] -> Maybe (a, [t])
forall t a. Parser t a -> [t] -> Maybe (a, [t])
parse Parser t a
p [t]
s Maybe (a, [t]) -> Maybe (a, [t]) -> Maybe (a, [t])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t a -> [t] -> Maybe (a, [t])
forall t a. Parser t a -> [t] -> Maybe (a, [t])
parse Parser t a
q [t]
s

instance Monad (Parser t) where
    return :: a -> Parser t a
return = a -> Parser t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    >>= :: Parser t a -> (a -> Parser t b) -> Parser t b
(>>=) Parser t a
f a -> Parser t b
g = ([t] -> Maybe (b, [t])) -> Parser t b
forall t a. ([t] -> Maybe (a, [t])) -> Parser t a
Parser (Parser t a -> [t] -> Maybe (a, [t])
forall t a. Parser t a -> [t] -> Maybe (a, [t])
parse Parser t a
f ([t] -> Maybe (a, [t]))
-> ((a, [t]) -> Maybe (b, [t])) -> [t] -> Maybe (b, [t])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\(a
a, [t]
s') -> Parser t b -> [t] -> Maybe (b, [t])
forall t a. Parser t a -> [t] -> Maybe (a, [t])
parse (a -> Parser t b
g a
a) [t]
s'))

instance MonadPlus (Parser t)

runParser :: Show t => Parser t a -> [t] -> Either String a
runParser :: Parser t a -> [t] -> Either String a
runParser Parser t a
m [t]
s = case Parser t a -> [t] -> Maybe (a, [t])
forall t a. Parser t a -> [t] -> Maybe (a, [t])
parse Parser t a
m [t]
s of
    Just (a
res, []) -> a -> Either String a
forall a b. b -> Either a b
Right a
res
    Just (a
_, [t]
ts) ->
        String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Parser did not consume entire stream, left: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [t] -> String
forall a. Show a => a -> String
show [t]
ts
    Maybe (a, [t])
Nothing -> String -> Either String a
forall a b. a -> Either a b
Left String
"No match"