{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Module.Declaration
  ( ModuleDeclaration
  , mkModuleDeclaration
  ) where

import HIndent.Applicative
import HIndent.Ast.Module.Export.Collection
import HIndent.Ast.Module.Name
import HIndent.Ast.Module.Warning
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data ModuleDeclaration = ModuleDeclaration
  { ModuleDeclaration -> WithComments ModuleName
name :: WithComments ModuleName
  , ModuleDeclaration -> Maybe (WithComments ModuleWarning)
warning :: Maybe (WithComments ModuleWarning)
  , ModuleDeclaration -> Maybe (WithComments ExportCollection)
exports :: Maybe (WithComments ExportCollection)
  }

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

instance Pretty ModuleDeclaration where
  pretty' :: ModuleDeclaration -> Printer ()
pretty' ModuleDeclaration {Maybe (WithComments ExportCollection)
Maybe (WithComments ModuleWarning)
WithComments ModuleName
name :: ModuleDeclaration -> WithComments ModuleName
warning :: ModuleDeclaration -> Maybe (WithComments ModuleWarning)
exports :: ModuleDeclaration -> Maybe (WithComments ExportCollection)
name :: WithComments ModuleName
warning :: Maybe (WithComments ModuleWarning)
exports :: Maybe (WithComments ExportCollection)
..} = do
    WithComments ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments ModuleName
name
    Maybe (WithComments ModuleWarning)
-> (WithComments ModuleWarning -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (WithComments ModuleWarning)
warning ((WithComments ModuleWarning -> Printer ()) -> Printer ())
-> (WithComments ModuleWarning -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \WithComments ModuleWarning
x -> do
      Printer ()
space
      WithComments ModuleWarning -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments ModuleWarning
x
    Maybe (WithComments ExportCollection)
-> (WithComments ExportCollection -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (WithComments ExportCollection)
exports ((WithComments ExportCollection -> Printer ()) -> Printer ())
-> (WithComments ExportCollection -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \WithComments ExportCollection
x -> do
      Printer ()
newline
      Printer () -> Printer ()
forall a. Printer a -> Printer a
indentedBlock (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ WithComments ExportCollection -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments ExportCollection
x
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
" where"

mkModuleDeclaration :: GHC.HsModule' -> Maybe ModuleDeclaration
mkModuleDeclaration :: HsModule' -> Maybe ModuleDeclaration
mkModuleDeclaration HsModule'
m =
  case HsModule' -> Maybe (XRec GhcPs ModuleName)
forall p. HsModule p -> Maybe (XRec p ModuleName)
GHC.hsmodName HsModule'
m of
    Maybe (XRec GhcPs ModuleName)
Nothing -> Maybe ModuleDeclaration
forall a. Maybe a
Nothing
    Just XRec GhcPs ModuleName
name' -> ModuleDeclaration -> Maybe ModuleDeclaration
forall a. a -> Maybe a
Just ModuleDeclaration {Maybe (WithComments ExportCollection)
Maybe (WithComments ModuleWarning)
WithComments ModuleName
name :: WithComments ModuleName
warning :: Maybe (WithComments ModuleWarning)
exports :: Maybe (WithComments ExportCollection)
name :: WithComments ModuleName
warning :: Maybe (WithComments ModuleWarning)
exports :: Maybe (WithComments ExportCollection)
..}
      where name :: WithComments ModuleName
name = ModuleName -> ModuleName
mkModuleName (ModuleName -> ModuleName)
-> WithComments ModuleName -> WithComments ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenLocated SrcSpanAnnA ModuleName -> WithComments ModuleName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
name'
            warning :: Maybe (WithComments ModuleWarning)
warning = HsModule' -> Maybe (WithComments ModuleWarning)
mkModuleWarning HsModule'
m
            exports :: Maybe (WithComments ExportCollection)
exports = HsModule' -> Maybe (WithComments ExportCollection)
mkExportCollection HsModule'
m