module Parsers.Haskell.FnDef where

import Lexers.Haskell.Layout     (lexeme)
import Parsers.Haskell.Common    (literal, nonTokenQVar, qCtor, qCtorOp, qVar,
                                  qVarOp, token, var, varOp)
import Parsers.Haskell.Pattern   (pattern')
import Parsers.Haskell.Type      (type')
import SyntaxTrees.Haskell.FnDef (Associativity (LAssoc, RAssoc),
                                  CaseBinding (..), DoStep (..), FnBody (..),
                                  FnDef (FnDef), FnDefOrSig (..), FnOp (..),
                                  FnSig (..), FnVar (..), Guard (..),
                                  GuardedFnBody (..),
                                  InfixFnAnnotation (InfixFnAnnotation),
                                  MaybeGuardedFnBody (..), PatternGuard (..))

import Bookhound.Parser              (Parser, andThen, check, withError)
import Bookhound.ParserCombinators   (IsMatch (is), someSepBy, (->>-), (<|>),
                                      (|*), (|+), (|?))
import Bookhound.Parsers.Char        (comma, dot)
import Bookhound.Parsers.Collections (listOf, tupleOf)
import Bookhound.Parsers.Number      (int)
import Bookhound.Parsers.String      (spacing, string, withinCurlyBrackets,
                                      withinParens, withinSquareBrackets)

import Data.Foldable (Foldable (fold))
import Data.Maybe    (maybeToList)
import Utils.String  (wrapCurly)


fnSig :: Parser FnSig
fnSig :: Parser FnSig
fnSig = forall a. String -> Parser a -> Parser a
withError String
"Function signature" forall a b. (a -> b) -> a -> b
$
  Var -> Type -> FnSig
FnSig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Var
var forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. IsMatch a => a -> Parser a
is String
"::")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Type
type'


fnDef :: Parser FnDef
fnDef :: Parser FnDef
fnDef = forall a. String -> Parser a -> Parser a
withError String
"Function definition" forall a b. (a -> b) -> a -> b
$
  [Var] -> [Pattern] -> MaybeGuardedFnBody -> FnDef
FnDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Parser a -> Parser [a]
tupleOf Parser Var
var forall a. Parser a -> Parser a -> Parser a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Var
var)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Pattern
pattern' |*)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser MaybeGuardedFnBody
maybeGuardedFnBody (forall a. IsMatch a => a -> Parser a
is String
"=")


infixAnnotation :: Parser InfixFnAnnotation
infixAnnotation :: Parser InfixFnAnnotation
infixAnnotation = forall a. String -> Parser a -> Parser a
withError String
"Infix annotation" forall a b. (a -> b) -> a -> b
$
  Associativity -> Integer -> VarOp -> InfixFnAnnotation
InfixFnAnnotation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
token (Associativity
LAssoc forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. IsMatch a => a -> Parser a
is String
"infixl" forall a. Parser a -> Parser a -> Parser a
<|>
                               Associativity
RAssoc forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. IsMatch a => a -> Parser a
is String
"infixr")
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser a
token Parser Integer
int
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VarOp
varOp


fnDefOrSig :: Parser FnDefOrSig
fnDefOrSig :: Parser FnDefOrSig
fnDefOrSig =  FnDef -> FnDefOrSig
Def forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FnDef
fnDef forall a. Parser a -> Parser a -> Parser a
<|>
              FnSig -> FnDefOrSig
Sig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FnSig
fnSig

fnBody :: Parser FnBody
fnBody :: Parser FnBody
fnBody = Parser FnBody
topLevelFnApply forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
openForm

  where
    topLevelFnApply :: Parser FnBody
topLevelFnApply = FnBody -> [FnBody] -> FnBody
FnApply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FnBody
delimitedForm
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FnBody
lambdaExpr)

    fnApply :: Parser FnBody
fnApply = FnBody -> [FnBody] -> FnBody
FnApply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FnBody
delimitedForm
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser FnBody
delimitedForm |+)

    infixFnApply :: Parser FnBody
infixFnApply = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [FnOp] -> [FnBody] -> FnBody
InfixFnApply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall a b. Parser a -> Parser b -> Parser ([a], [b])
sepByOps Parser FnOp
fnOp (Parser FnBody
infixArgForm forall a. Parser a -> Parser a -> Parser a
<|> forall a. Parser a -> Parser a
withinParens Parser FnBody
typeAnnotation)

    leftOpSection :: Parser FnBody
leftOpSection = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FnOp -> FnBody -> FnBody
LeftOpSection
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
withinParens ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FnOp
fnOp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FnBody
openForm)

    rightOpSection :: Parser FnBody
