--------------------------------------------------------------------------------
{-# LANGUAGE BlockArguments    #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.Stylish.Step.LanguagePragmas
    ( Style (..)
    , step
      -- * Utilities
    , addLanguagePragma
    ) where


--------------------------------------------------------------------------------
import           Data.List.NonEmpty              (NonEmpty, fromList, toList)
import qualified Data.Set                        as S


--------------------------------------------------------------------------------
import qualified GHC.Hs                          as GHC
import qualified GHC.Types.SrcLoc                as GHC


--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.Block
import qualified Language.Haskell.Stylish.Editor as Editor
import           Language.Haskell.Stylish.Module
import           Language.Haskell.Stylish.Step
import           Language.Haskell.Stylish.Util


--------------------------------------------------------------------------------
data Style
    = Vertical
    | Compact
    | CompactLine
    | VerticalCompact
    deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
/= :: Style -> Style -> Bool
Eq, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> String
show :: Style -> String
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
Show)


--------------------------------------------------------------------------------
verticalPragmas :: String -> Int -> Bool -> [String] -> Lines
verticalPragmas :: String -> Int -> Bool -> Lines -> Lines
verticalPragmas String
lg Int
longest Bool
align Lines
pragmas' =
    [ String
"{-# " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
lg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
pad String
pragma String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" #-}"
    | String
pragma <- Lines
pragmas'
    ]
  where
    pad :: ShowS
pad
      | Bool
align = Int -> ShowS
padRight Int
longest
      | Bool
otherwise = ShowS
forall a. a -> a
id


