module Parsers.Haskell.ClassDef where

import SyntaxTrees.Haskell.ClassDef (ClassDef (..), DerivingDef (..),
                                     InstanceDef (..))
import SyntaxTrees.Haskell.Type     (ClassConstraint)

import Parsers.Haskell.Common (class')
import Parsers.Haskell.FnDef  (fnDefOrSig, withinContext)
import Parsers.Haskell.Type   (anyKindedType, classConstraints, type',
                               typeParam)

import Bookhound.Parser            (Parser, withError)
import Bookhound.ParserCombinators (IsMatch (is), (<|>), (|*), (|+), (|?))

import Data.Foldable               (Foldable (fold))
import SyntaxTrees.Haskell.DataDef (DerivingStrategy (..))


classDef :: Parser ClassDef
classDef :: Parser ClassDef
classDef = forall a. String -> Parser a -> Parser a
withError String
"Class declaration" forall a b. (a -> b) -> a -> b
$
  [ClassConstraint]
-> Class -> [TypeParam] -> [FnDefOrSig] -> ClassDef
ClassDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"class" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [ClassConstraint]
classConstraints')
           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Class
class'
           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
<* 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


instanceDef :: Parser InstanceDef
instanceDef :: Parser InstanceDef
instanceDef = forall a. String -> Parser a -> Parser a
withError String
"Instance declaration" forall a b. (a -> b) -> a -> b
$
  [ClassConstraint]
-> Class -> [AnyKindedType] -> [FnDefOrSig] -> InstanceDef
InstanceDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"instance" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [ClassConstraint]
classConstraints')
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Class
class'
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser AnyKindedType
anyKindedType |+)
              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

derivingDef :: Parser DerivingDef
derivingDef :: Parser DerivingDef
derivingDef = forall a. String -> Parser a -> Parser a
withError String
"Standalone deriving declaration" forall a b. (a -> b) -> a -> b
$
  DerivingStrategy
-> [ClassConstraint]
-> Class
-> [AnyKindedType]
-> Maybe Class
-> DerivingDef
DerivingDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. IsMatch a => a -> Parser a
is String
"deriving" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                   Parser DerivingStrategy
derivingStrategy forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. IsMatch a => a -> Parser a
is String
"instance")
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ClassConstraint]
classConstraints'
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Class
class'
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser AnyKindedType
anyKindedType |+)
              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 Class
class') |?)

derivingStrategy :: Parser DerivingStrategy
derivingStrategy :: Parser DerivingStrategy
derivingStrategy = (DerivingStrategy
StandardDeriving forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. IsMatch a => a -> Parser a
is String
"stock")
                   forall a. Parser a -> Parser a -> Parser a
<|> (DerivingStrategy
NewTypeDeriving forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. IsMatch a => a -> Parser a
is String
"newtype")
                   forall a. Parser a -> Parser a -> Parser a
<|> (DerivingStrategy
AnyClassDeriving forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. IsMatch a => a -> Parser a
is String
"anyclass")
                   forall a. Parser a -> Parser a -> Parser a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure DerivingStrategy
StandardDeriving


classConstraints' :: Parser [ClassConstraint]
classConstraints' :: Parser [ClassConstraint]
classConstraints' = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    ((Parser Type -> Parser [ClassConstraint]
classConstraints Parser Type
type' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. IsMatch a => a -> Parser a
is String
"=>") |?)