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

module HIndent.Ast.Import
  ( Import
  , mkImport
  , sortByName
  ) where

import Control.Monad
import Data.Function
import Data.List
import qualified GHC.Types.SourceText as GHC
import qualified GHC.Unit as GHC
import HIndent.Applicative
import HIndent.Ast.Import.Entry.Collection
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC
import qualified HIndent.GhcLibParserWrapper.GHC.Hs.ImpExp as GHC
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments

data QualificationPosition
  = Pre
  | Post
  deriving (QualificationPosition -> QualificationPosition -> Bool
(QualificationPosition -> QualificationPosition -> Bool)
-> (QualificationPosition -> QualificationPosition -> Bool)
-> Eq QualificationPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QualificationPosition -> QualificationPosition -> Bool
== :: QualificationPosition -> QualificationPosition -> Bool
$c/= :: QualificationPosition -> QualificationPosition -> Bool
/= :: QualificationPosition -> QualificationPosition -> Bool
Eq)

data Qualification = Qualification
  { Qualification -> Maybe (XRec GhcPs ModuleName)
qualifiedAs :: Maybe (GHC.XRec GHC.GhcPs GHC.ModuleName)
  , Qualification -> QualificationPosition
position :: QualificationPosition
  } deriving (Qualification -> Qualification -> Bool
(Qualification -> Qualification -> Bool)
-> (Qualification -> Qualification -> Bool) -> Eq Qualification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Qualification -> Qualification -> Bool
== :: Qualification -> Qualification -> Bool
$c/= :: Qualification -> Qualification -> Bool
/= :: Qualification -> Qualification -> Bool
Eq)

data Import = Import
  { Import -> XRec GhcPs ModuleName
moduleName :: GHC.XRec GHC.GhcPs GHC.ModuleName
  , Import -> Bool
isSafe :: Bool
  , Import -> Bool
isBoot :: Bool
  , Import -> Maybe Qualification
qualification :: Maybe Qualification
  , Import -> Maybe StringLiteral
packageName :: Maybe GHC.StringLiteral
  , Import -> Maybe (WithComments ImportEntryCollection)
importEntries :: Maybe (WithComments ImportEntryCollection)
  }

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

instance Pretty Import where
  pretty' :: Import -> Printer ()
pretty' Import {Bool
Maybe StringLiteral
Maybe (WithComments ImportEntryCollection)
Maybe Qualification
XRec GhcPs ModuleName
moduleName :: Import -> XRec GhcPs ModuleName
isSafe :: Import -> Bool
isBoot :: Import -> Bool
qualification :: Import -> Maybe Qualification
packageName :: Import -> Maybe StringLiteral
importEntries :: Import -> Maybe (WithComments ImportEntryCollection)
moduleName :: XRec GhcPs ModuleName
isSafe :: Bool
isBoot :: Bool
qualification :: Maybe Qualification
packageName :: Maybe StringLiteral
importEntries :: Maybe (WithComments ImportEntryCollection)
..} = do
    HasCallStack => String -> Printer ()
String -> Printer ()
string String
"import "
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isBoot (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"{-# SOURCE #-} "
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSafe (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"safe "
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Qualification -> QualificationPosition)
-> Maybe Qualification -> Maybe QualificationPosition
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Qualification -> QualificationPosition
position Maybe Qualification
qualification Maybe QualificationPosition -> Maybe QualificationPosition -> Bool
forall a. Eq a => a -> a -> Bool
== QualificationPosition -> Maybe QualificationPosition
forall a. a -> Maybe a
Just QualificationPosition
Pre) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
"qualified "
    Maybe StringLiteral -> (StringLiteral -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe StringLiteral
packageName ((StringLiteral -> Printer ()) -> Printer ())
-> (StringLiteral -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \StringLiteral
name -> StringLiteral -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty StringLiteral
name 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 ()
space
    GenLocated SrcSpanAnnA ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
moduleName
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Qualification -> QualificationPosition)
-> Maybe Qualification -> Maybe QualificationPosition
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Qualification -> QualificationPosition
position Maybe Qualification
qualification Maybe QualificationPosition -> Maybe QualificationPosition -> Bool
forall a. Eq a => a -> a -> Bool
== QualificationPosition -> Maybe QualificationPosition
forall a. a -> Maybe a
Just QualificationPosition
Post) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Printer ()
String -> Printer ()
string String
" qualified"
    case Maybe Qualification
