{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Language.Haskell.Stylish.Module
  ( -- * Data types
    Module (..)
  , ModuleHeader
  , Import
  , Decls
  , Comments
  , Lines
  , makeModule

    -- * Getters
  , moduleHeader
  , moduleImports
  , moduleImportGroups
  , moduleDecls
  , moduleComments
  , moduleLanguagePragmas
  , queryModule
  , groupByLine

    -- * Imports
  , canMergeImport
  , mergeModuleImport

    -- * Annotations
  , lookupAnnotation

    -- * Internal API getters
  , rawComments
  , rawImport
  , rawModuleAnnotations
  , rawModuleDecls
  , rawModuleExports
  , rawModuleHaddocks
  , rawModuleName
  ) where

--------------------------------------------------------------------------------
import           Data.Function                   ((&), on)
import           Data.Functor                    ((<&>))
import           Data.Generics                   (Typeable, everything, mkQ)
import           Data.Maybe                      (mapMaybe)
import           Data.Map                        (Map)
import qualified Data.Map                        as Map
import           Data.List                       (nubBy, sort)
import           Data.List.NonEmpty              (NonEmpty (..), nonEmpty)
import           Data.Text                       (Text)
import qualified Data.Text                       as T
import           Data.Data                       (Data)

--------------------------------------------------------------------------------
import qualified ApiAnnotation                   as GHC
import qualified Lexer                           as GHC
import           GHC.Hs                          (ImportDecl(..), ImportDeclQualifiedStyle(..))
import qualified GHC.Hs                          as GHC
import           GHC.Hs.Extension                (GhcPs)
import           GHC.Hs.Decls                    (LHsDecl)
import           Outputable                      (Outputable)
import           SrcLoc                          (GenLocated(..), RealLocated)
import           SrcLoc                          (RealSrcSpan(..), SrcSpan(..))
import           SrcLoc                          (Located)
import qualified SrcLoc                          as GHC
import qualified Module                          as GHC

--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.GHC

--------------------------------------------------------------------------------
type Lines = [String]


--------------------------------------------------------------------------------
-- | Concrete module type
data Module = Module
  { Module -> [RealLocated AnnotationComment]
parsedComments :: [GHC.RealLocated GHC.AnnotationComment]
  , Module -> [(ApiAnnKey, [SrcSpan])]
parsedAnnotations :: [(GHC.ApiAnnKey, [GHC.SrcSpan])]
  , Module -> Map RealSrcSpan [AnnKeywordId]
parsedAnnotSrcs :: Map RealSrcSpan [GHC.AnnKeywordId]
  , Module -> Located (HsModule GhcPs)
parsedModule :: GHC.Located (GHC.HsModule GhcPs)
  } deriving (Typeable Module
DataType
Constr
Typeable Module
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Module -> c Module)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Module)
-> (Module -> Constr)
-> (Module -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Module))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module))
-> ((forall b. Data b => b -> b) -> Module -> Module)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Module -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Module -> r)
-> (forall u. (forall d. Data d => d -> u) -> Module -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Module -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Module -> m Module)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Module -> m Module)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Module -> m Module)
-> Data Module
Module -> DataType
Module -> Constr
(forall b. Data b => b -> b) -> Module -> Module
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Module -> u
forall u. (forall d. Data d => d -> u) -> Module -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Module -> m Module
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Module)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module)
$cModule :: Constr
$tModule :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Module -> m Module
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
gmapMp :: (forall d. Data d => d -> m d) -> Module -> m Module
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
gmapM :: (forall d. Data d => d -> m d) -> Module -> m Module
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Module -> m Module
gmapQi :: Int -> (forall d. Data d => d -> u) -> Module -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Module -> u
gmapQ :: (forall d. Data d => d -> u) -> Module -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Module -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
gmapT :: (forall b. Data b => b -> b) -> Module -> Module
$cgmapT :: (forall b. Data b => b -> b) -> Module -> Module
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Module)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Module)
dataTypeOf :: Module -> DataType
$cdataTypeOf :: Module -> DataType
toConstr :: Module -> Constr
$ctoConstr :: Module -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
$cp1Data :: Typeable Module
Data)

