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