{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Family.Type
  ( TypeFamily
  , mkTypeFamily
  ) where

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

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

instance Pretty TypeFamily where
  pretty' :: TypeFamily -> Printer ()
pretty' TypeFamily {Bool
[WithComments TypeVariable]
Maybe [WithComments (TyFamInstEqn GhcPs)]
Maybe (WithComments Injectivity)
WithComments PrefixName
WithComments ResultSignature
isTopLevel :: TypeFamily -> Bool
name :: TypeFamily -> WithComments PrefixName
typeVariables :: TypeFamily -> [WithComments TypeVariable]
signature :: TypeFamily -> WithComments ResultSignature
injectivity :: TypeFamily -> Maybe (WithComments Injectivity)
equations :: TypeFamily -> Maybe [WithComments (TyFamInstEqn GhcPs)]
isTopLevel :: Bool
name :: WithComments PrefixName
typeVariables :: [WithComments TypeVariable]
signature :: WithComments ResultSignature
injectivity :: Maybe (WithComments Injectivity)
equations :: Maybe [WithComments (TyFamInstEqn GhcPs)]
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"type "
    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
    WithComments ResultSignature -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments ResultSignature
signature
    Maybe (WithComments Injectivity)
-> (WithComments Injectivity -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (WithComments Injectivity)
injectivity ((WithComments Injectivity -> Printer ()) -> Printer ())
-> (WithComments Injectivity -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \WithComments Injectivity
x -> 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
>> WithComments Injectivity -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments Injectivity
x
    Maybe
  [WithComments
     (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
-> ([WithComments
       (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
    -> Printer ())
-> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [WithComments (TyFamInstEqn GhcPs)]
Maybe
  [WithComments
     (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
equations (([WithComments
     (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
  -> Printer ())
 -> Printer ())
-> ([WithComments
       (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \[WithComments
   (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
xs ->
      HasCallStack => String -> Printer ()
String -> Printer ()
string String
" where" 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 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 ()
lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments
   (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
 -> Printer ())
-> [WithComments
      (FamEqn 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 WithComments (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments
   (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
xs)

mkTypeFamily :: GHC.FamilyDecl GHC.GhcPs -> Maybe TypeFamily
mkTypeFamily :: FamilyDecl GhcPs -> Maybe TypeFamily
mkTypeFamily 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 TypeFamily
forall a. Maybe a
Nothing
  | Bool
otherwise = TypeFamily -> Maybe TypeFamily
forall a. a -> Maybe a
Just TypeFamily {Bool
[WithComments TypeVariable]
Maybe [WithComments (TyFamInstEqn GhcPs)]
Maybe
  [WithComments
     (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
Maybe (WithComments Injectivity)
WithComments PrefixName
WithComments ResultSignature
isTopLevel :: Bool
name :: WithComments PrefixName
typeVariables :: [WithComments TypeVariable]
signature :: WithComments ResultSignature
injectivity :: Maybe (WithComments Injectivity)
equations :: Maybe [WithComments (TyFamInstEqn GhcPs)]
isTopLevel :: Bool
name :: WithComments PrefixName
typeVariables :: [WithComments TypeVariable]
signature :: WithComments ResultSignature
injectivity :: Maybe (WithComments Injectivity)
equations :: Maybe
  [WithComments
     (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
..}
  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 :: WithComments ResultSignature
signature = FamilyResultSig GhcPs -> ResultSignature
mkResultSignature (FamilyResultSig GhcPs -> ResultSignature)
-> WithComments (FamilyResultSig GhcPs)
-> WithComments ResultSignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated EpAnnCO (FamilyResultSig GhcPs)
-> WithComments (FamilyResultSig GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated LFamilyResultSig GhcPs
GenLocated EpAnnCO (FamilyResultSig GhcPs)
fdResultSig
    injectivity :: Maybe (WithComments Injectivity)
injectivity = (GenLocated EpAnnCO (InjectivityAnn GhcPs)
 -> WithComments Injectivity)
-> Maybe (GenLocated EpAnnCO (InjectivityAnn GhcPs))
-> Maybe (WithComments Injectivity)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((InjectivityAnn GhcPs -> Injectivity)
-> WithComments (InjectivityAnn GhcPs) -> WithComments Injectivity
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InjectivityAnn GhcPs -> Injectivity
mkInjectivity (WithComments (InjectivityAnn GhcPs) -> WithComments Injectivity)
-> (GenLocated EpAnnCO (InjectivityAnn GhcPs)
    -> WithComments (InjectivityAnn GhcPs))
-> GenLocated EpAnnCO (InjectivityAnn GhcPs)
-> WithComments Injectivity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated EpAnnCO (InjectivityAnn GhcPs)
-> WithComments (InjectivityAnn GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) Maybe (LInjectivityAnn GhcPs)
Maybe (GenLocated EpAnnCO (InjectivityAnn GhcPs))
fdInjectivityAnn
    equations :: Maybe
  [WithComments
     (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
equations =
      case FamilyInfo GhcPs
fdInfo of
        FamilyInfo GhcPs
GHC.DataFamily -> String
-> Maybe
     [WithComments
        (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
forall a. HasCallStack => String -> a
error String
"Not a TypeFamily"
        FamilyInfo GhcPs
GHC.OpenTypeFamily -> Maybe
  [WithComments
     (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
forall a. Maybe a
Nothing
        GHC.ClosedTypeFamily Maybe [LTyFamInstEqn GhcPs]
Nothing -> [WithComments
   (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
-> Maybe
     [WithComments
        (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
forall a. a -> Maybe a
Just []
        GHC.ClosedTypeFamily (Just [LTyFamInstEqn GhcPs]
xs) -> [WithComments
   (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
-> Maybe
     [WithComments
        (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
forall a. a -> Maybe a
Just ([WithComments
    (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
 -> Maybe
      [WithComments
         (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))])
-> [WithComments
      (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
-> Maybe
     [WithComments
        (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
 -> WithComments
      (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))))
-> [GenLocated
      SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
-> [WithComments
      (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated
  SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> WithComments
     (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated [LTyFamInstEqn GhcPs]
[GenLocated
   SrcSpanAnnA (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))]
xs