--------------------------------------------------------------------------------
compactPragmas :: String -> Maybe Int -> [String] -> Lines
compactPragmas :: String -> Maybe Int -> Lines -> Lines
compactPragmas String
lg Maybe Int
columns Lines
pragmas' = Maybe Int -> String -> Int -> Lines -> Lines
wrapMaybe Maybe Int
columns (String
"{-# " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
lg) Int
13 (Lines -> Lines) -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$
    ShowS -> Lines -> Lines
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",") (Lines -> Lines
forall a. HasCallStack => [a] -> [a]
init Lines
pragmas') Lines -> Lines -> Lines
forall a. [a] -> [a] -> [a]
++ [Lines -> String
forall a. HasCallStack => [a] -> a
last Lines
pragmas' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" #-}"]


--------------------------------------------------------------------------------
compactLinePragmas :: String -> Maybe Int -> Bool -> [String] -> Lines
compactLinePragmas :: String -> Maybe Int -> Bool -> Lines -> Lines
compactLinePragmas String
_  Maybe Int
_ Bool
_ [] = []
compactLinePragmas String
lg Maybe Int
columns Bool
align Lines
pragmas' = ShowS -> Lines -> Lines
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
wrapLanguage ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
pad) Lines
prags
  where
    wrapLanguage :: ShowS
wrapLanguage String
ps = String
"{-# " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
lg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++  String
" #-}"
    maxWidth :: Maybe Int
maxWidth = (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
c -> Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16) Maybe Int
columns
    longest :: Int
longest  = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> Lines -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Lines
prags
    pad :: ShowS
pad
      | Bool
align = Int -> ShowS
padRight Int
longest
      | Bool
otherwise = ShowS
forall a. a -> a
id
    prags :: Lines
prags = ShowS -> Lines -> Lines
forall a b. (a -> b) -> [a] -> [b]
map ShowS
truncateComma (Lines -> Lines) -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$ Maybe Int -> String -> Int -> Lines -> Lines
wrapMaybe Maybe Int
maxWidth String
"" Int
1 (Lines -> Lines) -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$
      ShowS -> Lines -> Lines
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",") (Lines -> Lines
forall a. HasCallStack => [a] -> [a]
init Lines
pragmas') Lines -> Lines -> Lines
forall a. [a] -> [a] -> [a]
++ [Lines -> String
forall a. HasCallStack => [a] -> a
last Lines
pragmas']


--------------------------------------------------------------------------------
verticalCompactPragmas :: String -> [String] -> Lines
verticalCompactPragmas :: String -> Lines -> Lines
verticalCompactPragmas String
lg Lines
pragmas' =
  [ String
"{-# " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
lg
  , String
"    " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Lines -> String
forall a. HasCallStack => [a] -> a
head Lines
pragmas'
  ]
  Lines -> Lines -> Lines
forall a. Semigroup a => a -> a -> a
<> [ String
"  , "  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
pragma | String
pragma <- Lines -> Lines
forall a. HasCallStack => [a] -> [a]
tail Lines
pragmas']
  Lines -> Lines -> Lines
forall a. Semigroup a => a -> a -> a
<> [ String
"  #-}"]


--------------------------------------------------------------------------------
truncateComma :: String -> String
truncateComma :: ShowS
truncateComma String
""     = String
""
truncateComma String
xs
    | String -> Char
forall a. HasCallStack => [a] -> a
last String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' = ShowS
forall a. HasCallStack => [a] -> [a]
init String
xs
    | Bool
otherwise      = String
xs


--------------------------------------------------------------------------------
prettyPragmas :: String -> Maybe Int -> Int -> Bool -> Style -> [String] -> Lines
prettyPragmas :: String -> Maybe Int -> Int -> Bool -> Style -> Lines -> Lines
prettyPragmas String
lp Maybe Int
_    Int
longest Bool
align Style
Vertical        = String -> Int -> Bool -> Lines -> Lines
verticalPragmas String
lp Int
longest Bool
align
prettyPragmas String
lp Maybe Int
cols Int
_       Bool
_     Style
Compact         = String -> Maybe Int -> Lines -> Lines
compactPragmas String
lp Maybe Int
cols
prettyPragmas String
lp Maybe Int
cols Int
_       Bool
align Style
CompactLine     = String -> Maybe Int -> Bool -> Lines -> Lines
compactLinePragmas String
lp Maybe Int
cols Bool
align
prettyPragmas String
lp Maybe Int
_    Int
_       Bool
_     Style
VerticalCompact = String -> Lines -> Lines
verticalCompactPragmas String
lp


--------------------------------------------------------------------------------
-- | Filter redundant (and duplicate) pragmas out of the groups. As a side
-- effect, we also sort the pragmas in their group...
filterRedundant :: (String -> Bool)
                -> [(l, NonEmpty String)]
                -> [(l, [String])]
filterRedundant :: forall l.
(String -> Bool) -> [(l, NonEmpty String)] -> [(l, Lines)]
filterRedundant String -> Bool
isRedundant' = (Set String, [(l, Lines)]) -> [(l, Lines)]
forall a b. (a, b) -> b
snd ((Set String, [(l, Lines)]) -> [(l, Lines)])
-> ([(l, NonEmpty String)] -> (Set String, [(l, Lines)]))
-> [(l, NonEmpty String)]
-> [(l, Lines)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((l, Lines)
 -> (Set String, [(l, Lines)]) -> (Set String, [(l, Lines)]))
-> (Set String, [(l, Lines)])
-> [(l, Lines)]
-> (Set String, [(l, Lines)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (l, Lines)
-> (Set String, [(l, Lines)]) -> (Set String, [(l, Lines)])
forall {a}.
(a, Lines)
-> (Set String, [(a, Lines)]) -> (Set String, [(a, Lines)])
filterRedundant' (Set String
forall a. Set a
S.empty, []) ([(l, Lines)] -> (Set String, [(l, Lines)]))
-> ([(l, NonEmpty String)] -> [(l, Lines)])
-> [(l, NonEmpty String)]
-> (Set String, [(l, Lines)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((l, NonEmpty String) -> (l, Lines))
-> [(l, NonEmpty String)] -> [(l, Lines)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty String -> Lines) -> (l, NonEmpty String) -> (l, Lines)
forall a b. (a -> b) -> (l, a) -> (l, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty String -> Lines
forall a. NonEmpty a -> [a]
toList)
  where
    filterRedundant' :: (a, Lines)
-> (Set String, [(a, Lines)]) -> (Set String, [(a, Lines)])
filterRedundant' (a
l, Lines
xs) (Set String
known, [(a, Lines)]
zs)
        | Set String -> Bool
forall a. Set a -> Bool
S.null Set String
xs' = (Set String
known', [(a, Lines)]
zs)
        | Bool
otherwise  = (Set String
known', (a
l, Set String -> Lines
forall a. Set a -> [a]
S.toAscList Set String
xs') (a, Lines) -> [(a, Lines)] -> [(a, Lines)]
forall a. a -> [a] -> [a]
: [(a, Lines)]
zs)
      where
        fxs :: Lines
fxs    = (String -> Bool) -> Lines -> Lines
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isRedundant') Lines
xs
        xs' :: Set String
xs'    = Lines -> Set String
forall a. Ord a => [a] -> Set a
S.fromList Lines
fxs Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set String
known
        known' :: Set String
known' = Set String
xs' Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set String
known

--------------------------------------------------------------------------------
step :: Maybe Int -> Style -> Bool -> Bool -> String -> Step
step :: Maybe Int -> Style -> Bool -> Bool -> String -> Step
step = ((((String -> (Lines -> Module -> Lines) -> Step
makeStep String
"LanguagePragmas" ((Lines -> Module -> Lines) -> Step)
-> (String -> Lines -> Module -> Lines) -> String -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((String -> Lines -> Module -> Lines) -> String -> Step)
-> (Bool -> String -> Lines -> Module -> Lines)
-> Bool
-> String
-> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Bool -> String -> Lines -> Module -> Lines)
 -> Bool -> String -> Step)
-> (Bool -> Bool -> String -> Lines -> Module -> Lines)
-> Bool
-> Bool
-> String
-> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Bool -> Bool -> String -> Lines -> Module -> Lines)
 -> Bool -> Bool -> String -> Step)
-> (Style -> Bool -> Bool -> String -> Lines -> Module -> Lines)
-> Style
-> Bool
-> Bool
-> String
-> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Style -> Bool -> Bool -> String -> Lines -> Module -> Lines)
 -> Style -> Bool -> Bool -> String -> Step)
-> (Maybe Int
    -> Style -> Bool -> Bool -> String -> Lines -> Module -> Lines)
-> Maybe Int
-> Style
-> Bool
-> Bool
-> String
-> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int
-> Style -> Bool -> Bool -> String -> Lines -> Module -> Lines
step'


--------------------------------------------------------------------------------
step' :: Maybe Int -> Style -> Bool -> Bool -> String -> Lines -> Module -> Lines
step' :: Maybe Int
-> Style -> Bool -> Bool -> String -> Lines -> Module -> Lines
step' Maybe Int
columns Style
style Bool
align Bool
removeRedundant String
lngPrefix Lines
ls Module
m
  | [(RealSrcSpan, NonEmpty String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RealSrcSpan, NonEmpty String)]
languagePragmas = Lines
ls
  | Bool
otherwise = Edits -> Lines -> Lines
Editor.apply Edits
changes Lines
ls
  where
    isRedundant' :: String -> Bool
isRedundant'
        | Bool
removeRedundant = Module -> String -> Bool
isRedundant Module
m
        | Bool
otherwise       = Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
False

    languagePragmas :: [(RealSrcSpan, NonEmpty String)]
languagePragmas = Module -> [(RealSrcSpan, NonEmpty String)]
moduleLanguagePragmas Module
m

    convertFstToBlock :: [(GHC.RealSrcSpan, a)] -> [(Block String, a)]
    convertFstToBlock :: forall a. [(RealSrcSpan, a)] -> [(Block String, a)]
convertFstToBlock = ((RealSrcSpan, a) -> (Block String, a))
-> [(RealSrcSpan, a)] -> [(Block String, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(RealSrcSpan
rspan, a
a) ->
      (Int -> Int -> Block String
forall a. Int -> Int -> Block a
Block (RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
rspan) (RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
rspan), a
a)

    groupAdjacent' :: [(Block a, NonEmpty a)] -> [(Block a, NonEmpty a)]
groupAdjacent' =
      ((Block a, [[a]]) -> (Block a, NonEmpty a))
-> [(Block a, [[a]])] -> [(Block a, NonEmpty a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Block a, [[a]]) -> (Block a, NonEmpty a)
forall {t :: * -> *} {a} {a}.
Foldable t =>
(a, t [a]) -> (a, NonEmpty a)
turnSndBackToNel ([(Block a, [[a]])] -> [(Block a, NonEmpty a)])
-> ([(Block a, NonEmpty a)] -> [(Block a, [[a]])])
-> [(Block a, NonEmpty a)]
-> [(Block a, NonEmpty a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Block a, [a])] -> [(Block a, [[a]])]
forall a b. [(Block a, b)] -> [(Block a, [b])]
groupAdjacent ([(Block a, [a])] -> [(Block a, [[a]])])
-> ([(Block a, NonEmpty a)] -> [(Block a, [a])])
-> [(Block a, NonEmpty a)]
-> [(Block a, [[a]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Block a, NonEmpty a) -> (Block a, [a]))
-> [(Block a, NonEmpty a)] -> [(Block a, [a])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty a -> [a]) -> (Block a, NonEmpty a) -> (Block a, [a])
forall a b. (a -> b) -> (Block a, a) -> (Block a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
toList)
      where
        turnSndBackToNel :: (a, t [a]) -> (a, NonEmpty a)
turnSndBackToNel (a
a, t [a]
bss) = (a
a, [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
fromList ([a] -> NonEmpty a) -> (t [a] -> [a]) -> t [a] -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (t [a] -> NonEmpty a) -> t [a] -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ t [a]
bss)

    longest :: Int
    longest :: Int
longest  = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> Lines -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Lines -> [Int]) -> Lines -> [Int]
forall a b. (a -> b) -> a -> b
$ NonEmpty String -> Lines
forall a. NonEmpty a -> [a]
toList (NonEmpty String -> Lines)
-> ((RealSrcSpan, NonEmpty String) -> NonEmpty String)
-> (RealSrcSpan, NonEmpty String)
-> Lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealSrcSpan, NonEmpty String) -> NonEmpty String
forall a b. (a, b) -> b
snd ((RealSrcSpan, NonEmpty String) -> Lines)
-> [(RealSrcSpan, NonEmpty String)] -> Lines
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(RealSrcSpan, NonEmpty String)]
languagePragmas

    groups :: [(Block String, NonEmpty String)]
    groups :: [(Block String, NonEmpty String)]
groups = [(Block String
b, NonEmpty String
pgs) | (Block String
b, NonEmpty String
pgs) <- [(Block String, NonEmpty String)]
-> [(Block String, NonEmpty String)]
forall {a} {a}. [(Block a, NonEmpty a)] -> [(Block a, NonEmpty a)]
groupAdjacent' ([(RealSrcSpan, NonEmpty String)]
-> [(Block String, NonEmpty String)]
forall a. [(RealSrcSpan, a)] -> [(Block String, a)]
convertFstToBlock [(RealSrcSpan, NonEmpty String)]
languagePragmas)]

    changes :: Edits
changes = [Edits] -> Edits
forall a. Monoid a => [a] -> a
mconcat
      [ Block String -> (Lines -> Lines) -> Edits
Editor.changeLines Block String
b (Lines -> Lines -> Lines
forall a b. a -> b -> a
const (Lines -> Lines -> Lines) -> Lines -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int -> Int -> Bool -> Style -> Lines -> Lines
prettyPragmas String
lngPrefix Maybe Int
columns Int
longest Bool
align Style
style Lines
pg)
      | (Block String
b, Lines
pg) <- (String -> Bool)
-> [(Block String, NonEmpty String)] -> [(Block String, Lines)]
forall l.
(String -> Bool) -> [(l, NonEmpty String)] -> [(l, Lines)]
filterRedundant String -> Bool
isRedundant' [(Block String, NonEmpty String)]
groups
      ]


--------------------------------------------------------------------------------
-- | Add a LANGUAGE pragma to a module if it is not present already.
addLanguagePragma :: String -> String -> Module -> Editor.Edits
addLanguagePragma :: String -> String -> Module -> Edits
addLanguagePragma String
lg String
prag Module
modu
    | String
prag String -> Lines -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Lines
present = Edits
forall a. Monoid a => a
mempty
    | Bool
otherwise           = Int -> Lines -> Edits
Editor.insertLines Int
line [String
"{-# " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
lg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prag String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" #-}"]
  where
    pragmas' :: [(RealSrcSpan, NonEmpty String)]
pragmas'      = Module -> [(RealSrcSpan, NonEmpty String)]
moduleLanguagePragmas Module
modu
    present :: Lines
present       = ((RealSrcSpan, NonEmpty String) -> Lines)
-> [(RealSrcSpan, NonEmpty String)] -> Lines
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NonEmpty String -> Lines
forall a. NonEmpty a -> [a]
toList (NonEmpty String -> Lines)
-> ((RealSrcSpan, NonEmpty String) -> NonEmpty String)
-> (RealSrcSpan, NonEmpty String)
-> Lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealSrcSpan, NonEmpty String) -> NonEmpty String
forall a b. (a, b) -> b
snd) [(RealSrcSpan, NonEmpty String)]
pragmas'
    line :: Int
line          = if [(RealSrcSpan, NonEmpty String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RealSrcSpan, NonEmpty String)]
pragmas' then Int
1 else [(RealSrcSpan, NonEmpty String)] -> Int
firstLocation [(RealSrcSpan, NonEmpty String)]
pragmas'
    firstLocation :: [(GHC.RealSrcSpan, NonEmpty String)] -> Int
    firstLocation :: [(RealSrcSpan, NonEmpty String)] -> Int
firstLocation = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int)
-> ([(RealSrcSpan, NonEmpty String)] -> [Int])
-> [(RealSrcSpan, NonEmpty String)]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RealSrcSpan, NonEmpty String) -> Int)
-> [(RealSrcSpan, NonEmpty String)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RealSrcLoc -> Int
GHC.srcLocLine (RealSrcLoc -> Int)
-> ((RealSrcSpan, NonEmpty String) -> RealSrcLoc)
-> (RealSrcSpan, NonEmpty String)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> RealSrcLoc
GHC.realSrcSpanStart (RealSrcSpan -> RealSrcLoc)
-> ((RealSrcSpan, NonEmpty String) -> RealSrcSpan)
-> (RealSrcSpan, NonEmpty String)
-> RealSrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealSrcSpan, NonEmpty String) -> RealSrcSpan
forall a b. (a, b) -> a
fst)


