{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Data.Haskell98.Constructor.Body
  ( Haskell98ConstructorBody
  , mkHaskell98ConstructorBody
  , isRecord
  ) where

import HIndent.Ast.Declaration.Data.Record.Field
import HIndent.Ast.Name.Infix
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments
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 Haskell98ConstructorBody
  = Infix
      { Haskell98ConstructorBody -> WithComments InfixName
iName :: WithComments InfixName -- Using `name` in all constructors causes a type clash
      , Haskell98ConstructorBody -> HsScaled GhcPs (LBangType GhcPs)
left :: GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)
      , Haskell98ConstructorBody -> HsScaled GhcPs (LBangType GhcPs)
right :: GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)
      }
  | Prefix
      { Haskell98ConstructorBody -> WithComments PrefixName
pName :: WithComments PrefixName
      , Haskell98ConstructorBody -> [HsScaled GhcPs (LBangType GhcPs)]
types :: [GHC.HsScaled GHC.GhcPs (GHC.LBangType GHC.GhcPs)]
      }
  | Record
      { Haskell98ConstructorBody -> WithComments PrefixName
rName :: WithComments PrefixName
      , Haskell98ConstructorBody -> WithComments [WithComments RecordField]
records :: WithComments [WithComments RecordField]
      }

instance CommentExtraction Haskell98ConstructorBody where
  nodeComments :: Haskell98ConstructorBody -> NodeComments
