{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.Stylish.Step.LanguagePragmas
( Style (..)
, step
, 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
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
]
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)
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
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
_ -> []
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
_ -> []