--------------------------------------------------------------------------------
-- | Check if a language pragma is redundant. We can't do this for all pragmas,
-- but we do a best effort.
isRedundant :: Module -> String -> Bool
isRedundant :: Module -> String -> Bool
isRedundant Module
m String
"ViewPatterns" = Module -> Bool
isRedundantViewPatterns Module
m
isRedundant Module
m String
"BangPatterns" = Module -> Bool
isRedundantBangPatterns Module
m
isRedundant Module
_ String
_              = Bool
False


--------------------------------------------------------------------------------
-- | Check if the ViewPatterns language pragma is redundant.
isRedundantViewPatterns :: Module -> Bool
isRedundantViewPatterns :: Module -> Bool
isRedundantViewPatterns = [()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([()] -> Bool) -> (Module -> [()]) -> Module -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcPs -> [()]) -> Module -> [()]
forall a b. Typeable a => (a -> [b]) -> Module -> [b]
queryModule Pat GhcPs -> [()]
getViewPat
  where
    getViewPat :: GHC.Pat GHC.GhcPs -> [()]
    getViewPat :: Pat GhcPs -> [()]
getViewPat = \case
      GHC.ViewPat{} -> [()]
      Pat GhcPs
_             -> []


--------------------------------------------------------------------------------
-- | Check if the BangPatterns language pragma is redundant.
isRedundantBangPatterns :: Module -> Bool
isRedundantBangPatterns :: Module -> Bool
isRedundantBangPatterns Module
modul =
    ([()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([()] -> Bool) -> [()] -> Bool
forall a b. (a -> b) -> a -> b
$ (Pat GhcPs -> [()]) -> Module -> [()]
forall a b. Typeable a => (a -> [b]) -> Module -> [b]
queryModule Pat GhcPs -> [()]
getBangPat Module
modul) Bool -> Bool -> Bool
&&
    ([()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([()] -> Bool) -> [()] -> Bool
forall a b. (a -> b) -> a -> b
$ (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> [()])
-> Module -> [()]
forall a b. Typeable a => (a -> [b]) -> Module -> [b]
queryModule Match GhcPs (LHsExpr GhcPs) -> [()]
Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> [()]
getMatchStrict Module
modul)
  where
    getBangPat :: GHC.Pat GHC.GhcPs -> [()]
    getBangPat :: Pat GhcPs -> [()]
getBangPat = \case
      GHC.BangPat{} -> [()]
      Pat GhcPs
_             -> []

    getMatchStrict :: GHC.Match GHC.GhcPs (GHC.LHsExpr GHC.GhcPs) -> [()]
    getMatchStrict :: Match GhcPs (LHsExpr GhcPs) -> [()]
getMatchStrict (GHC.Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext GhcPs
ctx [LPat GhcPs]
_ GRHSs GhcPs (LHsExpr GhcPs)
_) = case HsMatchContext GhcPs
ctx of
      GHC.FunRhs LIdP (NoGhcTc GhcPs)
_ LexicalFixity
_ SrcStrictness
GHC.SrcStrict -> [()]
      HsMatchContext GhcPs
_                            -> []