-- | Declarations in module
newtype Decls = Decls [LHsDecl GhcPs]

-- | Import declaration in module
newtype Import = Import { Import -> ImportDecl GhcPs
unImport :: ImportDecl GhcPs }
  deriving newtype (Rational -> Import -> SDoc
Import -> SDoc
(Import -> SDoc)
-> (Rational -> Import -> SDoc) -> Outputable Import
forall a. (a -> SDoc) -> (Rational -> a -> SDoc) -> Outputable a
pprPrec :: Rational -> Import -> SDoc
$cpprPrec :: Rational -> Import -> SDoc
ppr :: Import -> SDoc
$cppr :: Import -> SDoc
Outputable)

-- | Returns true if the two import declarations can be merged
canMergeImport :: Import -> Import -> Bool
canMergeImport :: Import -> Import -> Bool
canMergeImport (Import ImportDecl GhcPs
i0) (Import ImportDecl GhcPs
i1) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ((ImportDecl GhcPs -> ImportDecl GhcPs -> Bool) -> Bool)
-> [ImportDecl GhcPs -> ImportDecl GhcPs -> Bool] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
f -> ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
f ImportDecl GhcPs
i0 ImportDecl GhcPs
i1)
  [ ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ModuleName -> ModuleName -> Bool)
-> (ImportDecl GhcPs -> ModuleName)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Located ModuleName -> ModuleName
forall a. Located a -> a
unLocated (Located ModuleName -> ModuleName)
-> (ImportDecl GhcPs -> Located ModuleName)
-> ImportDecl GhcPs
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName
  , Maybe StringLiteral -> Maybe StringLiteral -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe StringLiteral -> Maybe StringLiteral -> Bool)
-> (ImportDecl GhcPs -> Maybe StringLiteral)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual
  , Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Bool -> Bool -> Bool)
-> (ImportDecl GhcPs -> Bool)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
ideclSource
  , ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
hasMergableQualified (ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool)
-> (ImportDecl GhcPs -> ImportDeclQualifiedStyle)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified
  , Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Bool -> Bool -> Bool)
-> (ImportDecl GhcPs -> Bool)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
ideclImplicit
  , Maybe ModuleName -> Maybe ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe ModuleName -> Maybe ModuleName -> Bool)
-> (ImportDecl GhcPs -> Maybe ModuleName)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Located ModuleName -> ModuleName)
-> Maybe (Located ModuleName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located ModuleName -> ModuleName
forall a. Located a -> a
unLocated (Maybe (Located ModuleName) -> Maybe ModuleName)
-> (ImportDecl GhcPs -> Maybe (Located ModuleName))
-> ImportDecl GhcPs
-> Maybe ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs
  , Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe Bool -> Maybe Bool -> Bool)
-> (ImportDecl GhcPs -> Maybe Bool)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((Bool, Located [LIE GhcPs]) -> Bool)
-> Maybe (Bool, Located [LIE GhcPs]) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, Located [LIE GhcPs]) -> Bool
forall a b. (a, b) -> a
fst (Maybe (Bool, Located [LIE GhcPs]) -> Maybe Bool)
-> (ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs]))
-> ImportDecl GhcPs
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding -- same 'hiding' flags
  ]
  where
    hasMergableQualified :: ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
hasMergableQualified ImportDeclQualifiedStyle
QualifiedPre ImportDeclQualifiedStyle
QualifiedPost = Bool
True
    hasMergableQualified ImportDeclQualifiedStyle
QualifiedPost ImportDeclQualifiedStyle
QualifiedPre = Bool
True
    hasMergableQualified ImportDeclQualifiedStyle
q0 ImportDeclQualifiedStyle
q1 = ImportDeclQualifiedStyle
q0 ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ImportDeclQualifiedStyle
q1

instance Eq Import where
  Import
