{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Processing.Preprocess
( preprocess,
)
where
import Control.Monad
import Data.Array as A
import Data.Bifunctor (bimap)
import Data.Char (isSpace)
import Data.Function ((&))
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import qualified Data.List as L
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Ormolu.Config (RegionDeltas (..))
import Ormolu.Processing.Common
import Ormolu.Processing.Cpp
preprocess ::
Bool ->
RegionDeltas ->
String ->
[Either Text RegionDeltas]
preprocess :: Bool -> RegionDeltas -> [Char] -> [Either Text RegionDeltas]
preprocess Bool
cppEnabled RegionDeltas
region [Char]
rawInput = [Either Text RegionDeltas]
rawSnippetsAndRegionsToFormat
where
(IntSet
linesNotToFormat', IntMap [Char]
replacementLines) = Bool -> RegionDeltas -> [Char] -> (IntSet, IntMap [Char])
linesNotToFormat Bool
cppEnabled RegionDeltas
region [Char]
rawInput
regionsToFormat :: [RegionDeltas]
regionsToFormat =
Key -> IntSet -> [RegionDeltas]
intSetToRegions Key
rawLineLength forall a b. (a -> b) -> a -> b
$
[Key] -> IntSet
IntSet.fromAscList [Key
1 .. Key
rawLineLength] IntSet -> IntSet -> IntSet
IntSet.\\ IntSet
linesNotToFormat'
regionsNotToFormat :: [RegionDeltas]
regionsNotToFormat = Key -> IntSet -> [RegionDeltas]
intSetToRegions Key
rawLineLength IntSet
linesNotToFormat'
interleave' :: [a] -> [a] -> [a]
interleave' = case [RegionDeltas]
regionsNotToFormat of
RegionDeltas
r : [RegionDeltas]
_ | RegionDeltas -> Key
regionPrefixLength RegionDeltas
r forall a. Eq a => a -> a -> Bool
== Key
0 -> forall {a}. [a] -> [a] -> [a]
interleave
[RegionDeltas]
_ -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {a}. [a] -> [a] -> [a]
interleave
rawSnippets :: [Text]
rawSnippets = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip RegionDeltas -> [Char] -> [Char]
linesInRegion [Char]
updatedInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RegionDeltas]
regionsNotToFormat
where
updatedInput :: [Char]
updatedInput = [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key, [Char]) -> [Char]
updateLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Key
1 ..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines forall a b. (a -> b) -> a -> b
$ [Char]
rawInput
updateLine :: (Key, [Char]) -> [Char]
updateLine (Key
i, [Char]
line) = forall a. a -> Key -> IntMap a -> a
IntMap.findWithDefault [Char]
line Key
i IntMap [Char]
replacementLines
rawSnippetsAndRegionsToFormat :: [Either Text RegionDeltas]
rawSnippetsAndRegionsToFormat =
forall {a}. [a] -> [a] -> [a]
interleave' (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
rawSnippets) (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RegionDeltas]
regionsToFormat)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Text RegionDeltas -> [Either Text RegionDeltas]
patchSeparatingBlankLines
forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall {b}. Either Text b -> Bool
isBlankRawSnippet
forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> [a] -> [a]
L.dropWhileEnd forall {b}. Either Text b -> Bool
isBlankRawSnippet
patchSeparatingBlankLines :: Either Text RegionDeltas -> [Either Text RegionDeltas]
patchSeparatingBlankLines = \case
Right r :: RegionDeltas
r@RegionDeltas {Key
regionSuffixLength :: RegionDeltas -> Key
regionSuffixLength :: Key
regionPrefixLength :: Key
regionPrefixLength :: RegionDeltas -> Key
..} ->
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace (RegionDeltas -> [Char] -> [Char]
linesInRegion RegionDeltas
r [Char]
rawInput)
then [forall {b}. Either Text b
blankRawSnippet]
else
[forall {b}. Either Text b
blankRawSnippet | Key -> Bool
isBlankLine Key
regionPrefixLength]
forall a. Semigroup a => a -> a -> a
<> [forall a b. b -> Either a b
Right RegionDeltas
r]
forall a. Semigroup a => a -> a -> a
<> [forall {b}. Either Text b
blankRawSnippet | Key -> Bool
isBlankLine (Key
rawLineLength forall a. Num a => a -> a -> a
- Key
regionSuffixLength forall a. Num a => a -> a -> a
- Key
1)]
Left Text
r -> [forall a b. a -> Either a b
Left Text
r]
where
blankRawSnippet :: Either Text b
blankRawSnippet = forall a b. a -> Either a b
Left Text
"\n"
isBlankLine :: Key -> Bool
isBlankLine Key
i = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace) forall a b. (a -> b) -> a -> b
$ Array Key [Char]
rawLines forall {a}. Array Key a -> Key -> Maybe a
!!? Key
i
isBlankRawSnippet :: Either Text b -> Bool
isBlankRawSnippet = \case
Left Text
r | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
r -> Bool
True
Either Text b
_ -> Bool
False
rawLines :: Array Key [Char]
rawLines = forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (Key
0, forall (t :: * -> *) a. Foldable t => t a -> Key
length [[Char]]
rawLines' forall a. Num a => a -> a -> a
- Key
1) [[Char]]
rawLines'
where
rawLines' :: [[Char]]
rawLines' = [Char] -> [[Char]]
lines [Char]
rawInput
rawLineLength :: Key
rawLineLength = forall (t :: * -> *) a. Foldable t => t a -> Key
length Array Key [Char]
rawLines
interleave :: [a] -> [a] -> [a]
interleave [] [a]
bs = [a]
bs
interleave (a
a : [a]
as) [a]
bs = a
a forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
interleave [a]
bs [a]
as
Array Key a
xs !!? :: Array Key a -> Key -> Maybe a
!!? Key
i = if forall i e. Array i e -> (i, i)
A.bounds Array Key [Char]
rawLines forall a. Ix a => (a, a) -> a -> Bool
`A.inRange` Key
i then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Array Key a
xs forall i e. Ix i => Array i e -> i -> e
A.! Key
i else forall a. Maybe a
Nothing
linesNotToFormat ::
Bool ->
RegionDeltas ->
String ->
(IntSet, IntMap String)
linesNotToFormat :: Bool -> RegionDeltas -> [Char] -> (IntSet, IntMap [Char])
linesNotToFormat Bool
cppEnabled region :: RegionDeltas
region@RegionDeltas {Key
regionSuffixLength :: Key
regionPrefixLength :: Key
regionSuffixLength :: RegionDeltas -> Key
regionPrefixLength :: RegionDeltas -> Key
..} [Char]
input =
(IntSet
unconsidered forall a. Semigroup a => a -> a -> a
<> IntSet
magicDisabled forall a. Semigroup a => a -> a -> a
<> IntSet
otherDisabled, IntMap [Char]
lineUpdates)
where
unconsidered :: IntSet
unconsidered =
[Key] -> IntSet
IntSet.fromAscList forall a b. (a -> b) -> a -> b
$
[Key
1 .. Key
regionPrefixLength] forall a. Semigroup a => a -> a -> a
<> [Key
totalLines forall a. Num a => a -> a -> a
- Key
regionSuffixLength forall a. Num a => a -> a -> a
+ Key
1 .. Key
totalLines]
totalLines :: Key
totalLines = forall (t :: * -> *) a. Foldable t => t a -> Key
length ([Char] -> [[Char]]
lines [Char]
input)
regionLines :: [Char]
regionLines = RegionDeltas -> [Char] -> [Char]
linesInRegion RegionDeltas
region [Char]
input
(IntSet
magicDisabled, IntMap [Char]
lineUpdates) = [Char] -> (IntSet, IntMap [Char])
magicDisabledLines [Char]
regionLines
otherDisabled :: IntSet
otherDisabled = (forall a. Monoid a => [a] -> a
mconcat [[Char] -> IntSet]
allLines) [Char]
regionLines
where
allLines :: [[Char] -> IntSet]
allLines = [[Char] -> IntSet
shebangLines, [Char] -> IntSet
linePragmaLines] forall a. Semigroup a => a -> a -> a
<> [[Char] -> IntSet
cppLines | Bool
cppEnabled]
data OrmoluState
=
OrmoluEnabled
|
OrmoluDisabled
deriving (OrmoluState -> OrmoluState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrmoluState -> OrmoluState -> Bool
$c/= :: OrmoluState -> OrmoluState -> Bool
== :: OrmoluState -> OrmoluState -> Bool
$c== :: OrmoluState -> OrmoluState -> Bool
Eq, Key -> OrmoluState -> [Char] -> [Char]
[OrmoluState] -> [Char] -> [Char]
OrmoluState -> [Char]
forall a.
(Key -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [OrmoluState] -> [Char] -> [Char]
$cshowList :: [OrmoluState] -> [Char] -> [Char]
show :: OrmoluState -> [Char]
$cshow :: OrmoluState -> [Char]
showsPrec :: Key -> OrmoluState -> [Char] -> [Char]
$cshowsPrec :: Key -> OrmoluState -> [Char] -> [Char]
Show)
magicDisabledLines :: String -> (IntSet, IntMap String)
magicDisabledLines :: [Char] -> (IntSet, IntMap [Char])
magicDisabledLines [Char]
input =
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Key] -> IntSet
IntSet.fromAscList forall a. [(Key, a)] -> IntMap a
IntMap.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
forall {a}. OrmoluState -> [([Char], a)] -> [([a], [(a, [Char])])]
go OrmoluState
OrmoluEnabled ([Char] -> [[Char]]
lines [Char]
input forall a b. [a] -> [b] -> [(a, b)]
`zip` [Key
1 ..])
where
go :: OrmoluState -> [([Char], a)] -> [([a], [(a, [Char])])]
go OrmoluState
_ [] = []
go OrmoluState
state (([Char]
line, a
i) : [([Char], a)]
ls)
| Just [Char]
marker <- [Char] -> Maybe [Char]
disablingMagicComment [Char]
line,
OrmoluState
state forall a. Eq a => a -> a -> Bool
== OrmoluState
OrmoluEnabled =
([a
i], [(a
i, [Char]
marker)]) forall a. a -> [a] -> [a]
: OrmoluState -> [([Char], a)] -> [([a], [(a, [Char])])]
go OrmoluState
OrmoluDisabled [([Char], a)]
ls
| Just [Char]
marker <- [Char] -> Maybe [Char]
enablingMagicComment [Char]
line,
OrmoluState
state forall a. Eq a => a -> a -> Bool
== OrmoluState
OrmoluDisabled =
([a
i], [(a
i, [Char]
marker)]) forall a. a -> [a] -> [a]
: OrmoluState -> [([Char], a)] -> [([a], [(a, [Char])])]
go OrmoluState
OrmoluEnabled [([Char], a)]
ls
| Bool
otherwise = forall {a}. ([a], [a])
iIfDisabled forall a. a -> [a] -> [a]
: OrmoluState -> [([Char], a)] -> [([a], [(a, [Char])])]
go OrmoluState
state [([Char], a)]
ls
where
iIfDisabled :: ([a], [a])
iIfDisabled = case OrmoluState
state of
OrmoluState
OrmoluDisabled -> ([a
i], [])
OrmoluState
OrmoluEnabled -> ([], [])
linesFiltered :: (String -> Bool) -> String -> IntSet
linesFiltered :: ([Char] -> Bool) -> [Char] -> IntSet
linesFiltered [Char] -> Bool
p =
[Key] -> IntSet
IntSet.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. [a] -> [b] -> [(a, b)]
`zip` [Key
1 ..]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
shebangLines :: String -> IntSet
shebangLines :: [Char] -> IntSet
shebangLines = ([Char] -> Bool) -> [Char] -> IntSet
linesFiltered ([Char]
"#!" forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`)
linePragmaLines :: String -> IntSet
linePragmaLines :: [Char] -> IntSet
linePragmaLines = ([Char] -> Bool) -> [Char] -> IntSet
linesFiltered ([Char]
"{-# LINE" forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`)
enablingMagicComment :: String -> Maybe String
[Char]
s
| Just [Char]
rest <- [Char] -> [Char] -> Maybe [Char]
isMagicComment [Char]
"ORMOLU_ENABLE" [Char]
s = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"{- ORMOLU_ENABLE -}" forall a. Semigroup a => a -> a -> a
<> [Char]
rest
| Just [Char]
rest <- [Char] -> [Char] -> Maybe [Char]
isMagicComment [Char]
"FOURMOLU_ENABLE" [Char]
s = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"{- FOURMOLU_ENABLE -}" forall a. Semigroup a => a -> a -> a
<> [Char]
rest
| Bool
otherwise = forall a. Maybe a
Nothing
disablingMagicComment :: String -> Maybe String
[Char]
s
| Just [Char]
rest <- [Char] -> [Char] -> Maybe [Char]
isMagicComment [Char]
"ORMOLU_DISABLE" [Char]
s = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"{- ORMOLU_DISABLE -}" forall a. Semigroup a => a -> a -> a
<> [Char]
rest
| Just [Char]
rest <- [Char] -> [Char] -> Maybe [Char]
isMagicComment [Char]
"FOURMOLU_DISABLE" [Char]
s = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"{- FOURMOLU_DISABLE -}" forall a. Semigroup a => a -> a -> a
<> [Char]
rest
| Bool
otherwise = forall a. Maybe a
Nothing
isMagicComment ::
String ->
String ->
Maybe String
[Char]
expected [Char]
s0 = do
let trim :: [Char] -> [Char]
trim = forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
[Char]
s1 <- [Char] -> [Char]
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix [Char]
"{-" ([Char] -> [Char]
trim [Char]
s0)
[Char]
s2 <- [Char] -> [Char]
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix [Char]
expected [Char]
s1
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix [Char]
"-}" [Char]
s2