--------------------------------------------------------------------------------
{-# 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           Data.Text                       (Text)
import qualified Data.Text                       as T


--------------------------------------------------------------------------------
import qualified GHC.Hs                          as Hs
import           SrcLoc                          (RealSrcSpan, realSrcSpanStart,
                                                  srcLocLine, srcSpanEndLine,
                                                  srcSpanStartLine)


--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.Block
import           Language.Haskell.Stylish.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
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: 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
showList :: [Style] -> ShowS
$cshowList :: [Style] -> ShowS
show :: Style -> String
$cshow :: Style -> String
showsPrec :: Int -> Style -> ShowS
$cshowsPrec :: Int -> Style -> ShowS
Show)


--------------------------------------------------------------------------------
verticalPragmas :: String -> Int -> Bool -> [String] -> Lines
verticalPragmas :: String -> Int -> Bool -> [String] -> [String]
verticalPragmas String
lg Int
longest Bool
align [String]
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 <- [String]
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 -> [String] -> [String]
compactPragmas String
lg Maybe Int
columns [String]
pragmas' = Maybe Int -> String -> Int -> [String] -> [String]
wrapMaybe Maybe Int
columns (String
"{-# " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
lg) Int
13 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
    ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",") ([String] -> [String]
forall a. [a] -> [a]
init [String]
pragmas') [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String] -> String
forall a. [a] -> a
last [String]
pragmas' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" #-}"]


--------------------------------------------------------------------------------
compactLinePragmas :: String -> Maybe Int -> Bool -> [String] -> Lines
compactLinePragmas :: String -> Maybe Int -> Bool -> [String] -> [String]
compactLinePragmas String
_  Maybe Int
_ Bool
_ [] = []
compactLinePragmas String
lg Maybe Int
columns Bool
align [String]
pragmas' = ShowS -> [String] -> [String]
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) [String]
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 (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 (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
prags
    pad :: ShowS
pad
      | Bool
align = Int -> ShowS
padRight Int
longest
      | Bool
otherwise = ShowS
forall a. a -> a
id
    prags :: [String]
prags = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
truncateComma ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Maybe Int -> String -> Int -> [String] -> [String]
wrapMaybe Maybe Int
maxWidth String
"" Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
      ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",") ([String] -> [String]
forall a. [a] -> [a]
init [String]
pragmas') [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String] -> String
forall a. [a] -> a
last [String]
pragmas']


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


--------------------------------------------------------------------------------
truncateComma :: String -> String
truncateComma :: ShowS
truncateComma String
""     = String
""
truncateComma String
xs
    | String -> Char
forall a. [a] -> a
last String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' = ShowS
forall a. [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 -> [String] -> [String]
prettyPragmas String
lp Maybe Int
_    Int
longest Bool
align Style
Vertical        = String -> Int -> Bool -> [String] -> [String]
verticalPragmas String
lp Int
longest Bool
align
prettyPragmas String
lp Maybe Int
cols Int
_       Bool
_     Style
Compact         = String -> Maybe Int -> [String] -> [String]
compactPragmas String
lp Maybe Int
cols
prettyPragmas String
lp Maybe Int
cols Int
_       Bool
align Style
CompactLine     = String -> Maybe Int -> Bool -> [String] -> [String]
compactLinePragmas String
lp Maybe Int
cols Bool
align
prettyPragmas String
lp Maybe Int
_    Int
_       Bool
_     Style
VerticalCompact = String -> [String] -> [String]
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 :: (Text -> Bool)
                -> [(l, NonEmpty Text)]
                -> [(l, [Text])]
filterRedundant :: (Text -> Bool) -> [(l, NonEmpty Text)] -> [(l, [Text])]
filterRedundant Text -> Bool
isRedundant' = (Set Text, [(l, [Text])]) -> [(l, [Text])]
forall a b. (a, b) -> b
snd ((Set Text, [(l, [Text])]) -> [(l, [Text])])
-> ([(l, NonEmpty Text)] -> (Set Text, [(l, [Text])]))
-> [(l, NonEmpty Text)]
-> [(l, [Text])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((l, [Text])
 -> (Set Text, [(l, [Text])]) -> (Set Text, [(l, [Text])]))
-> (Set Text, [(l, [Text])])
-> [(l, [Text])]
-> (Set Text, [(l, [Text])])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (l, [Text])
-> (Set Text, [(l, [Text])]) -> (Set Text, [(l, [Text])])
forall a.
(a, [Text])
-> (Set Text, [(a, [Text])]) -> (Set Text, [(a, [Text])])
filterRedundant' (Set Text
forall a. Set a
S.empty, []) ([(l, [Text])] -> (Set Text, [(l, [Text])]))
-> ([(l, NonEmpty Text)] -> [(l, [Text])])
-> [(l, NonEmpty Text)]
-> (Set Text, [(l, [Text])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((l, NonEmpty Text) -> (l, [Text]))
-> [(l, NonEmpty Text)] -> [(l, [Text])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty Text -> [Text]) -> (l, NonEmpty Text) -> (l, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
toList)
  where
    filterRedundant' :: (a, [Text])
-> (Set Text, [(a, [Text])]) -> (Set Text, [(a, [Text])])
filterRedundant' (a
l, [Text]
xs) (Set Text
known, [(a, [Text])]
zs)
        | Set Text -> Bool
forall a. Set a -> Bool
S.null Set Text
xs' = (Set Text
known', [(a, [Text])]
zs)
        | Bool
otherwise  = (Set Text
known', (a
l, Set Text -> [Text]
forall a. Set a -> [a]
S.toAscList Set Text
xs') (a, [Text]) -> [(a, [Text])] -> [(a, [Text])]
forall a. a -> [a] -> [a]
: [(a, [Text])]
zs)
      where
        fxs :: [Text]
fxs    = (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
isRedundant') [Text]
xs
        xs' :: Set Text
xs'    = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
fxs Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Text
known
        known' :: Set Text
known' = Set Text
xs' Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set Text
known

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


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

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

    convertFstToBlock :: [(RealSrcSpan, a)] -> [(Block String, a)]
    convertFstToBlock :: [(RealSrcSpan, a)] -> [(Block String, a)]
convertFstToBlock = ((RealSrcSpan, a) -> (Block String, a))
-> [(RealSrcSpan, a)] -> [(Block String, a)]
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
srcSpanStartLine RealSrcSpan
rspan) (RealSrcSpan -> Int
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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty a -> [a]) -> (Block a, NonEmpty a) -> (Block a, [a])
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. [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 (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length ([Text] -> [Int]) -> [Text] -> [Int]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
toList (NonEmpty Text -> [Text])
-> ((RealSrcSpan, NonEmpty Text) -> NonEmpty Text)
-> (RealSrcSpan, NonEmpty Text)
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealSrcSpan, NonEmpty Text) -> NonEmpty Text
forall a b. (a, b) -> b
snd ((RealSrcSpan, NonEmpty Text) -> [Text])
-> [(RealSrcSpan, NonEmpty Text)] -> [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(RealSrcSpan, NonEmpty Text)]
languagePragmas

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

    changes :: [Change String]
changes =
      [ Block String -> ([String] -> [String]) -> Change String
forall a. Block a -> ([a] -> [a]) -> Change a
change Block String
b ([String] -> [String] -> [String]
forall a b. a -> b -> a
const ([String] -> [String] -> [String])
-> [String] -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int -> Int -> Bool -> Style -> [String] -> [String]
prettyPragmas String
lngPrefix Maybe Int
columns Int
longest Bool
align Style
style ((Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack [Text]
pg))
      | (Block String
b, [Text]
pg) <- (Text -> Bool)
-> [(Block String, NonEmpty Text)] -> [(Block String, [Text])]
forall l. (Text -> Bool) -> [(l, NonEmpty Text)] -> [(l, [Text])]
filterRedundant Text -> Bool
isRedundant' [(Block String, NonEmpty Text)]
groups
      ]

--------------------------------------------------------------------------------
-- | Add a LANGUAGE pragma to a module if it is not present already.
addLanguagePragma :: String -> String -> Module -> [Change String]
addLanguagePragma :: String -> String -> Module -> [Change String]
addLanguagePragma String
lg String
prag Module
modu
    | String
prag String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
present = []
    | Bool
otherwise           = [Int -> [String] -> Change String
forall a. Int -> [a] -> Change a
insert 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 Text)]
pragmas'      = Module -> [(RealSrcSpan, NonEmpty Text)]
moduleLanguagePragmas Module
modu
    present :: [String]
present       = ((RealSrcSpan, NonEmpty Text) -> [String])
-> [(RealSrcSpan, NonEmpty Text)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack) ([Text] -> [String])
-> ((RealSrcSpan, NonEmpty Text) -> [Text])
-> (RealSrcSpan, NonEmpty Text)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
toList (NonEmpty Text -> [Text])
-> ((RealSrcSpan, NonEmpty Text) -> NonEmpty Text)
-> (RealSrcSpan, NonEmpty Text)
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealSrcSpan, NonEmpty Text) -> NonEmpty Text
forall a b. (a, b) -> b
snd) [(RealSrcSpan, NonEmpty Text)]
pragmas'
    line :: Int
line          = if [(RealSrcSpan, NonEmpty Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RealSrcSpan, NonEmpty Text)]
pragmas' then Int
1 else [(RealSrcSpan, NonEmpty Text)] -> Int
firstLocation [(RealSrcSpan, NonEmpty Text)]
pragmas'
    firstLocation :: [(RealSrcSpan, NonEmpty Text)] -> Int
    firstLocation :: [(RealSrcSpan, NonEmpty Text)] -> Int
firstLocation = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int)
-> ([(RealSrcSpan, NonEmpty Text)] -> [Int])
-> [(RealSrcSpan, NonEmpty Text)]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RealSrcSpan, NonEmpty Text) -> Int)
-> [(RealSrcSpan, NonEmpty Text)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RealSrcLoc -> Int
srcLocLine (RealSrcLoc -> Int)
-> ((RealSrcSpan, NonEmpty Text) -> RealSrcLoc)
-> (RealSrcSpan, NonEmpty Text)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> RealSrcLoc
realSrcSpanStart (RealSrcSpan -> RealSrcLoc)
-> ((RealSrcSpan, NonEmpty Text) -> RealSrcSpan)
-> (RealSrcSpan, NonEmpty Text)
-> RealSrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealSrcSpan, NonEmpty Text) -> 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 -> Text -> Bool
isRedundant :: Module -> Text -> Bool
isRedundant Module
m Text
"ViewPatterns" = Module -> Bool
isRedundantViewPatterns Module
m
isRedundant Module
m Text
"BangPatterns" = Module -> Bool
isRedundantBangPatterns Module
m
isRedundant Module
_ Text
_              = Bool
False


