{-# 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 (WithComments ModuleName)
qualifiedAs :: Maybe (WithComments 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 -> WithComments ModuleName
moduleName :: WithComments 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
WithComments ModuleName
moduleName :: Import -> WithComments ModuleName
isSafe :: Import -> Bool
isBoot :: Import -> Bool
qualification :: Import -> Maybe Qualification
packageName :: Import -> Maybe StringLiteral
importEntries :: Import -> Maybe (WithComments ImportEntryCollection)
moduleName :: WithComments 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
    WithComments ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments 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 (WithComments ModuleName)
qualifiedAs = Just WithComments 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
>> WithComments ModuleName -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty WithComments 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
WithComments ModuleName
moduleName :: WithComments ModuleName
isSafe :: Bool
isBoot :: Bool
qualification :: Maybe Qualification
packageName :: Maybe StringLiteral
importEntries :: Maybe (WithComments ImportEntryCollection)
moduleName :: WithComments ModuleName
isSafe :: Bool
isBoot :: Bool
qualification :: Maybe Qualification
packageName :: Maybe StringLiteral
importEntries :: Maybe (WithComments ImportEntryCollection)
..}
  where
    moduleName :: WithComments ModuleName
moduleName = GenLocated SrcSpanAnnA ModuleName -> WithComments ModuleName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated XRec GhcPs ModuleName
GenLocated SrcSpanAnnA 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 (WithComments ModuleName)
qualifiedAs = Maybe (WithComments 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 (WithComments ModuleName)
qualifiedAs = Maybe (WithComments 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 (WithComments ModuleName)
qualifiedAs = WithComments ModuleName -> Maybe (WithComments ModuleName)
forall a. a -> Maybe a
Just (WithComments ModuleName -> Maybe (WithComments ModuleName))
-> WithComments ModuleName -> Maybe (WithComments ModuleName)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA ModuleName -> WithComments ModuleName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated 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 (WithComments ModuleName)
qualifiedAs = WithComments ModuleName -> Maybe (WithComments ModuleName)
forall a. a -> Maybe a
Just (WithComments ModuleName -> Maybe (WithComments ModuleName))
-> WithComments ModuleName -> Maybe (WithComments ModuleName)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA ModuleName -> WithComments ModuleName
forall l a. CommentExtraction l => GenLocated l a -> WithComments a
fromGenLocated 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` ModuleName -> String
forall a. Outputable a => a -> String
showOutputable (ModuleName -> String)
-> (WithComments Import -> ModuleName)
-> WithComments Import
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithComments ModuleName -> ModuleName
forall a. WithComments a -> a
getNode (WithComments ModuleName -> ModuleName)
-> (WithComments Import -> WithComments ModuleName)
-> WithComments Import
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> WithComments ModuleName
moduleName (Import -> WithComments ModuleName)
-> (WithComments Import -> Import)
-> WithComments Import
-> WithComments 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
WithComments ModuleName
moduleName :: Import -> WithComments ModuleName
isSafe :: Import -> Bool
isBoot :: Import -> Bool
qualification :: Import -> Maybe Qualification
packageName :: Import -> Maybe StringLiteral
moduleName :: WithComments 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
WithComments ModuleName
moduleName :: WithComments ModuleName
isSafe :: Bool
isBoot :: Bool
qualification :: Maybe Qualification
packageName :: Maybe StringLiteral
moduleName :: WithComments 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