module Parsers.Haskell.DataDef where import Parsers.Haskell.Common (class', ctor, var) import Parsers.Haskell.Type (anyKindedType, type', typeCtor, typeParam) import SyntaxTrees.Haskell.DataDef (DataCtorDef (..), DataDef (..), DerivingClause (..), DerivingStrategy (..), FieldDef (..), NamedFieldDef (..), NewTypeDef (..), TypeDef (..), UnNamedFieldDef (..)) import Bookhound.Parser (Parser, withError) import Bookhound.ParserCombinators (IsMatch (..), anySepBy, someSepBy, (<#>), (<|>), (|*), (|?)) import Bookhound.Parsers.Char (colon, comma, equal) import Bookhound.Parsers.Collections (tupleOf) import Bookhound.Parsers.String (maybeWithinParens, withinCurlyBrackets, withinParens) import Data.Foldable (Foldable (fold)) typeDef :: Parser TypeDef typeDef :: Parser TypeDef typeDef = forall a. String -> Parser a -> Parser a withError String "Type declaration" forall a b. (a -> b) -> a -> b $ TypeCtor -> [TypeParam] -> AnyKindedType -> TypeDef TypeDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ((forall a. IsMatch a => a -> Parser a is String "type") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser TypeCtor typeCtor) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Parser TypeParam typeParam |*) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Parser Char equal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser AnyKindedType anyKindedType newtypeDef :: Parser NewTypeDef newtypeDef :: Parser NewTypeDef newtypeDef = forall a. String -> Parser a -> Parser a withError String "Newtype declaration" forall a b. (a -> b) -> a -> b $ TypeCtor -> [TypeParam] -> Ctor -> FieldDef -> [DerivingClause] -> NewTypeDef NewTypeDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (forall a. IsMatch a => a -> Parser a is String "newtype" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser TypeCtor typeCtor) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Parser TypeParam typeParam |*) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Parser Char equal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Ctor ctor forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser FieldDef fieldDef forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Parser DerivingClause derivingClause |*) dataDef :: Parser DataDef dataDef :: Parser DataDef dataDef = forall a. String -> Parser a -> Parser a withError String "Data declaration" forall a b. (a -> b) -> a -> b $ TypeCtor -> [TypeParam] -> [DataCtorDef] -> [DerivingClause] -> DataDef DataDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (forall a. IsMatch a => a -> Parser a is String "data" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser TypeCtor typeCtor) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Parser TypeParam typeParam |*) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m fold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser (Maybe [DataCtorDef]) alternatives) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Parser DerivingClause derivingClause |*) where alternatives :: Parser (Maybe [DataCtorDef]) alternatives = ((Parser Char equal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> forall a b. Parser a -> Parser b -> Parser [b] someSepBy (forall a. IsMatch a => a -> Parser a is String "|") Parser DataCtorDef dataCtorDef) |?) namedFieldDef :: Parser NamedFieldDef namedFieldDef :: Parser NamedFieldDef namedFieldDef = Var -> Type -> NamedFieldDef NamedFieldDef 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 <* (Parser Char colon forall a. Parser a -> Integer -> Parser [a] <#> Integer 2) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Type type' unNamedFieldDef :: Parser UnNamedFieldDef unNamedFieldDef :: Parser UnNamedFieldDef unNamedFieldDef = Type -> UnNamedFieldDef UnNamedFieldDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (forall b. Parser b -> Parser b withinParens Parser Type type' forall a. Parser a -> Parser a -> Parser a <|> Parser Type type') fieldDef :: Parser FieldDef fieldDef :: Parser FieldDef fieldDef = UnNamedFieldDef -> FieldDef UnNamedField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser UnNamedFieldDef unNamedFieldDef forall a. Parser a -> Parser a -> Parser a <|> NamedFieldDef -> FieldDef NamedField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall b. Parser b -> Parser b withinCurlyBrackets Parser NamedFieldDef namedFieldDef dataCtorDef :: Parser DataCtorDef dataCtorDef :: Parser DataCtorDef dataCtorDef = Ctor -> [NamedFieldDef] -> DataCtorDef NamedFieldsCtor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Ctor ctor forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (forall b. Parser b -> Parser b withinCurlyBrackets forall a b. (a -> b) -> a -> b $ forall a b. Parser a -> Parser b -> Parser [b] anySepBy Parser Char comma Parser NamedFieldDef namedFieldDef) forall a. Parser a -> Parser a -> Parser a <|> Ctor -> [UnNamedFieldDef] -> DataCtorDef UnNamedFieldsCtor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Ctor ctor forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Parser UnNamedFieldDef unNamedFieldDef |*) derivingClause :: Parser DerivingClause derivingClause :: Parser DerivingClause derivingClause = (forall a. IsMatch a => a -> Parser a is String "deriving" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ((forall a. IsMatch a => a -> Parser a is String "stock" |?) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> (DerivingStrategy -> [Class] -> DerivingClause Deriving DerivingStrategy StandardDeriving forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser [Class] derivingList)) forall a. Parser a -> Parser a -> Parser a <|> (forall a. IsMatch a => a -> Parser a is String "newtype" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> (DerivingStrategy -> [Class] -> DerivingClause Deriving DerivingStrategy NewTypeDeriving forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser [Class] derivingList)) forall a. Parser a -> Parser a -> Parser a <|> (forall a. IsMatch a => a -> Parser a is String "anyclass" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> (DerivingStrategy -> [Class] -> DerivingClause Deriving DerivingStrategy AnyClassDeriving forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser [Class] derivingList)) forall a. Parser a -> Parser a -> Parser a <|> ([Class] -> AnyKindedType -> DerivingClause DerivingVia forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser [Class] derivingList forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (forall a. IsMatch a => a -> Parser a is String "via" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser AnyKindedType anyKindedType))) where derivingList :: Parser [Class] derivingList = (forall a. Parser a -> Parser [a] tupleOf Parser Class class' 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 Class class')