rightOpSection = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FnBody -> FnOp -> FnBody
RightOpSection
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
withinParens ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FnBody
openForm forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FnOp
fnOp)

    opSection :: Parser FnBody
opSection = Parser FnBody
leftOpSection forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
rightOpSection


    lambdaExpr :: Parser FnBody
lambdaExpr = [Pattern] -> FnBody -> FnBody
LambdaExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Pattern
pattern' |*))
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. IsMatch a => a -> Parser a
is String
"->" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser FnBody
openForm)

    letExpr :: Parser FnBody
letExpr = [FnDefOrSig] -> FnBody -> FnBody
LetExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"let" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> Parser [a]
withinContext Parser FnDefOrSig
fnDefOrSig)
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. IsMatch a => a -> Parser a
is String
"in"  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser FnBody
openForm)

    whereExpr :: Parser FnBody
whereExpr = FnBody -> [FnDefOrSig] -> FnBody
WhereExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
withinCurlyBrackets Parser FnBody
openForm forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. IsMatch a => a -> Parser a
is String
"where"
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser [a]
withinContext Parser FnDefOrSig
fnDefOrSig

    ifExpr :: Parser FnBody
ifExpr = FnBody -> FnBody -> FnBody -> FnBody
IfExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"if"   forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser FnBody
openForm)
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. IsMatch a => a -> Parser a
is String
"then" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser FnBody
openForm)
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. IsMatch a => a -> Parser a
is String
"else" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser FnBody
openForm)

    multiWayIfExpr :: Parser FnBody
multiWayIfExpr = [GuardedFnBody] -> FnBody
MultiWayIfExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (forall a. IsMatch a => a -> Parser a
is String
"if" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall a. Parser a -> Parser [a]
withinContext forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Parser GuardedFnBody
guardedFnBody forall a b. (a -> b) -> a -> b
$ forall a. IsMatch a => a -> Parser a
is String
"->"))

    doExpr :: Parser FnBody
doExpr = [DoStep] -> FnBody
DoExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"do" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> Parser [a]
withinContext Parser DoStep
doStep)

    caseOfExpr :: Parser FnBody
caseOfExpr = FnBody -> [CaseBinding] -> FnBody
CaseOfExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"case" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser FnBody
openForm forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. IsMatch a => a -> Parser a
is String
"of")
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser [a]
withinContext Parser CaseBinding
caseBinding

    lambdaCaseExpr :: Parser FnBody
lambdaCaseExpr = [CaseBinding] -> FnBody
LambdaCaseExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"\\case" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> Parser [a]
withinContext Parser CaseBinding
caseBinding)

    listRange :: Parser FnBody
listRange = forall a. Parser a -> Parser a
withinSquareBrackets forall a b. (a -> b) -> a -> b
$
      FnBody -> Maybe FnBody -> FnBody
ListRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser FnBody
openForm forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. IsMatch a => a -> Parser a
is String
"..")
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser FnBody
openForm |?)

    typeAnnotation :: Parser FnBody
typeAnnotation = FnBody -> Type -> FnBody
TypeAnnotation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser FnBody
infixArgForm forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. IsMatch a => a -> Parser a
is String
"::")
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Type
type'

    tuple :: Parser FnBody
tuple = [FnBody] -> FnBody
Tuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser [a]
tupleOf Parser FnBody
openForm

    list :: Parser FnBody
list = [FnBody] -> FnBody
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser [a]
listOf Parser FnBody
openForm

    fnOp :: Parser FnOp
fnOp = QCtorOp -> FnOp
CtorOp' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser QCtorOp
qCtorOp
       forall a. Parser a -> Parser a -> Parser a
<|> QVarOp -> FnOp
VarOp' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser QVarOp
qVarOp

    fnOp' :: Parser FnBody
fnOp' = FnOp -> FnBody
FnOp' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
withinParens Parser FnOp
fnOp

    fnVar :: Parser FnBody
fnVar = FnVar -> FnBody
FnVar' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> FnVar
Selector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
withinParens (Parser Char
dot forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Var
var)
        forall a. Parser a -> Parser a -> Parser a
<|> FnVar -> FnBody
FnVar' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            (QVar -> [Var] -> FnVar
Selection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser QVar
nonTokenQVar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
dot forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Parser a -> Parser b -> Parser [b]
someSepBy Parser Char
dot Parser Var
var)
        forall a. Parser a -> Parser a -> Parser a
