{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Import.Entry.Collection
  ( ImportEntryCollection
  , mkImportEntryCollection
  , sortEntriesByName
  ) where

import Control.Monad
import qualified GHC.Hs as GHC
import HIndent.Ast.Import.Entry
import HIndent.Ast.Import.ImportingOrHiding
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data ImportEntryCollection = ImportEntryCollection
  { ImportEntryCollection -> [WithComments ImportEntry]
entries :: [WithComments ImportEntry]
  , ImportEntryCollection -> ImportingOrHiding
kind :: ImportingOrHiding
  }

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

instance Pretty ImportEntryCollection where
  pretty' :: ImportEntryCollection -> Printer ()
pretty' ImportEntryCollection {[WithComments ImportEntry]
ImportingOrHiding
entries :: ImportEntryCollection -> [WithComments ImportEntry]
kind :: ImportEntryCollection -> ImportingOrHiding
entries :: [WithComments ImportEntry]
kind :: ImportingOrHiding
..} = do
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ImportingOrHiding
kind ImportingOrHiding -> ImportingOrHiding -> Bool
forall a. Eq a => a -> a -> Bool
== ImportingOrHiding
Hiding) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
" hiding"
    (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
>> [Printer ()] -> Printer ()
hTuple ((WithComments ImportEntry -> Printer ())
-> [WithComments ImportEntry] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments ImportEntry -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments ImportEntry]
entries))
      Printer () -> Printer () -> Printer ()
forall a. Printer a -> Printer a -> Printer a
<-|> (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 ()
vTuple ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (WithComments ImportEntry -> Printer ())
-> [WithComments ImportEntry] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments ImportEntry -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [WithComments ImportEntry]
entries))

mkImportEntryCollection ::
     GHC.ImportDecl GHC.GhcPs -> Maybe (WithComments ImportEntryCollection)
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
mkImportEntryCollection :: ImportDecl GhcPs -> Maybe (WithComments ImportEntryCollection)
mkImportEntryCollection GHC.ImportDecl {Bool
Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Maybe (XRec GhcPs ModuleName)
ImportDeclPkgQual GhcPs
XCImportDecl GhcPs
XRec GhcPs ModuleName
IsBootInterface
ImportDeclQualifiedStyle
ideclExt :: XCImportDecl GhcPs
ideclName :: XRec GhcPs ModuleName
ideclPkgQual :: ImportDeclPkgQual GhcPs
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclAs :: Maybe (XRec GhcPs ModuleName)
ideclImportList :: Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
..} =
  case Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
ideclImportList of
    Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
Nothing -> Maybe (WithComments ImportEntryCollection)
forall a. Maybe a
Nothing
    Just (ImportListInterpretation
GHC.Exactly, XRec GhcPs [LIE GhcPs]
xs) ->
      WithComments ImportEntryCollection
-> Maybe (WithComments ImportEntryCollection)
forall a. a -> Maybe a
Just
        (WithComments ImportEntryCollection
 -> Maybe (WithComments ImportEntryCollection))
-> WithComments ImportEntryCollection
-> Maybe (WithComments ImportEntryCollection)
forall a b. (a -> b) -> a -> b
$ ([WithComments ImportEntry] -> ImportEntryCollection)
-> WithComments [WithComments ImportEntry]
-> WithComments ImportEntryCollection
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[WithComments ImportEntry]
entries -> ImportEntryCollection {kind :: ImportingOrHiding
kind = ImportingOrHiding
Importing, [WithComments ImportEntry]
entries :: [WithComments ImportEntry]
entries :: [WithComments ImportEntry]
..})
        (WithComments [WithComments ImportEntry]
 -> WithComments ImportEntryCollection)
-> WithComments [WithComments ImportEntry]
-> WithComments ImportEntryCollection
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnL [WithComments ImportEntry]
-> WithComments [WithComments ImportEntry]
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated
        (GenLocated SrcSpanAnnL [WithComments ImportEntry]
 -> WithComments [WithComments ImportEntry])
