module Parsers.Haskell.Type where


import Bookhound.Parser              (Parser)
import Bookhound.ParserCombinators   (IsMatch (is), multipleSepBy, (<|>),
                                      (|+))
import Bookhound.Parsers.Char        (comma, dot, lower, upper)
import Bookhound.Parsers.Collections (tupleOf)
import Bookhound.Parsers.String      (maybeWithinParens, withinParens,
                                      withinSquareBrackets)

import Parsers.Haskell.Common   (ident, notReserved, qClass, qTerm')
import SyntaxTrees.Haskell.Type (AnyKindedType (..), ClassConstraint (..),
                                 QTypeCtor (QTypeCtor), QTypeVar (QTypeVar),
                                 Type (..), TypeCtor (..), TypeParam (..),
                                 TypeVar (..))

typeParam :: Parser TypeParam
typeParam :: Parser TypeParam
typeParam = String -> TypeParam
TypeParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser String
notReserved (Parser Char -> Parser String
ident Parser Char
lower)

typeVar :: Parser TypeVar
typeVar :: Parser TypeVar
typeVar = String -> TypeVar
TypeVar  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Parser String
ident Parser Char
upper forall a. Parser a -> Parser a -> Parser a
<|>
          TypeVar
UnitType forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. IsMatch a => a -> Parser a
is String
"()"

typeCtor :: Parser TypeCtor
typeCtor :: Parser TypeCtor
typeCtor = String -> TypeCtor
TypeCtor  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Parser String
ident Parser Char
upper forall a. Parser a -> Parser a -> Parser a
<|>
           TypeCtor
Arrow     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. IsMatch a => a -> Parser a
is String
"(->)"   forall a. Parser a -> Parser a -> Parser a
<|>
           TypeCtor
TupleType forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. IsMatch a => a -> Parser a
is String
"(,)"    forall a. Parser a -> Parser a -> Parser a
<|>
           TypeCtor
ListType  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  forall a. IsMatch a => a -> Parser a
is String
"[]"

anyKindedType :: Parser AnyKindedType
anyKindedType :: Parser AnyKindedType
anyKindedType = Type -> AnyKindedType
TypeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Type
type'     forall a. Parser a -> Parser a -> Parser a
<|>
                QTypeCtor -> AnyKindedType
TypeFn    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser QTypeCtor
qTypeCtor


classConstraints :: Parser Type -> Parser [ClassConstraint]
classConstraints :: Parser Type -> Parser [ClassConstraint]
classConstraints Parser Type
typeParser =
  forall a. Parser a -> Parser [a]
tupleOf (Parser Type -> Parser ClassConstraint
classConstraint Parser Type
typeParser)
  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
<$> forall b. Parser b -> Parser b
maybeWithinParens (Parser Type -> Parser ClassConstraint
classConstraint Parser Type
typeParser)


classConstraint :: Parser Type -> Parser ClassConstraint
classConstraint :: Parser Type -> Parser ClassConstraint
classConstraint Parser Type
typeParser = QClass -> [Type] -> ClassConstraint
ClassConstraint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser QClass
qClass forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Type
typeParser |+)



type' :: Parser Type
type' :: Parser Type
type' = Parser Type
typeScope forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
classScope forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
type'' forall a. Parser a -> Parser a -> Parser a
<|> forall b. Parser b -> Parser b
maybeWithinParens (Parser Type
type'')
  where
    type'' :: Parser Type
type'' = Parser Type
arrow forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
typeApply forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
elem'

    typeApply :: Parser Type
typeApply = QTypeCtor -> [Type] -> Type
CtorTypeApply   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser QTypeCtor
typeCtor' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Type
typeApplyElem |+) forall a. Parser a -> Parser a -> Parser a
<|>
                TypeParam -> [Type] -> Type
ParamTypeApply  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeParam
typeParam forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Type
typeApplyElem |+) forall a. Parser a -> Parser a -> Parser a
<|>
                Type -> [Type] -> Type
NestedTypeApply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. Parser b -> Parser b
withinParens Parser Type
typeApply forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Type
typeApplyElem |+)

    arrow :: Parser Type
