module HIndent.Ast.Module.Export.Collection
  ( ExportCollection
  , mkExportCollection
  ) where

import HIndent.Ast.Module.Export.Entry
import HIndent.Ast.NodeComments hiding (fromEpAnn)
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

newtype ExportCollection =
  ExportCollection [WithComments ExportEntry]

instance CommentExtraction ExportCollection where
  nodeComments :: ExportCollection -> NodeComments
nodeComments (ExportCollection [WithComments ExportEntry]
_) = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty ExportCollection where
  pretty' :: ExportCollection -> Printer ()
pretty' (ExportCollection [WithComments ExportEntry]
xs) = [Printer ()] -> Printer ()
vTuple ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments ExportEntry -> Printer ())
-> [WithComments ExportEntry] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments ExportEntry -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments ExportEntry]
xs

mkExportCollection :: GHC.HsModule' -> Maybe (WithComments ExportCollection)
mkExportCollection :: HsModule' -> Maybe (WithComments ExportCollection)
mkExportCollection =
  (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
 -> WithComments ExportCollection)
-> Maybe
     (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe (WithComments ExportCollection)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (([GenLocated SrcSpanAnnA (IE GhcPs)] -> ExportCollection)
-> WithComments [GenLocated SrcSpanAnnA (IE GhcPs)]
-> WithComments ExportCollection
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([WithComments ExportEntry] -> ExportCollection
ExportCollection ([WithComments ExportEntry] -> ExportCollection)
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
    -> [WithComments ExportEntry])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> ExportCollection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (IE GhcPs) -> WithComments ExportEntry)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [WithComments ExportEntry]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IE GhcPs -> ExportEntry)
-> WithComments (IE GhcPs) -> WithComments ExportEntry
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IE GhcPs -> ExportEntry
mkExportEntry (WithComments (IE GhcPs) -> WithComments ExportEntry)
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> WithComments (IE GhcPs))
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> WithComments ExportEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> WithComments (IE GhcPs)
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated))
       (WithComments [GenLocated SrcSpanAnnA (IE GhcPs)]
 -> WithComments ExportCollection)
-> (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> WithComments [GenLocated SrcSpanAnnA (IE GhcPs)])
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> WithComments ExportCollection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> WithComments [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated)
    (Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
 -> Maybe (WithComments ExportCollection))
-> (HsModule'
    -> Maybe
         (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> HsModule'
-> Maybe (WithComments ExportCollection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule' -> Maybe (XRec GhcPs [LIE GhcPs])
HsModule'
-> Maybe
     (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall p. HsModule p -> Maybe (XRec p [LIE p])
GHC.hsmodExports