qualification of
      Just Qualification {qualifiedAs :: Qualification -> Maybe (XRec GhcPs ModuleName)
qualifiedAs = Just XRec GhcPs ModuleName
name} ->
        HasCallStack => String -> Printer ()
String -> Printer ()
string String
" as " Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
name
      Maybe Qualification
_ -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Maybe (WithComments ImportEntryCollection)
-> (WithComments ImportEntryCollection -> Printer ()) -> Printer ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (WithComments ImportEntryCollection)
importEntries WithComments ImportEntryCollection -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty

mkImport :: GHC.ImportDecl GHC.GhcPs -> Import
mkImport :: ImportDecl GhcPs -> Import
mkImport decl :: ImportDecl GhcPs
decl@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
..} = Import {Bool
Maybe StringLiteral
Maybe (WithComments ImportEntryCollection)
Maybe Qualification
XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
moduleName :: XRec GhcPs ModuleName
isSafe :: Bool
isBoot :: Bool
qualification :: Maybe Qualification
packageName :: Maybe StringLiteral
importEntries :: Maybe (WithComments ImportEntryCollection)
moduleName :: GenLocated SrcSpanAnnA ModuleName
isSafe :: Bool
isBoot :: Bool
qualification :: Maybe Qualification
packageName :: Maybe StringLiteral
importEntries :: Maybe (WithComments ImportEntryCollection)
..}
  where
    moduleName :: XRec GhcPs ModuleName
moduleName = XRec GhcPs ModuleName
ideclName
    isSafe :: Bool
isSafe = Bool
ideclSafe
    isBoot :: Bool
isBoot = IsBootInterface
ideclSource IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
GHC.IsBoot
    qualification :: Maybe Qualification
qualification =
      case (ImportDeclQualifiedStyle
ideclQualified, Maybe (XRec GhcPs ModuleName)
Maybe (GenLocated SrcSpanAnnA ModuleName)
ideclAs, ImportDeclQualifiedStyle
ideclQualified) of
        (ImportDeclQualifiedStyle
GHC.NotQualified, Maybe (GenLocated SrcSpanAnnA ModuleName)
_, ImportDeclQualifiedStyle
_) -> Maybe Qualification
forall a. Maybe a
Nothing
        (ImportDeclQualifiedStyle
_, Maybe (GenLocated SrcSpanAnnA ModuleName)
Nothing, ImportDeclQualifiedStyle
GHC.QualifiedPre) ->
          Qualification -> Maybe Qualification
forall a. a -> Maybe a
Just Qualification {qualifiedAs :: Maybe (XRec GhcPs ModuleName)
qualifiedAs = Maybe (XRec GhcPs ModuleName)
Maybe (GenLocated SrcSpanAnnA ModuleName)
forall a. Maybe a
Nothing, position :: QualificationPosition
position = QualificationPosition
Pre}
        (ImportDeclQualifiedStyle
_, Maybe (GenLocated SrcSpanAnnA ModuleName)
Nothing, ImportDeclQualifiedStyle
GHC.QualifiedPost) ->
          Qualification -> Maybe Qualification
forall a. a -> Maybe a
Just Qualification {qualifiedAs :: Maybe (XRec GhcPs ModuleName)
qualifiedAs = Maybe (XRec GhcPs ModuleName)
Maybe (GenLocated SrcSpanAnnA ModuleName)
forall a. Maybe a
Nothing, position :: QualificationPosition
position = QualificationPosition
Post}
        (ImportDeclQualifiedStyle
_, Just GenLocated SrcSpanAnnA ModuleName
name, ImportDeclQualifiedStyle
GHC.QualifiedPre) ->
          Qualification -> Maybe Qualification
forall a. a -> Maybe a
Just Qualification {qualifiedAs :: Maybe (XRec GhcPs ModuleName)
qualifiedAs = GenLocated SrcSpanAnnA ModuleName
-> Maybe (GenLocated SrcSpanAnnA ModuleName)
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA ModuleName
name, position :: QualificationPosition
position = QualificationPosition
Pre}
        (ImportDeclQualifiedStyle
_, Just GenLocated SrcSpanAnnA ModuleName
name, ImportDeclQualifiedStyle
GHC.QualifiedPost) ->
          Qualification -> Maybe Qualification