--------------------------------------------------------------------------------
-- | Check if the ViewPatterns language pragma is redundant.
isRedundantViewPatterns :: Module -> Bool
isRedundantViewPatterns :: Module -> Bool
isRedundantViewPatterns = [()] -> 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 :: Hs.Pat Hs.GhcPs -> [()]
    getViewPat :: Pat GhcPs -> [()]
getViewPat = \case
      Hs.ViewPat{} -> [()]
      Pat GhcPs
_            -> []


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

    getMatchStrict :: Hs.Match Hs.GhcPs (Hs.LHsExpr Hs.GhcPs) -> [()]
    getMatchStrict :: Match GhcPs (LHsExpr GhcPs) -> [()]
getMatchStrict (Hs.XMatch XXMatch GhcPs (LHsExpr GhcPs)
m) = NoExtCon -> [()]
forall a. NoExtCon -> a
Hs.noExtCon NoExtCon
XXMatch GhcPs (LHsExpr GhcPs)
m
    getMatchStrict (Hs.Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NameOrRdrName (IdP GhcPs))
ctx [LPat GhcPs]
_ GRHSs GhcPs (LHsExpr GhcPs)
_) = case HsMatchContext (NameOrRdrName (IdP GhcPs))
ctx of
      Hs.FunRhs Located (NameOrRdrName (IdP GhcPs))
_ LexicalFixity
_ SrcStrictness
Hs.SrcStrict -> [()]
      HsMatchContext (NameOrRdrName (IdP GhcPs))
_                          -> []