i0 == :: Import -> Import -> Bool
== Import
i1 = Import -> Import -> Bool
canMergeImport Import
i0 Import
i1 Bool -> Bool -> Bool
&& ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
hasSameImports (Import -> ImportDecl GhcPs
unImport Import
i0) (Import -> ImportDecl GhcPs
unImport Import
i1)
    where
      hasSameImports :: ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
hasSameImports = Maybe (Located [LIE GhcPs]) -> Maybe (Located [LIE GhcPs]) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe (Located [LIE GhcPs])
 -> Maybe (Located [LIE GhcPs]) -> Bool)
-> (ImportDecl GhcPs -> Maybe (Located [LIE GhcPs]))
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((Bool, Located [LIE GhcPs]) -> Located [LIE GhcPs])
-> Maybe (Bool, Located [LIE GhcPs]) -> Maybe (Located [LIE GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, Located [LIE GhcPs]) -> Located [LIE GhcPs]
forall a b. (a, b) -> b
snd (Maybe (Bool, Located [LIE GhcPs]) -> Maybe (Located [LIE GhcPs]))
-> (ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs]))
-> ImportDecl GhcPs
-> Maybe (Located [LIE GhcPs])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding

instance Ord Import where
  compare :: Import -> Import -> Ordering
compare (Import ImportDecl GhcPs
i0) (Import ImportDecl GhcPs
i1) =
    ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
i0 Located ModuleName -> Located ModuleName -> Ordering
forall a. Outputable a => a -> a -> Ordering
`compareOutputable` ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
i1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
    (StringLiteral -> String) -> Maybe StringLiteral -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> String
