module Internal.Quasi.Operator.Parser where

import Internal.Quasi.Parser
import Language.Haskell.TH.Syntax

definition :: Parser ([Pat], [Exp])
definition :: Parser ([Pat], [Exp])
definition = do
  [Pat]
params <- ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String () Identity ()
-> ParsecT String () Identity [Pat]
-> ParsecT String () Identity [Pat]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity [Pat]
parameters ParsecT String () Identity [Pat]
-> ParsecT String () Identity ()
-> ParsecT String () Identity [Pat]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "=>"
  [Exp]
lams <- ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String () Identity ()
-> ParsecT String () Identity [Exp]
-> ParsecT String () Identity [Exp]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity [Exp]
lambdas ParsecT String () Identity [Exp]
-> ParsecT String () Identity ()
-> ParsecT String () Identity [Exp]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  ([Pat], [Exp]) -> Parser ([Pat], [Exp])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Pat]
params, [Exp]
lams)

lambdas :: Parser [Exp]
lambdas :: ParsecT String () Identity [Exp]
lambdas = do
  Exp
result <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String () Identity String
-> (String -> ParsecT String () Identity Exp)
-> ParsecT String () Identity Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT String () Identity Exp
expr
  case Exp
result of
    TupE elems :: [Exp]
elems -> [Exp] -> ParsecT String () Identity [Exp]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Exp]
elems
    otherwise :: Exp
otherwise -> String -> ParsecT String () Identity [Exp]
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail (String -> ParsecT String () Identity [Exp])
-> String -> ParsecT String () Identity [Exp]
forall a b. (a -> b) -> a -> b
$ Exp -> String
forall a. Show a => a -> String
show Exp
otherwise

parameters :: Parser [Pat]
parameters :: ParsecT String () Identity [Pat]
parameters = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '(' ParsecT String () Identity Char
-> ParsecT String () Identity [Pat]
-> ParsecT String () Identity [Pat]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity [Pat]
inner ParsecT String () Identity [Pat]
-> ParsecT String () Identity Char
-> ParsecT String () Identity [Pat]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ')'
  where
    inner :: ParsecT String () Identity [Pat]
inner = (String -> Pat) -> [String] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Pat
VarP (Name -> Pat) -> (String -> Name) -> String -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName) ([String] -> [Pat])
-> ParsecT String () Identity [String]
-> ParsecT String () Identity [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
var ParsecT String () Identity String
-> ParsecT String () Identity ()
-> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` (ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String () Identity ()
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ',' ParsecT String () Identity Char
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)