{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Declaration.Class
  ( ClassDeclaration
  , mkClassDeclaration
  ) where

import Control.Monad
import Data.Maybe
import qualified GHC.Data.Bag as GHC
import HIndent.Applicative
import HIndent.Ast.Context
import HIndent.Ast.Declaration.Class.FunctionalDependency
import HIndent.Ast.Declaration.Class.NameAndTypeVariables
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
import HIndent.Pretty.SigBindFamily

data ClassDeclaration = ClassDeclaration
  { ClassDeclaration -> Maybe (WithComments Context)
context :: Maybe (WithComments Context)
  , ClassDeclaration -> NameAndTypeVariables
nameAndTypeVariables :: NameAndTypeVariables
  , ClassDeclaration -> [WithComments FunctionalDependency]
functionalDependencies :: [WithComments FunctionalDependency]
  , ClassDeclaration -> [LSigBindFamily]
associatedThings :: [LSigBindFamily]
  }

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

instance Pretty ClassDeclaration where
  pretty' :: ClassDeclaration -> Printer ()
pretty' ClassDeclaration {[LSigBindFamily]
[WithComments FunctionalDependency]
Maybe (WithComments Context)
NameAndTypeVariables
context :: ClassDeclaration -> Maybe (WithComments Context)
nameAndTypeVariables :: ClassDeclaration -> NameAndTypeVariables
functionalDependencies :: ClassDeclaration -> [WithComments FunctionalDependency]
associatedThings :: ClassDeclaration -> [LSigBindFamily]
context :: Maybe (WithComments Context)
nameAndTypeVariables :: NameAndTypeVariables
functionalDependencies :: [WithComments FunctionalDependency]
associatedThings :: [LSigBindFamily]
..} = do
    if Maybe (WithComments Context) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (WithComments Context)
context
      then Printer ()
verHead
      else Printer ()
horHead Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> Printer ()
verHead
    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
$ (LSigBindFamily -> Printer ()) -> [LSigBindFamily] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LSigBindFamily -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LSigBindFamily]
associatedThings
    where
      horHead :: Printer ()
horHead = do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
"class "
        NameAndTypeVariables -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty NameAndTypeVariables
nameAndTypeVariables
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([WithComments FunctionalDependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WithComments FunctionalDependency]
functionalDependencies)
          (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> 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 ()] -> Printer ()
hCommaSep ((WithComments FunctionalDependency -> Printer ())
-> [WithComments FunctionalDependency] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments FunctionalDependency -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments FunctionalDependency]
functionalDependencies)
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LSigBindFamily] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSigBindFamily]
associatedThings) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
" where"
      verHead :: Printer ()
verHead = do
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
"class " 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
ctx -> WithComments Context -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments Context
ctx 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
          NameAndTypeVariables -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty NameAndTypeVariables
nameAndTypeVariables
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([WithComments FunctionalDependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WithComments FunctionalDependency]
functionalDependencies) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
          Printer ()