forall a. Outputable a => a -> String
showOutputable (ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual ImportDecl GhcPs
i0) Maybe String -> Maybe String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`
        (StringLiteral -> String) -> Maybe StringLiteral -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> String
forall a. Outputable a => a -> String
showOutputable (ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual ImportDecl GhcPs
i1) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
    ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering
forall a. Outputable a => a -> a -> Ordering
compareOutputable ImportDecl GhcPs
i0 ImportDecl GhcPs
i1

-- | Comments associated with module
newtype Comments = Comments [GHC.RealLocated GHC.AnnotationComment]

-- | A module header is its name, exports and haddock docstring
data ModuleHeader = ModuleHeader
  { ModuleHeader -> Maybe (Located ModuleName)
name :: Maybe (GHC.Located GHC.ModuleName)
  , ModuleHeader -> Maybe (Located [LIE GhcPs])
exports :: Maybe (GHC.Located [GHC.LIE GhcPs])
  , ModuleHeader -> Maybe LHsDocString
haddocks :: Maybe GHC.LHsDocString
  }

-- | Create a module from GHC internal representations
makeModule :: GHC.PState -> GHC.Located (GHC.HsModule GHC.GhcPs) -> Module
makeModule :: PState -> Located (HsModule GhcPs) -> Module
makeModule PState
pstate = [RealLocated AnnotationComment]
-> [(ApiAnnKey, [SrcSpan])]
-> Map RealSrcSpan [AnnKeywordId]
-> Located (HsModule GhcPs)
-> Module
Module [RealLocated AnnotationComment]
comments [(ApiAnnKey, [SrcSpan])]
annotations Map RealSrcSpan [AnnKeywordId]
annotationMap
  where
    comments :: [RealLocated AnnotationComment]
comments
      = [RealLocated AnnotationComment] -> [RealLocated AnnotationComment]
forall a. Ord a => [a] -> [a]
sort
      ([RealLocated AnnotationComment]
 -> [RealLocated AnnotationComment])
-> ([GenLocated SrcSpan AnnotationComment]
    -> [RealLocated AnnotationComment])
-> [GenLocated SrcSpan AnnotationComment]
-> [RealLocated AnnotationComment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpan AnnotationComment]
-> [RealLocated AnnotationComment]
forall e. [GenLocated SrcSpan e] -> [GenLocated RealSrcSpan e]
filterRealLocated
      ([GenLocated SrcSpan AnnotationComment]
 -> [RealLocated AnnotationComment])
-> [GenLocated SrcSpan AnnotationComment]
-> [RealLocated AnnotationComment]
forall a b. (a -> b) -> a -> b
$ PState -> [GenLocated SrcSpan AnnotationComment]
GHC.comment_q PState
pstate [GenLocated SrcSpan AnnotationComment]
-> [GenLocated SrcSpan AnnotationComment]
-> [GenLocated SrcSpan AnnotationComment]
forall a. [a] -> [a] -> [a]
++ (PState -> [(SrcSpan, [GenLocated SrcSpan AnnotationComment])]
GHC.annotations_comments PState
pstate [(SrcSpan, [GenLocated SrcSpan AnnotationComment])]
-> ((SrcSpan, [GenLocated SrcSpan AnnotationComment])
    -> [GenLocated SrcSpan AnnotationComment])
-> [GenLocated SrcSpan AnnotationComment]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SrcSpan, [GenLocated SrcSpan AnnotationComment])
-> [GenLocated SrcSpan AnnotationComment]
forall a b. (a, b) -> b
snd)

    filterRealLocated :: [GenLocated SrcSpan e] -> [GenLocated RealSrcSpan e]
filterRealLocated = (GenLocated SrcSpan e -> Maybe (GenLocated RealSrcSpan e))
-> [GenLocated SrcSpan e] -> [GenLocated RealSrcSpan e]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe \case
      GHC.L (GHC.RealSrcSpan RealSrcSpan
s) e
e -> GenLocated RealSrcSpan e -> Maybe (GenLocated RealSrcSpan e)
forall a. a -> Maybe a
Just (RealSrcSpan -> e -> GenLocated RealSrcSpan e
forall l e. l -> e -> GenLocated l e
GHC.L RealSrcSpan
s e
e)
      GHC.L (GHC.UnhelpfulSpan FastString
_) e
_ -> Maybe (GenLocated RealSrcSpan e)
forall a. Maybe a
Nothing

    annotations :: [(ApiAnnKey, [SrcSpan])]
annotations
      = PState -> [(ApiAnnKey, [SrcSpan])]
GHC.annotations PState
pstate

    annotationMap :: Map RealSrcSpan [AnnKeywordId]
annotationMap
      = PState -> [(ApiAnnKey, [SrcSpan])]
GHC.annotations PState
pstate
      [(ApiAnnKey, [SrcSpan])]
-> ([(ApiAnnKey, [SrcSpan])] -> [(RealSrcSpan, [AnnKeywordId])])
-> [(RealSrcSpan, [AnnKeywordId])]
forall a b. a -> (a -> b) -> b
& ((ApiAnnKey, [SrcSpan]) -> Maybe (RealSrcSpan, [AnnKeywordId]))
-> [(ApiAnnKey, [SrcSpan])] -> [(RealSrcSpan, [AnnKeywordId])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ApiAnnKey, [SrcSpan]) -> Maybe (RealSrcSpan, [AnnKeywordId])
forall a b. ((SrcSpan, a), b) -> Maybe (RealSrcSpan, [a])
x
      [(RealSrcSpan, [AnnKeywordId])]
-> ([(RealSrcSpan, [AnnKeywordId])]
    -> Map RealSrcSpan [AnnKeywordId])
-> Map RealSrcSpan [AnnKeywordId]
forall a b. a -> (a -> b) -> b
& ([AnnKeywordId] -> [AnnKeywordId] -> [AnnKeywordId])
-> [(RealSrcSpan, [AnnKeywordId])]
-> Map RealSrcSpan [AnnKeywordId]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [AnnKeywordId] -> [AnnKeywordId] -> [AnnKeywordId]
forall a. [a] -> [a] -> [a]
(++)

    x :: ((SrcSpan, a), b) -> Maybe (RealSrcSpan, [a])
x = \case
      ((RealSrcSpan RealSrcSpan
rspan, a
annot), b
_) -> (RealSrcSpan, [a]) -> Maybe (RealSrcSpan, [a])
forall a. a -> Maybe a
Just (RealSrcSpan
rspan, [a
annot])
      ((SrcSpan, a), b)
_ -> Maybe (RealSrcSpan, [a])
forall a. Maybe a
Nothing

-- | Get all declarations in module
moduleDecls :: Module -> Decls
moduleDecls :: Module -> Decls
moduleDecls = [LHsDecl GhcPs] -> Decls
Decls ([LHsDecl GhcPs] -> Decls)
-> (Module -> [LHsDecl GhcPs]) -> Module -> Decls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule GhcPs -> [LHsDecl GhcPs]
forall pass. HsModule pass -> [LHsDecl pass]
GHC.hsmodDecls (HsModule GhcPs -> [LHsDecl GhcPs])
-> (Module -> HsModule GhcPs) -> Module -> [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (HsModule GhcPs) -> HsModule GhcPs
forall a. Located a -> a
unLocated (Located (HsModule GhcPs) -> HsModule GhcPs)
-> (Module -> Located (HsModule GhcPs)) -> Module -> HsModule GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Located (HsModule GhcPs)
parsedModule

-- | Get comments in module
moduleComments :: Module -> Comments
moduleComments :: Module -> Comments
moduleComments = [RealLocated AnnotationComment] -> Comments
Comments ([RealLocated AnnotationComment] -> Comments)
-> (Module -> [RealLocated AnnotationComment])
-> Module
-> Comments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [RealLocated AnnotationComment]
parsedComments

-- | Get module language pragmas
moduleLanguagePragmas :: Module -> [(RealSrcSpan, NonEmpty Text)]
moduleLanguagePragmas :: Module -> [(RealSrcSpan, NonEmpty Text)]
moduleLanguagePragmas = (RealLocated AnnotationComment
 -> Maybe (RealSrcSpan, NonEmpty Text))
-> [RealLocated AnnotationComment]
-> [(RealSrcSpan, NonEmpty Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe RealLocated AnnotationComment -> Maybe (RealSrcSpan, NonEmpty Text)
toLanguagePragma ([RealLocated AnnotationComment] -> [(RealSrcSpan, NonEmpty Text)])
-> (Module -> [RealLocated AnnotationComment])
-> Module
-> [(RealSrcSpan, NonEmpty Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [RealLocated AnnotationComment]
parsedComments
  where
    toLanguagePragma :: RealLocated GHC.AnnotationComment -> Maybe (RealSrcSpan, NonEmpty Text)
    toLanguagePragma :: RealLocated AnnotationComment -> Maybe (RealSrcSpan, NonEmpty Text)
toLanguagePragma = \case
      L RealSrcSpan
pos (GHC.AnnBlockComment String
s) ->
        Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack String
s)
          Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> Maybe Text
T.stripPrefix Text
"{-#"
          Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> Maybe Text
T.stripSuffix Text
"#-}"
          Maybe Text -> (Text -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
T.strip
          Maybe Text -> (Text -> (Text, Text)) -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int -> Text -> (Text, Text)
T.splitAt Int
8 -- length "LANGUAGE"
          Maybe (Text, Text)
-> ((Text, Text) -> (Text, [Text])) -> Maybe (Text, [Text])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> [Text]) -> (Text, Text) -> (Text, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> [Text]
T.splitOn Text
",")
          Maybe (Text, [Text])
-> ((Text, [Text]) -> (Text, [Text])) -> Maybe (Text, [Text])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([Text] -> [Text]) -> (Text, [Text]) -> (Text, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.strip)
          Maybe (Text, [Text])
-> ((Text, [Text]) -> (Text, [Text])) -> Maybe (Text, [Text])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([Text] -> [Text]) -> (Text, [Text]) -> (Text, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null))
          Maybe (Text, [Text])
-> ((Text, [Text]) -> Maybe (Text, NonEmpty Text))
-> Maybe (Text, NonEmpty Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(Text -> Text
T.toUpper (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip -> Text
lang, [Text]
xs) -> (Text
lang,) (NonEmpty Text -> (Text, NonEmpty Text))
-> Maybe (NonEmpty Text) -> Maybe (Text, NonEmpty Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Text]
xs)
          Maybe (Text, NonEmpty Text)
-> ((Text, NonEmpty Text) -> Maybe (RealSrcSpan, NonEmpty Text))
-> Maybe (RealSrcSpan, NonEmpty Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(Text
lang, NonEmpty Text
nel) -> if Text
lang Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"LANGUAGE" then (RealSrcSpan, NonEmpty Text) -> Maybe (RealSrcSpan, NonEmpty Text)
forall a. a -> Maybe a
Just (RealSrcSpan
pos, NonEmpty Text
nel) else Maybe (RealSrcSpan, NonEmpty Text)
forall a. Maybe a
Nothing)
      RealLocated AnnotationComment
_ -> Maybe (RealSrcSpan, NonEmpty Text)
forall a. Maybe a
Nothing

-- | Get module imports
moduleImports :: Module -> [Located Import]
moduleImports :: Module -> [Located Import]
moduleImports Module
m
  = Module -> Located (HsModule GhcPs)
parsedModule Module
m
  Located (HsModule GhcPs)
-> (Located (HsModule GhcPs) -> HsModule GhcPs) -> HsModule GhcPs
forall a b. a -> (a -> b) -> b
& Located (HsModule GhcPs) -> HsModule GhcPs
forall a. Located a -> a
unLocated
  HsModule GhcPs
-> (HsModule GhcPs -> [LImportDecl GhcPs]) -> [LImportDecl GhcPs]
forall a b. a -> (a -> b) -> b
& HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
GHC.hsmodImports
  [LImportDecl GhcPs]
-> ([LImportDecl GhcPs] -> [Located Import]) -> [Located Import]
forall a b. a -> (a -> b) -> b
& (LImportDecl GhcPs -> Located Import)
-> [LImportDecl GhcPs] -> [Located Import]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(L SrcSpan
pos ImportDecl GhcPs
i) -> SrcSpan -> Import -> Located Import
forall l e. l -> e -> GenLocated l e
L SrcSpan
pos (ImportDecl GhcPs -> Import
Import ImportDecl GhcPs
i)

-- | Get groups of imports from module
moduleImportGroups :: Module -> [NonEmpty (Located Import)]
moduleImportGroups :: Module -> [NonEmpty (Located Import)]
moduleImportGroups = (Located Import -> RealSrcSpan)
-> [Located Import] -> [NonEmpty (Located Import)]
forall a. (a -> RealSrcSpan) -> [a] -> [NonEmpty a]
groupByLine Located Import -> RealSrcSpan
forall a. Located a -> RealSrcSpan
unsafeGetRealSrcSpan ([Located Import] -> [NonEmpty (Located Import)])
-> (Module -> [Located Import])
-> Module
-> [NonEmpty (Located Import)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [Located Import]
moduleImports

-- The same logic as 'Language.Haskell.Stylish.Module.moduleImportGroups'.
groupByLine :: (a -> RealSrcSpan) -> [a] -> [NonEmpty a]
groupByLine :: (a -> RealSrcSpan) -> [a] -> [NonEmpty a]
groupByLine a -> RealSrcSpan
f = [a] -> Maybe Int -> [a] -> [NonEmpty a]
go [] Maybe Int
forall a. Maybe a
Nothing
  where
    go :: [a] -> Maybe Int -> [a] -> [NonEmpty a]
go [a]
acc Maybe Int
_ [] = [a] -> [NonEmpty a]
forall a. [a] -> [NonEmpty a]
ne [a]
acc
    go [a]
acc Maybe Int
mbCurrentLine (a
x:[a]
xs) =
      let
        lStart :: Int
lStart = RealSrcSpan -> Int
GHC.srcSpanStartLine (a -> RealSrcSpan
f a
x)
        lEnd :: Int
lEnd = RealSrcSpan -> Int
GHC.srcSpanEndLine (a -> RealSrcSpan
f a
x) in
      case Maybe Int
mbCurrentLine of
        Just Int
lPrevEnd | Int
lPrevEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lStart
          -> [a] -> [NonEmpty a]
forall a. [a] -> [NonEmpty a]
ne [a]
acc [NonEmpty a] -> [NonEmpty a] -> [NonEmpty a]
forall a. [a] -> [a] -> [a]
++ [a] -> Maybe Int -> [a] -> [NonEmpty a]
go [a
x] (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
lEnd) [a]
xs
        Maybe Int
_ -> [a] -> Maybe Int -> [a] -> [NonEmpty a]
go ([a]
acc [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
lEnd) [a]
xs

    ne :: [a] -> [NonEmpty a]
ne []       = []
    ne (a
x : [a]
xs) = [a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs]

-- | Merge two import declarations, keeping positions from the first
--
--   As alluded, this highlights an issue with merging imports. The GHC
--   annotation comments aren't attached to any particular AST node. This
--   means that right now, we're manually reconstructing the attachment. By
--   merging two import declarations, we lose that mapping.
--
--   It's not really a big deal if we consider that people don't usually
--   comment imports themselves. It _is_ however, systemic and it'd be better
--   if we processed comments beforehand and attached them to all AST nodes in
--   our own representation.
mergeModuleImport :: Located Import -> Located Import -> Located Import
mergeModuleImport :: Located Import -> Located Import -> Located Import
mergeModuleImport (L SrcSpan
p0 (Import ImportDecl GhcPs
i0)) (L SrcSpan
_p1 (Import ImportDecl GhcPs
i1)) =
  SrcSpan -> Import -> Located Import
forall l e. l -> e -> GenLocated l e
L SrcSpan
p0 (Import -> Located Import) -> Import -> Located Import
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Import
Import ImportDecl GhcPs
i0 { ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = Maybe (Bool, Located [LIE GhcPs])
newImportNames }
  where
    newImportNames :: Maybe (Bool, Located [LIE GhcPs])
newImportNames =
      case (ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
i0, ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
i1) of
        (Just (Bool
b, L SrcSpan
p [LIE GhcPs]
imps0), Just (Bool
_, L SrcSpan
_ [LIE GhcPs]
imps1)) -> (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool
b, SrcSpan -> [LIE GhcPs] -> Located [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpan
p ([LIE GhcPs]
imps0 [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. Outputable a => [a] -> [a] -> [a]
`merge` [LIE GhcPs]
imps1))
        (Maybe (Bool, Located [LIE GhcPs])
Nothing, Maybe (Bool, Located [LIE GhcPs])
Nothing) -> Maybe (Bool, Located [LIE GhcPs])
forall a. Maybe a
Nothing
        (Just (Bool, Located [LIE GhcPs])
x, Maybe (Bool, Located [LIE GhcPs])
Nothing) -> (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool, Located [LIE GhcPs])
x
        (Maybe (Bool, Located [LIE GhcPs])
Nothing, Just (Bool, Located [LIE GhcPs])
x) -> (Bool, Located [LIE GhcPs]) -> Maybe (Bool, Located [LIE GhcPs])
forall a. a -> Maybe a
Just (Bool, Located [LIE GhcPs])
x
    merge :: [a] -> [a] -> [a]
merge [a]
xs [a]
ys
      = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool) -> (a -> String) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> String
forall a. Outputable a => a -> String
showOutputable) ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys)

-- | Get module header
moduleHeader :: Module -> ModuleHeader
moduleHeader :: Module -> ModuleHeader
moduleHeader (Module [RealLocated AnnotationComment]
_ [(ApiAnnKey, [SrcSpan])]
_ Map RealSrcSpan [AnnKeywordId]
_ (GHC.L SrcSpan
_ HsModule GhcPs
m)) = ModuleHeader :: Maybe (Located ModuleName)
-> Maybe (Located [LIE GhcPs])
-> Maybe LHsDocString
-> ModuleHeader
ModuleHeader
  { name :: Maybe (Located ModuleName)
name = HsModule GhcPs -> Maybe (Located ModuleName)
forall pass. HsModule pass -> Maybe (Located ModuleName)
GHC.hsmodName HsModule GhcPs
m
  , exports :: Maybe (Located [LIE GhcPs])
exports = HsModule GhcPs -> Maybe (Located [LIE GhcPs])
forall pass. HsModule pass -> Maybe (Located [LIE pass])
GHC.hsmodExports HsModule GhcPs
m
  , haddocks :: Maybe LHsDocString
haddocks = HsModule GhcPs -> Maybe LHsDocString
forall pass. HsModule pass -> Maybe LHsDocString
GHC.hsmodHaddockModHeader HsModule GhcPs
m
  }

-- | Query for annotations associated with a 'SrcSpan'
lookupAnnotation :: SrcSpan -> Module -> [GHC.AnnKeywordId]
lookupAnnotation :: SrcSpan -> Module -> [AnnKeywordId]
lookupAnnotation (RealSrcSpan RealSrcSpan
rspan) Module
m = [AnnKeywordId]
-> RealSrcSpan -> Map RealSrcSpan [AnnKeywordId] -> [AnnKeywordId]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] RealSrcSpan
rspan (Module -> Map RealSrcSpan [AnnKeywordId]
parsedAnnotSrcs Module
m)
lookupAnnotation (UnhelpfulSpan FastString
_) Module
_ = []

-- | Query the module AST using @f@
queryModule :: Typeable a => (a -> [b]) -> Module -> [b]
queryModule :: (a -> [b]) -> Module -> [b]
queryModule a -> [b]
f = ([b] -> [b] -> [b]) -> GenericQ [b] -> GenericQ [b]
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
(++) ([b] -> (a -> [b]) -> a -> [b]
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ [] a -> [b]
f) (Located (HsModule GhcPs) -> [b])
-> (Module -> Located (HsModule GhcPs)) -> Module -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Located (HsModule GhcPs)
parsedModule

--------------------------------------------------------------------------------
-- | Getter for internal components in imports newtype
rawImport :: Import -> ImportDecl GhcPs
rawImport :: Import -> ImportDecl GhcPs
rawImport (Import ImportDecl GhcPs
i) = ImportDecl GhcPs
i

-- | Getter for internal module name representation
rawModuleName :: ModuleHeader -> Maybe (GHC.Located GHC.ModuleName)
rawModuleName :: ModuleHeader -> Maybe (Located ModuleName)
rawModuleName = ModuleHeader -> Maybe (Located ModuleName)
name

-- | Getter for internal module exports representation
rawModuleExports :: ModuleHeader -> Maybe (GHC.Located [GHC.LIE GhcPs])
rawModuleExports :: ModuleHeader -> Maybe (Located [LIE GhcPs])
rawModuleExports = ModuleHeader -> Maybe (Located [LIE GhcPs])
exports

-- | Getter for internal module haddocks representation
rawModuleHaddocks :: ModuleHeader -> Maybe GHC.LHsDocString
rawModuleHaddocks :: ModuleHeader -> Maybe LHsDocString
rawModuleHaddocks = ModuleHeader -> Maybe LHsDocString
haddocks

-- | Getter for internal module decls representation
rawModuleDecls :: Decls -> [LHsDecl GhcPs]
rawModuleDecls :: Decls -> [LHsDecl GhcPs]
rawModuleDecls (Decls [LHsDecl GhcPs]
xs) = [LHsDecl GhcPs]
xs

-- | Getter for internal module comments representation
rawComments :: Comments -> [GHC.RealLocated GHC.AnnotationComment]
rawComments :: Comments -> [RealLocated AnnotationComment]
rawComments (Comments [RealLocated AnnotationComment]
xs) = [RealLocated AnnotationComment]
xs

-- | Getter for internal module annotation representation
rawModuleAnnotations :: Module -> [(GHC.ApiAnnKey, [GHC.SrcSpan])]
rawModuleAnnotations :: Module -> [(ApiAnnKey, [SrcSpan])]
rawModuleAnnotations = Module -> [(ApiAnnKey, [SrcSpan])]
parsedAnnotations