<|> FnVar -> FnBody
FnVar' forall b c a. (b -> c) -> (a -> b) -> a -> c
. QVar -> FnVar
Var' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser QVar
qVar
        forall a. Parser a -> Parser a -> Parser a
<|> FnVar -> FnBody
FnVar' forall b c a. (b -> c) -> (a -> b) -> a -> c
. QCtor -> FnVar
Ctor' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser QCtor
qCtor

    literal' :: Parser FnBody
literal' = Literal -> FnBody
Literal' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Literal
literal

    recordCreate :: Parser FnBody
recordCreate = FnBody -> [(Var, FnBody)] -> FnBody
RecordCreate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FnBody
delimitedForm forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Var, FnBody)]
recordFields

    recordUpdate :: Parser FnBody
recordUpdate = FnBody -> [(Var, FnBody)] -> FnBody
RecordUpdate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FnBody
delimitedForm forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Var, FnBody)]
recordFields

    recordFields :: Parser [(Var, FnBody)]
recordFields = forall a. Parser a -> Parser a
withinCurlyBrackets (forall a b. Parser a -> Parser b -> Parser [b]
someSepBy Parser Char
comma Parser (Var, FnBody)
recordField)

    recordField :: Parser (Var, FnBody)
recordField  = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Var
var forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. IsMatch a => a -> Parser a
is String
"=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser FnBody
openForm)

    infixArgForm :: Parser FnBody
infixArgForm = Parser FnBody
complexInfixForm forall a. Parser a -> Parser a -> Parser a
<|> forall a. Parser a -> Parser a
withinParens Parser FnBody
complexInfixForm
               forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
singleForm

    openForm :: Parser FnBody
openForm = Parser FnBody
complexForm forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
singleForm
               forall a. Parser a -> Parser a -> Parser a
<|> forall a. Parser a -> Parser a
withinParens (Parser FnBody
complexForm forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
singleForm)

    delimitedForm :: Parser FnBody
delimitedForm = Parser FnBody
singleForm forall a. Parser a -> Parser a -> Parser a
<|> forall a. Parser a -> Parser a
withinParens Parser FnBody
complexForm
                    forall a. Parser a -> Parser a -> Parser a
<|> forall a. Parser a -> Parser a
withinParens Parser FnBody
singleForm

    singleForm :: Parser FnBody
singleForm = Parser FnBody
fnOp' forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
fnVar forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
literal' forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
tuple forall a. Parser a -> Parser a -> Parser a
<|>
                 Parser FnBody
listRange forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
list forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
opSection

    complexForm :: Parser FnBody
complexForm = Parser FnBody
infixFnApply forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
complexInfixForm forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
typeAnnotation


    complexInfixForm :: Parser FnBody
complexInfixForm = Parser FnBody
fnApply forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
lambdaCaseExpr forall a. Parser a -> Parser a -> Parser a
<|>
                       Parser FnBody
lambdaExpr forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
letExpr forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
whereExpr forall a. Parser a -> Parser a -> Parser a
<|>
                       Parser FnBody
ifExpr forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
multiWayIfExpr forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
doExpr forall a. Parser a -> Parser a -> Parser a
<|>
                       Parser FnBody
caseOfExpr forall a. Parser a -> Parser a -> Parser a
<|> forall a. Parser a -> Parser a
withinParens Parser FnBody
infixFnApply forall a. Parser a -> Parser a -> Parser a
<|>
                       Parser FnBody
recordCreate forall a. Parser a -> Parser a -> Parser a
<|> Parser FnBody
recordUpdate


doStep :: Parser DoStep
doStep :: Parser DoStep
doStep = [Var] -> FnBody -> DoStep
DoBinding  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Parser a -> Parser [a]
tupleOf Parser Var
var forall a. Parser a -> Parser a -> Parser a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Var
var) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. IsMatch a => a -> Parser a
is String
"<-"
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser String
adaptFnBody forall a. Parser String -> Parser a -> Parser a
`andThen` Parser FnBody
fnBody) forall a. Parser a -> Parser a -> Parser a
<|>
         [FnDefOrSig] -> DoStep
LetBinding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"let" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> Parser [a]
withinContext Parser FnDefOrSig
fnDefOrSig) forall a. Parser a -> Parser a -> Parser a
<|>
         FnBody -> DoStep
Body       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser String
adaptFnBody forall a. Parser String -> Parser a -> Parser a
`andThen` Parser FnBody
fnBody)