newline
          Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock
            (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"| " Printer () -> Printer () -> Printer ()
forall a. Printer () -> Printer a -> Printer a
|=> [Printer ()] -> Printer ()
vCommaSep ((WithComments FunctionalDependency -> Printer ())
-> [WithComments FunctionalDependency] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments FunctionalDependency -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments FunctionalDependency]
functionalDependencies)
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LSigBindFamily] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSigBindFamily]
associatedThings)
          (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> 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 (HasCallStack => String -> Printer ()
String -> Printer ()
string String
"where")

mkClassDeclaration :: GHC.TyClDecl GHC.GhcPs -> Maybe ClassDeclaration
mkClassDeclaration :: TyClDecl GhcPs -> Maybe ClassDeclaration
mkClassDeclaration x :: TyClDecl GhcPs
x@GHC.ClassDecl {[LSig GhcPs]
[LDocDecl GhcPs]
[LTyFamDefltDecl GhcPs]
[LFamilyDecl GhcPs]
[LHsFunDep GhcPs]
Maybe (LHsContext GhcPs)
XClassDecl GhcPs
LIdP GhcPs
LHsBinds GhcPs
LexicalFixity
LHsQTyVars GhcPs
tcdCExt :: XClassDecl GhcPs
tcdCtxt :: Maybe (LHsContext GhcPs)
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdFDs :: [LHsFunDep GhcPs]
tcdSigs :: [LSig GhcPs]
tcdMeths :: LHsBinds GhcPs
tcdATs :: [LFamilyDecl GhcPs]
tcdATDefs :: [LTyFamDefltDecl GhcPs]
tcdDocs :: [LDocDecl GhcPs]
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdDocs :: forall pass. TyClDecl pass -> [LDocDecl pass]
tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCExt :: forall pass. TyClDecl pass -> XClassDecl pass
..}
  | Just NameAndTypeVariables
nameAndTypeVariables <- TyClDecl GhcPs -> Maybe NameAndTypeVariables
mkNameAndTypeVariables TyClDecl GhcPs
x =
    ClassDeclaration -> Maybe ClassDeclaration
forall a. a -> Maybe a
Just ClassDeclaration {[LSigBindFamily]
[WithComments FunctionalDependency]
Maybe (WithComments Context)
NameAndTypeVariables
context :: Maybe (WithComments Context)
nameAndTypeVariables :: NameAndTypeVariables
functionalDependencies :: [WithComments FunctionalDependency]
associatedThings :: [LSigBindFamily]
nameAndTypeVariables :: NameAndTypeVariables
context :: Maybe (WithComments Context)
functionalDependencies :: [WithComments FunctionalDependency]
associatedThings :: [LSigBindFamily]
..}
  where
    context :: Maybe (WithComments Context)
context = (GenLocated
   SrcSpanAnnC [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
 -> WithComments Context)
-> Maybe
     (GenLocated
        SrcSpanAnnC [GenLocated (EpAnn AnnListItem) (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 (EpAnn AnnListItem) (HsType GhcPs)] -> Context)
-> WithComments [GenLocated (EpAnn AnnListItem) (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 (EpAnn AnnListItem) (HsType GhcPs)] -> Context
mkContext (WithComments [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
 -> WithComments Context)
-> (GenLocated
      SrcSpanAnnC [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
    -> WithComments [GenLocated (EpAnn AnnListItem) (HsType GhcPs)])
-> GenLocated
     SrcSpanAnnC [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
-> WithComments Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnC [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
-> WithComments [GenLocated (EpAnn AnnListItem) (HsType GhcPs)]
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) Maybe (LHsContext GhcPs)
Maybe
  (GenLocated
     SrcSpanAnnC [GenLocated (EpAnn AnnListItem) (HsType GhcPs)])
tcdCtxt
    functionalDependencies :: [WithComments FunctionalDependency]
functionalDependencies =
      (GenLocated (EpAnn AnnListItem) (FunDep GhcPs)
 -> WithComments FunctionalDependency)
-> [GenLocated (EpAnn AnnListItem) (FunDep GhcPs)]
-> [WithComments FunctionalDependency]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FunDep GhcPs -> FunctionalDependency)
-> WithComments (FunDep GhcPs) -> WithComments FunctionalDependency
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FunDep GhcPs -> FunctionalDependency
mkFunctionalDependency (WithComments (FunDep GhcPs) -> WithComments FunctionalDependency)
-> (GenLocated (EpAnn AnnListItem) (FunDep GhcPs)
    -> WithComments (FunDep GhcPs))
-> GenLocated (EpAnn AnnListItem) (FunDep GhcPs)
-> WithComments FunctionalDependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (EpAnn AnnListItem) (FunDep GhcPs)
-> WithComments (FunDep GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated) [LHsFunDep GhcPs]
[GenLocated (EpAnn AnnListItem) (FunDep GhcPs)]
tcdFDs
    associatedThings :: [LSigBindFamily]
associatedThings =
      [LSig GhcPs]
-> [LHsBindLR GhcPs GhcPs]
-> [LFamilyDecl GhcPs]
-> [LTyFamDefltDecl GhcPs]
-> [LDataFamInstDecl GhcPs]
-> [LSigBindFamily]
mkSortedLSigBindFamilyList [LSig GhcPs]
tcdSigs (Bag (GenLocated (EpAnn AnnListItem) (HsBindLR GhcPs GhcPs))
-> [GenLocated (EpAnn AnnListItem) (HsBindLR GhcPs GhcPs)]
forall a. Bag a -> [a]
GHC.bagToList LHsBinds GhcPs
Bag (GenLocated (EpAnn AnnListItem) (HsBindLR GhcPs GhcPs))
tcdMeths) [LFamilyDecl GhcPs]
tcdATs [] []
mkClassDeclaration TyClDecl GhcPs
_ = Maybe ClassDeclaration
forall a. Maybe a
Nothing