-> GenLocated SrcSpanAnnL [WithComments ImportEntry]
-> WithComments [WithComments ImportEntry]
forall a b. (a -> b) -> a -> b
$ ([GenLocated SrcSpanAnnA (IE GhcPs)] -> [WithComments ImportEntry])
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> GenLocated SrcSpanAnnL [WithComments ImportEntry]
forall a b.
(a -> b) -> GenLocated SrcSpanAnnL a -> GenLocated SrcSpanAnnL b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GenLocated SrcSpanAnnA (IE GhcPs) -> WithComments ImportEntry)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [WithComments ImportEntry]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IE GhcPs -> ImportEntry)
-> WithComments (IE GhcPs) -> WithComments ImportEntry
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IE GhcPs -> ImportEntry
mkImportEntry (WithComments (IE GhcPs) -> WithComments ImportEntry)
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> WithComments (IE GhcPs))
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> WithComments ImportEntry
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)) XRec GhcPs [LIE GhcPs]
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
xs
    Just (ImportListInterpretation
GHC.EverythingBut, XRec GhcPs [LIE GhcPs]
xs) ->
      WithComments ImportEntryCollection
-> Maybe (WithComments ImportEntryCollection)
forall a. a -> Maybe a
Just
        (WithComments ImportEntryCollection
 -> Maybe (WithComments ImportEntryCollection))
-> WithComments ImportEntryCollection
-> Maybe (WithComments ImportEntryCollection)
forall a b. (a -> b) -> a -> b
$ ([WithComments ImportEntry] -> ImportEntryCollection)
-> WithComments [WithComments ImportEntry]
-> WithComments ImportEntryCollection
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[WithComments ImportEntry]
entries -> ImportEntryCollection {kind :: ImportingOrHiding
kind = ImportingOrHiding
Hiding, [WithComments ImportEntry]
entries :: [WithComments ImportEntry]
entries :: [WithComments ImportEntry]
..})
        (WithComments [WithComments ImportEntry]
 -> WithComments ImportEntryCollection)
-> WithComments [WithComments ImportEntry]
-> WithComments ImportEntryCollection
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnL [WithComments ImportEntry]
-> WithComments [WithComments ImportEntry]
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated
        (GenLocated SrcSpanAnnL [WithComments ImportEntry]
 -> WithComments [WithComments ImportEntry])
-> GenLocated SrcSpanAnnL [WithComments ImportEntry]
-> WithComments [WithComments ImportEntry]
forall a b. (a -> b) -> a -> b
$ ([GenLocated SrcSpanAnnA (IE GhcPs)] -> [WithComments ImportEntry])
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> GenLocated SrcSpanAnnL [WithComments ImportEntry]
forall a b.
(a -> b) -> GenLocated SrcSpanAnnL a -> GenLocated SrcSpanAnnL b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GenLocated SrcSpanAnnA (IE GhcPs) -> WithComments ImportEntry)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [WithComments ImportEntry]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IE GhcPs -> ImportEntry)
-> WithComments (IE GhcPs) -> WithComments ImportEntry
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IE GhcPs -> ImportEntry
mkImportEntry (WithComments (IE GhcPs) -> WithComments ImportEntry)
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> WithComments (IE GhcPs))
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> WithComments ImportEntry
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)) XRec GhcPs [LIE GhcPs]
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
xs
#else
mkImportEntryCollection GHC.ImportDecl {..} =
  case ideclHiding of
    Nothing -> Nothing
    Just (False, xs) ->
      Just
        $ fmap (\entries -> ImportEntryCollection {kind = Importing, ..})
        $ fromGenLocated
        $ fmap (fmap (fmap mkImportEntry . fromGenLocated)) xs
    Just (True, xs) ->
      Just
        $ fmap (\entries -> ImportEntryCollection {kind = Hiding, ..})
        $ fromGenLocated
        $ fmap (fmap (fmap mkImportEntry . fromGenLocated)) xs
#endif
sortEntriesByName :: ImportEntryCollection -> ImportEntryCollection
sortEntriesByName :: ImportEntryCollection -> ImportEntryCollection
sortEntriesByName ImportEntryCollection {[WithComments ImportEntry]
ImportingOrHiding
entries :: ImportEntryCollection -> [WithComments ImportEntry]
kind :: ImportEntryCollection -> ImportingOrHiding
entries :: [WithComments ImportEntry]
kind :: ImportingOrHiding
..} =
  ImportEntryCollection {entries :: [WithComments ImportEntry]
entries = [WithComments ImportEntry] -> [WithComments ImportEntry]
sortVariantsAndExplicitImports [WithComments ImportEntry]
entries, ImportingOrHiding
kind :: ImportingOrHiding
kind :: ImportingOrHiding
..}