caseBinding :: Parser CaseBinding
caseBinding :: Parser CaseBinding
caseBinding = Pattern -> MaybeGuardedFnBody -> CaseBinding
CaseBinding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Pattern
pattern' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser MaybeGuardedFnBody
maybeGuardedFnBody (forall a. IsMatch a => a -> Parser a
is String
"->")


maybeGuardedFnBody :: Parser a -> Parser MaybeGuardedFnBody
maybeGuardedFnBody :: forall a. Parser a -> Parser MaybeGuardedFnBody
maybeGuardedFnBody Parser a
sep = [GuardedFnBody] -> MaybeGuardedFnBody
Guarded  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Parser a -> Parser GuardedFnBody
guardedFnBody Parser a
sep |+) forall a. Parser a -> Parser a -> Parser a
<|>
                         FnBody -> MaybeGuardedFnBody
Standard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser a
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser String
adaptFnBody forall a. Parser String -> Parser a -> Parser a
`andThen` Parser FnBody
fnBody))

guardedFnBody :: Parser a -> Parser GuardedFnBody
guardedFnBody :: forall a. Parser a -> Parser GuardedFnBody
guardedFnBody Parser a
sep = Guard -> FnBody -> GuardedFnBody
GuardedFnBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Guard
guard forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser a
sep forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser String
adaptFnBody forall a. Parser String -> Parser a -> Parser a
`andThen` Parser FnBody
fnBody)

guard :: Parser Guard
guard :: Parser Guard
guard = Guard
Otherwise forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  (forall a. IsMatch a => a -> Parser a
is String
"|" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> Parser a
token (forall a. IsMatch a => a -> Parser a
is String
"otherwise")) forall a. Parser a -> Parser a -> Parser a
<|>
        [PatternGuard] -> Guard
Guard     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"|" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a b. Parser a -> Parser b -> Parser [b]
someSepBy Parser Char
comma Parser PatternGuard
patternGuard)


patternGuard :: Parser PatternGuard
patternGuard :: Parser PatternGuard
patternGuard = Pattern -> FnBody -> PatternGuard
PatternGuard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Pattern
pattern' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. IsMatch a => a -> Parser a
is String
"<-") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FnBody
fnBody forall a. Parser a -> Parser a -> Parser a
<|>
               FnBody -> PatternGuard
SimpleGuard  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FnBody
fnBody


adaptFnBody :: Parser String
adaptFnBody :: Parser String
adaptFnBody = do String
start <- Parser String
otherText
                 Maybe String
next <- ((forall a. IsMatch a => a -> Parser a
is String
"where" forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser String
->>- Parser String
string) |?)
                 Maybe String
other <- ((forall a. IsMatch a => a -> Parser a
is String
";" forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser String
->>- Parser String
string) |?)
                 let x :: String
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
start ((String -> String
wrapCurly String
start) ++) Maybe String
next forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe String
other
                 forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x
 where
   otherText :: Parser String
otherText = (Parser String
spacing |?) forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser String
->>- (Parser String
textElem |*)
   textElem :: Parser String
textElem = forall a. String -> (a -> Bool) -> Parser a -> Parser a
check String
"" (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"where", String
";"]) Parser String
lexeme forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser String
->>- (Parser String
spacing |?)


statements :: Parser a -> Parser [a]
statements :: forall a. Parser a -> Parser [a]
statements Parser a
parser = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Parser a -> Parser b -> Parser [b]
someSepBy (forall a. IsMatch a => a -> Parser a
is String
";") (forall a. Maybe a -> [a]
maybeToList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser a
parser |?))

withinContext :: Parser a -> Parser [a]
withinContext :: forall a. Parser a -> Parser [a]
withinContext = forall a. Parser a -> Parser a
withinCurlyBrackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser [a]
statements

withinContextTupled :: Parser a1 -> Parser a2 -> Parser ([a1], [a2])
withinContextTupled :: forall a b. Parser a -> Parser b -> Parser ([a], [b])
withinContextTupled Parser a1
p1 Parser a2
p2 = forall a. Parser a -> Parser a
withinCurlyBrackets forall a b. (a -> b) -> a -> b
$
                             (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser [a]
statements Parser a1
p1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser [a]
statements Parser a2
p2


sepByOps :: Parser a -> Parser b -> Parser ([a], [b])
sepByOps :: forall a b. Parser a -> Parser b -> Parser ([a], [b])
sepByOps Parser a
sep Parser b
p = do b
x <-  Parser b
p
                    [(a, b)]
y <- (((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
sep forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser b
p) |+)
                    pure $ (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b)]
y, b
x forall a. a -> [a] -> [a]
: (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b)]
y))