arrow = QTypeCtor -> [Type] -> Type
CtorTypeApply (Maybe Module -> TypeCtor -> QTypeCtor
QTypeCtor forall a. Maybe a
Nothing TypeCtor
Arrow)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Parser a -> Parser b -> Parser [b]
multipleSepBy (forall a. IsMatch a => a -> Parser a
is String
"->") Parser Type
arrowElem
    tuple :: Parser Type
tuple = QTypeCtor -> [Type] -> Type
CtorTypeApply (Maybe Module -> TypeCtor -> QTypeCtor
QTypeCtor forall a. Maybe a
Nothing TypeCtor
TupleType)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall b. Parser b -> Parser b
withinParens forall a b. (a -> b) -> a -> b
$ forall a b. Parser a -> Parser b -> Parser [b]
multipleSepBy Parser Char
comma Parser Type
type'')
    list :: Parser Type
list  = QTypeCtor -> [Type] -> Type
CtorTypeApply (Maybe Module -> TypeCtor -> QTypeCtor
QTypeCtor forall a. Maybe a
Nothing TypeCtor
ListType)
            forall (f :: * -> *) a b. Functor 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
<$> forall b. Parser b -> Parser b
withinSquareBrackets Parser Type
type'')

    typeCtor' :: Parser QTypeCtor
typeCtor'  = Parser QTypeCtor
qTypeCtor forall a. Parser a -> Parser a -> Parser a
<|> Maybe Module -> TypeCtor -> QTypeCtor
QTypeCtor forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeCtor
typeCtor
    typeVar' :: Parser Type
typeVar'   = QTypeVar -> Type
TypeVar'   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser QTypeVar
qTypeVar forall a. Parser a -> Parser a -> Parser a
<|> Maybe Module -> TypeVar -> QTypeVar
QTypeVar forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeVar
typeVar)
    typeParam' :: Parser Type
typeParam' = TypeParam -> Type
TypeParam' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeParam
typeParam

    typeScope :: Parser Type
typeScope = [TypeParam] -> Type -> Type
TypeScope forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"forall" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser TypeParam
typeParam |+) 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
<*> (Parser Type
classScope forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
type'')
    classScope :: Parser Type
classScope = [ClassConstraint] -> Type -> Type
ClassScope forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser [ClassConstraint]
classConstraints' 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''

    classConstraints' :: Parser [ClassConstraint]
classConstraints' = Parser Type -> Parser [ClassConstraint]
classConstraints
                        (Parser Type
elem' forall a. Parser a -> Parser a -> Parser a
<|> forall b. Parser b -> Parser b
withinParens (Parser Type
arrow forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
typeApply))


    typeApplyElem :: Parser Type
typeApplyElem = Parser Type
elem' forall a. Parser a -> Parser a -> Parser a
<|> forall b. Parser b -> Parser b
withinParens (Parser Type
arrow forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
typeApply)
    arrowElem :: Parser Type
arrowElem     = Parser Type
typeApply forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
elem' forall a. Parser a -> Parser a -> Parser a
<|> forall b. Parser b -> Parser b
withinParens Parser Type
arrow

    elem' :: Parser Type
elem' = Parser Type
typeVar' forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
typeParam' forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
tuple forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
list forall a. Parser a -> Parser a -> Parser a
<|>
            forall b. Parser b -> Parser b
withinParens (Parser Type
typeScope forall a. Parser a -> Parser a -> Parser a
<|> Parser Type
classScope)

qTypeVar :: Parser QTypeVar
qTypeVar :: Parser QTypeVar
qTypeVar = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Module -> TypeVar -> QTypeVar
QTypeVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. (String -> b) -> Parser (Maybe Module, b)
qTerm' String -> TypeVar
TypeVar

qTypeCtor :: Parser QTypeCtor
qTypeCtor :: Parser QTypeCtor
qTypeCtor = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Module -> TypeCtor -> QTypeCtor
QTypeCtor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. (String -> b) -> Parser (Maybe Module, b)
qTerm' String -> TypeCtor
TypeCtor