nodeComments Infix {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Prefix {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []
  nodeComments Record {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty Haskell98ConstructorBody where
  pretty' :: Haskell98ConstructorBody -> Printer ()
pretty' Infix {HsScaled GhcPs (LBangType GhcPs)
WithComments InfixName
iName :: Haskell98ConstructorBody -> WithComments InfixName
left :: Haskell98ConstructorBody -> HsScaled GhcPs (LBangType GhcPs)
right :: Haskell98ConstructorBody -> HsScaled GhcPs (LBangType GhcPs)
iName :: WithComments InfixName
left :: HsScaled GhcPs (LBangType GhcPs)
right :: HsScaled GhcPs (LBangType GhcPs)
..} = [Printer ()] -> Printer ()
spaced [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsScaled GhcPs (LBangType GhcPs)
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
left, WithComments InfixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments InfixName
iName, HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty HsScaled GhcPs (LBangType GhcPs)
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
right]
  pretty' Prefix {[HsScaled GhcPs (LBangType GhcPs)]
WithComments PrefixName
pName :: Haskell98ConstructorBody -> WithComments PrefixName
types :: Haskell98ConstructorBody -> [HsScaled GhcPs (LBangType GhcPs)]
pName :: WithComments PrefixName
types :: [HsScaled GhcPs (LBangType GhcPs)]
..} = WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
pName 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 ()
hor Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
ver
    where
      hor :: Printer ()
hor = [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [HsScaled GhcPs (LBangType GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
types
      ver :: Printer ()
ver = Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ [Printer ()] -> Printer ()
newlinePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [HsScaled GhcPs (LBangType GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
types
  pretty' Record {WithComments [WithComments RecordField]
WithComments PrefixName
rName :: Haskell98ConstructorBody -> WithComments PrefixName
records :: Haskell98ConstructorBody -> WithComments [WithComments RecordField]
rName :: WithComments PrefixName
records :: WithComments [WithComments RecordField]
..} = do
    WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
rName
    WithComments [WithComments RecordField]
-> ([WithComments RecordField] -> Printer ()) -> Printer ()
forall a. WithComments a -> (a -> Printer ()) -> Printer ()
prettyWith WithComments [WithComments RecordField]
records (([WithComments RecordField] -> Printer ()) -> Printer ())
-> ([WithComments RecordField] -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \[WithComments RecordField]
r ->
      Printer ()
newline 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 () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock ([Printer ()] -> Printer ()
vFields ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments RecordField -> Printer ())
-> [WithComments RecordField] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments RecordField -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments RecordField]
r)

mkHaskell98ConstructorBody ::
     GHC.ConDecl GHC.GhcPs -> Maybe Haskell98ConstructorBody
mkHaskell98ConstructorBody :: ConDecl GhcPs -> Maybe Haskell98ConstructorBody
mkHaskell98ConstructorBody GHC.ConDeclH98 { con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = GHC.InfixCon HsScaled GhcPs (LBangType GhcPs)
left HsScaled GhcPs (LBangType GhcPs)
right
                                          , Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP 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_doc :: Maybe (LHsDoc GhcPs)
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext 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
..
                                          } = Haskell98ConstructorBody -> Maybe Haskell98ConstructorBody
forall a. a -> Maybe a
Just Infix {HsScaled GhcPs (LBangType GhcPs)
WithComments InfixName
iName :: WithComments InfixName
left :: HsScaled GhcPs (LBangType GhcPs)
right :: HsScaled GhcPs (LBangType GhcPs)
left :: HsScaled GhcPs (LBangType GhcPs)
right :: HsScaled GhcPs (LBangType GhcPs)
iName :: WithComments InfixName
..}
  where
    iName :: WithComments InfixName
iName = GenLocated SrcSpanAnnN InfixName -> WithComments InfixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN InfixName -> WithComments InfixName)
-> GenLocated SrcSpanAnnN InfixName -> WithComments InfixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> InfixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN InfixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> InfixName
mkInfixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
con_name
mkHaskell98ConstructorBody GHC.ConDeclH98 {con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = GHC.PrefixCon [Void]
_ [HsScaled GhcPs (LBangType GhcPs)]
types, Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext 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
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_doc :: Maybe (LHsDoc GhcPs)
..} =
  Haskell98ConstructorBody -> Maybe Haskell98ConstructorBody
forall a. a -> Maybe a
Just Prefix {[HsScaled GhcPs (LBangType GhcPs)]
WithComments PrefixName
pName :: WithComments PrefixName
types :: [HsScaled GhcPs (LBangType GhcPs)]
types :: [HsScaled GhcPs (LBangType GhcPs)]
pName :: WithComments PrefixName
..}
  where
    pName :: WithComments PrefixName
pName = GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
con_name
mkHaskell98ConstructorBody GHC.ConDeclH98 {con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = GHC.RecCon XRec GhcPs [LConDeclField GhcPs]
rs, Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext 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
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_doc :: Maybe (LHsDoc GhcPs)
..} =
  Haskell98ConstructorBody -> Maybe Haskell98ConstructorBody
forall a. a -> Maybe a
Just Record {WithComments [WithComments RecordField]
WithComments PrefixName
rName :: WithComments PrefixName
records :: WithComments [WithComments RecordField]
rName :: WithComments PrefixName
records :: WithComments [WithComments RecordField]
..}
  where
    rName :: WithComments PrefixName
rName = GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName)
-> GenLocated SrcSpanAnnN PrefixName -> WithComments PrefixName
forall a b. (a -> b) -> a -> b
$ (RdrName -> PrefixName)
-> GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN PrefixName
forall a b.
(a -> b) -> GenLocated SrcSpanAnnN a -> GenLocated SrcSpanAnnN b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RdrName -> PrefixName
mkPrefixName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
con_name
    records :: WithComments [WithComments RecordField]
records =
      GenLocated SrcSpanAnnL [WithComments RecordField]
-> WithComments [WithComments RecordField]
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated (GenLocated SrcSpanAnnL [WithComments RecordField]
 -> WithComments [WithComments RecordField])
-> GenLocated SrcSpanAnnL [WithComments RecordField]
-> WithComments [WithComments RecordField]
forall a b. (a -> b) -> a -> b
$ ([GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
 -> [WithComments RecordField])
-> GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> GenLocated SrcSpanAnnL [WithComments RecordField]
forall a b.
(a -> b) -> GenLocated SrcSpanAnnL a -> GenLocated SrcSpanAnnL b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GenLocated SrcSpanAnnA (ConDeclField GhcPs)
 -> WithComments RecordField)
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [WithComments RecordField]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ConDeclField GhcPs -> RecordField)
-> WithComments (ConDeclField GhcPs) -> WithComments RecordField
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConDeclField GhcPs -> RecordField
mkRecordField (WithComments (ConDeclField GhcPs) -> WithComments RecordField)
-> (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
    -> WithComments (ConDeclField GhcPs))
-> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> WithComments RecordField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> WithComments (ConDeclField GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated)) XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
rs
mkHaskell98ConstructorBody GHC.ConDeclGADT {} = Maybe Haskell98ConstructorBody
forall a. Maybe a
Nothing

isRecord :: Haskell98ConstructorBody -> Bool
isRecord :: Haskell98ConstructorBody -> Bool
isRecord Record {} = Bool
True
isRecord Haskell98ConstructorBody
_ = Bool
False