{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Family.Data
  ( DataFamily
  , mkDataFamily
  ) where

import Control.Monad
import qualified GHC.Types.Basic as GHC
import qualified GHC.Types.SrcLoc as GHC
import HIndent.Applicative
import HIndent.Ast.Name.Prefix
import HIndent.Ast.NodeComments hiding (fromEpAnn)
import HIndent.Ast.Type
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 DataFamily = DataFamily
  { DataFamily -> Bool
isTopLevel :: Bool
  , DataFamily -> WithComments PrefixName
name :: WithComments PrefixName
  , DataFamily -> [WithComments TypeVariable]
typeVariables :: [WithComments TypeVariable]
  , DataFamily -> Maybe (WithComments Type)
signature :: Maybe (WithComments Type)
  }

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

instance Pretty DataFamily where
  pretty' :: DataFamily -> Printer ()
pretty' DataFamily {Bool
[WithComments TypeVariable]
Maybe (WithComments Type)
WithComments PrefixName
isTopLevel :: DataFamily -> Bool
name :: DataFamily -> WithComments PrefixName
typeVariables :: DataFamily -> [WithComments TypeVariable]
signature :: DataFamily -> Maybe (WithComments Type)
isTopLevel :: Bool
name :: WithComments PrefixName
typeVariables :: [WithComments TypeVariable]
signature :: Maybe (WithComments Type)
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"data "
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isTopLevel (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"family "
    WithComments PrefixName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments PrefixName
name
    [Printer ()] -> Printer ()
spacePrefixed ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (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]
typeVariables
    Maybe (WithComments Type)
-> (WithComments Type -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (WithComments Type)
signature ((WithComments Type -> Printer ()) -> Printer ())
-> (WithComments Type -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \WithComments Type
sig -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WithComments Type -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments Type
sig

mkDataFamily :: GHC.FamilyDecl GHC.GhcPs -> Maybe DataFamily
mkDataFamily :: FamilyDecl GhcPs -> Maybe DataFamily
mkDataFamily GHC.FamilyDecl {fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars = GHC.HsQTvs {[LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
XHsQTvs GhcPs
hsq_ext :: XHsQTvs GhcPs
hsq_explicit :: [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
hsq_explicit :: forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsq_ext :: forall pass. LHsQTyVars pass -> XHsQTvs pass
..}, Maybe (LInjectivityAnn GhcPs)
XCFamilyDecl GhcPs
LIdP GhcPs
LFamilyResultSig GhcPs
TopLevelFlag
LexicalFixity
FamilyInfo GhcPs
fdExt :: XCFamilyDecl GhcPs
fdInfo :: FamilyInfo GhcPs
fdTopLevel :: TopLevelFlag
fdLName :: LIdP GhcPs
fdFixity :: LexicalFixity
fdResultSig :: LFamilyResultSig GhcPs
fdInjectivityAnn :: Maybe (LInjectivityAnn GhcPs)
fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdFixity :: forall pass. FamilyDecl pass -> LexicalFixity
fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdTopLevel :: forall pass. FamilyDecl pass -> TopLevelFlag
fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdExt :: forall pass. FamilyDecl pass -> XCFamilyDecl pass
..}
  | FamilyInfo GhcPs
GHC.DataFamily <- FamilyInfo GhcPs
fdInfo
  , Maybe (LInjectivityAnn GhcPs)
Nothing <- Maybe (LInjectivityAnn GhcPs)
fdInjectivityAnn = DataFamily -> Maybe DataFamily
forall a. a -> Maybe a
Just DataFamily {Bool
[WithComments TypeVariable]
Maybe (WithComments Type)
WithComments PrefixName
isTopLevel :: Bool
name :: WithComments PrefixName
typeVariables :: [WithComments TypeVariable]
signature :: Maybe (WithComments Type)
isTopLevel :: Bool
name :: WithComments PrefixName
typeVariables :: [WithComments TypeVariable]
signature :: Maybe (WithComments Type)
..}
  | Bool
otherwise = Maybe DataFamily
forall a. Maybe a
Nothing
  where
    isTopLevel :: Bool
isTopLevel =
      case TopLevelFlag
fdTopLevel of
        TopLevelFlag
GHC.TopLevel -> Bool
True
        TopLevelFlag
GHC.NotTopLevel -> Bool
False
    name :: WithComments PrefixName
name = 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
fdLName
    typeVariables :: [WithComments TypeVariable]
typeVariables = (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
 -> WithComments TypeVariable)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> [WithComments TypeVariable]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HsTyVarBndr (HsBndrVis GhcPs) GhcPs -> TypeVariable)
-> WithComments (HsTyVarBndr (HsBndrVis GhcPs) 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 (HsBndrVis GhcPs) GhcPs -> TypeVariable
forall a. HsTyVarBndr a GhcPs -> TypeVariable
mkTypeVariable (WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
 -> WithComments TypeVariable)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
    -> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
-> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> WithComments TypeVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> WithComments (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
hsq_explicit
    signature :: Maybe (WithComments Type)
signature =
      case GenLocated EpAnnCO (FamilyResultSig GhcPs) -> FamilyResultSig GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LFamilyResultSig GhcPs
GenLocated EpAnnCO (FamilyResultSig GhcPs)
fdResultSig of
        GHC.NoSig {} -> Maybe (WithComments Type)
forall a. Maybe a
Nothing
        GHC.KindSig XCKindSig GhcPs
_ LHsKind GhcPs
kind -> WithComments Type -> Maybe (WithComments Type)
forall a. a -> Maybe a
Just (WithComments Type -> Maybe (WithComments Type))
-> WithComments Type -> Maybe (WithComments Type)
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> Type
mkType (HsType GhcPs -> Type)
-> WithComments (HsType GhcPs) -> WithComments Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnA (HsType GhcPs)
-> WithComments (HsType GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated LHsKind GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
kind
        GHC.TyVarSig {} ->
          String -> Maybe (WithComments Type)
forall a. HasCallStack => String -> a
error
            String
"Data family should never have this AST node. If you see this error, please report it to the HIndent maintainers."