forall a. a -> Maybe a
Just Qualification {qualifiedAs :: Maybe (XRec GhcPs ModuleName)
qualifiedAs = GenLocated SrcSpanAnnA ModuleName
-> Maybe (GenLocated SrcSpanAnnA ModuleName)
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA ModuleName
name, position :: QualificationPosition
position = QualificationPosition
Post}
    packageName :: Maybe StringLiteral
packageName = ImportDecl GhcPs -> Maybe StringLiteral
GHC.getPackageName ImportDecl GhcPs
decl
    importEntries :: Maybe (WithComments ImportEntryCollection)
importEntries = ImportDecl GhcPs -> Maybe (WithComments ImportEntryCollection)
mkImportEntryCollection ImportDecl GhcPs
decl

sortByName :: [WithComments Import] -> [WithComments Import]
sortByName :: [WithComments Import] -> [WithComments Import]
sortByName = (WithComments Import -> WithComments Import)
-> [WithComments Import] -> [WithComments Import]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments Import -> WithComments Import
sortExplicitImportsInDecl ([WithComments Import] -> [WithComments Import])
-> ([WithComments Import] -> [WithComments Import])
-> [WithComments Import]
-> [WithComments Import]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WithComments Import] -> [WithComments Import]
sortByModuleName

-- | This function sorts import declarations by their module names.
sortByModuleName :: [WithComments Import] -> [WithComments Import]
sortByModuleName :: [WithComments Import] -> [WithComments Import]
sortByModuleName = (WithComments Import -> WithComments Import -> Ordering)
-> [WithComments Import] -> [WithComments Import]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> Ordering)
-> (WithComments Import -> String)
-> WithComments Import
-> WithComments Import
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA ModuleName -> String
forall a. Outputable a => a -> String
showOutputable (GenLocated SrcSpanAnnA ModuleName -> String)
-> (WithComments Import -> GenLocated SrcSpanAnnA ModuleName)
-> WithComments Import
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> XRec GhcPs ModuleName
Import -> GenLocated SrcSpanAnnA ModuleName
moduleName (Import -> GenLocated SrcSpanAnnA ModuleName)
-> (WithComments Import -> Import)
-> WithComments Import
-> GenLocated SrcSpanAnnA ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithComments Import -> Import
forall a. WithComments a -> a
getNode)

-- | This function sorts explicit imports in the given import declaration
-- by their names.
sortExplicitImportsInDecl :: WithComments Import -> WithComments Import
sortExplicitImportsInDecl :: WithComments Import -> WithComments Import
sortExplicitImportsInDecl = (Import -> Import) -> WithComments Import -> WithComments Import
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Import -> Import
f
  where
    f :: Import -> Import
f (Import {importEntries :: Import -> Maybe (WithComments ImportEntryCollection)
importEntries = Just WithComments ImportEntryCollection
xs, Bool
Maybe StringLiteral
Maybe Qualification
XRec GhcPs ModuleName
moduleName :: Import -> XRec GhcPs ModuleName
isSafe :: Import -> Bool
isBoot :: Import -> Bool
qualification :: Import -> Maybe Qualification
packageName :: Import -> Maybe StringLiteral
moduleName :: XRec GhcPs ModuleName
isSafe :: Bool
isBoot :: Bool
qualification :: Maybe Qualification
packageName :: Maybe StringLiteral
..}) =
      Import {importEntries :: Maybe (WithComments ImportEntryCollection)
importEntries = WithComments ImportEntryCollection
-> Maybe (WithComments ImportEntryCollection)
forall a. a -> Maybe a
Just WithComments ImportEntryCollection
sorted, Bool
Maybe StringLiteral
Maybe Qualification
XRec GhcPs ModuleName
moduleName :: XRec GhcPs ModuleName
isSafe :: Bool
isBoot :: Bool
qualification :: Maybe Qualification
packageName :: Maybe StringLiteral
moduleName :: XRec GhcPs ModuleName
isSafe :: Bool
isBoot :: Bool
qualification :: Maybe Qualification
packageName :: Maybe StringLiteral
..}
      where
        sorted :: WithComments ImportEntryCollection
sorted = (ImportEntryCollection -> ImportEntryCollection)
-> WithComments ImportEntryCollection
-> WithComments ImportEntryCollection
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImportEntryCollection -> ImportEntryCollection
sortEntriesByName WithComments ImportEntryCollection
xs
    f Import
x = Import
x