{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Data.Haskell98.Constructor
  ( Haskell98Constructor
  , mkHaskell98Constructor
  , hasSingleRecordConstructor
  ) where

import HIndent.Applicative
import HIndent.Ast.Context
import HIndent.Ast.Declaration.Data.Haskell98.Constructor.Body
import HIndent.Ast.NodeComments
import HIndent.Ast.Type.Variable
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import {-# SOURCE #-} HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data Haskell98Constructor = Haskell98Constructor
  { Haskell98Constructor -> [WithComments TypeVariable]
existentialVariables :: [WithComments TypeVariable]
  , Haskell98Constructor -> Maybe (WithComments Context)
context :: Maybe (WithComments Context)
  , Haskell98Constructor -> Haskell98ConstructorBody
body :: Haskell98ConstructorBody
  }

instance CommentExtraction Haskell98Constructor where
  nodeComments :: Haskell98Constructor -> NodeComments
nodeComments Haskell98Constructor {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty Haskell98Constructor where
  pretty' :: Haskell98Constructor -> Printer ()
pretty' Haskell98Constructor {existentialVariables :: Haskell98Constructor -> [WithComments TypeVariable]
existentialVariables = [], Maybe (WithComments Context)
Haskell98ConstructorBody
context :: Haskell98Constructor -> Maybe (WithComments Context)
body :: Haskell98Constructor -> Haskell98ConstructorBody
context :: Maybe (WithComments Context)
body :: Haskell98ConstructorBody
..} = do
    Maybe (WithComments Context)
-> (WithComments Context -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (WithComments Context)
context ((WithComments Context -> Printer ()) -> Printer ())
-> (WithComments Context -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \WithComments Context
c -> WithComments Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments Context
c Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
" => "
    Haskell98ConstructorBody -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Haskell98ConstructorBody
body
  pretty' Haskell98Constructor {[WithComments TypeVariable]
Maybe (WithComments Context)
Haskell98ConstructorBody
existentialVariables :: Haskell98Constructor -> [WithComments TypeVariable]
context :: Haskell98Constructor -> Maybe (WithComments Context)
body :: Haskell98Constructor -> Haskell98ConstructorBody
existentialVariables :: [WithComments TypeVariable]
context :: Maybe (WithComments Context)
body :: Haskell98ConstructorBody
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"forall "
    [Printer ()] -> Printer ()
spaced ((WithComments TypeVariable -> Printer ())
-> [WithComments TypeVariable] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments TypeVariable -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments TypeVariable]
existentialVariables)
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
". " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> do
      Maybe (WithComments Context)
-> (WithComments Context -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (WithComments Context)
context ((WithComments Context -> Printer ()) -> Printer ())
-> (WithComments Context -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \WithComments Context
c -> WithComments Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments Context
c Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
" =>" Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline
      Haskell98ConstructorBody -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty Haskell98ConstructorBody
body

mkHaskell98Constructor :: GHC.ConDecl GHC.GhcPs -> Maybe Haskell98Constructor
mkHaskell98Constructor :: ConDecl GhcPs -> Maybe Haskell98Constructor
mkHaskell98Constructor GHC.ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDeclH98Details GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_forall :: forall pass. ConDecl pass -> Bool
con_name :: forall pass. ConDecl pass -> LIdP pass
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
..}
  | Just Haskell98ConstructorBody
body <- ConDecl GhcPs -> Maybe Haskell98ConstructorBody
mkHaskell98ConstructorBody GHC.ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDeclH98Details GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
con_doc :: Maybe (LHsDoc GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDeclH98Details GhcPs
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_forall :: Bool
con_name :: LIdP GhcPs
con_ext :: XConDeclH98 GhcPs
..} =
    Haskell98Constructor -> Maybe Haskell98Constructor
forall a. a -> Maybe a
Just Haskell98Constructor {[WithComments TypeVariable]
Maybe (WithComments Context)
Haskell98ConstructorBody
existentialVariables :: [WithComments TypeVariable]
context :: Maybe (WithComments Context)
body :: Haskell98ConstructorBody
body :: Haskell98ConstructorBody
existentialVariables :: [WithComments TypeVariable]
context :: Maybe (WithComments Context)
..}
  where
    existentialVariables :: [WithComments TypeVariable]
existentialVariables =
      if Bool
con_forall
        then (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
 -> WithComments TypeVariable)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [WithComments TypeVariable]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HsTyVarBndr Specificity GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsTyVarBndr Specificity GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (WithComments (HsTyVarBndr Specificity GhcPs)
 -> WithComments TypeVariable)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
    -> WithComments (HsTyVarBndr Specificity GhcPs))
-> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments TypeVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> WithComments (HsTyVarBndr Specificity GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
con_ex_tvs
        else []
    context :: Maybe (WithComments Context)
context = (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> WithComments Context)
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Maybe (WithComments Context)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([GenLocated SrcSpanAnnA (HsType GhcPs)] -> Context)
-> WithComments [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> WithComments Context
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsContext GhcPs -> Context
[GenLocated SrcSpanAnnA (HsType GhcPs)] -> Context
mkContext (WithComments [GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> WithComments Context)
-> (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
    -> WithComments [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> WithComments Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> WithComments [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) Maybe (LHsContext GhcPs)
Maybe
  (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)])
con_mb_cxt
mkHaskell98Constructor ConDecl GhcPs
_ = Maybe Haskell98Constructor
forall a. Maybe a
Nothing

hasSingleRecordConstructor :: Haskell98Constructor -> Bool
hasSingleRecordConstructor :: Haskell98Constructor -> Bool
hasSingleRecordConstructor = Haskell98ConstructorBody -> Bool
isRecord (Haskell98ConstructorBody -> Bool)
-> (Haskell98Constructor -> Haskell98ConstructorBody)
-> Haskell98Constructor
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Haskell98Constructor -> Haskell98ConstructorBody
body