{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Ormolu.Processing.Preprocess
( preprocess,
)
where
import Control.Monad
import Data.Char (isSpace)
import qualified Data.List as L
import Data.Maybe (isJust)
import Data.Maybe (maybeToList)
import FastString
import Ormolu.Config (RegionDeltas (..))
import Ormolu.Parser.Shebang (isShebang)
import Ormolu.Processing.Common
import qualified Ormolu.Processing.Cpp as Cpp
import SrcLoc
preprocess ::
FilePath ->
String ->
RegionDeltas ->
(String, String, String, [Located String])
preprocess path input RegionDeltas {..} =
go 1 OrmoluEnabled Cpp.Outside id id regionLines
where
(prefixLines, otherLines) = splitAt regionPrefixLength (lines input)
(regionLines, suffixLines) =
let regionLength = length otherLines - regionSuffixLength
in splitAt regionLength otherLines
go !n ormoluState cppState inputSoFar csSoFar = \case
[] ->
let input' = unlines (inputSoFar [])
in ( unlines prefixLines,
case ormoluState of
OrmoluEnabled -> input'
OrmoluDisabled -> input' ++ endDisabling,
unlines suffixLines,
csSoFar []
)
(x : xs) ->
let (x', ormoluState', cppState', cs) =
processLine path n ormoluState cppState x
in go
(n + 1)
ormoluState'
cppState'
(inputSoFar . (x' :))
(csSoFar . (maybeToList cs ++))
xs
processLine ::
FilePath ->
Int ->
OrmoluState ->
Cpp.State ->
String ->
(String, OrmoluState, Cpp.State, Maybe (Located String))
processLine path n ormoluState Cpp.Outside line
| "{-# LINE" `L.isPrefixOf` line =
let (pragma, res) = getPragma line
size = length pragma
ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))
in (res, ormoluState, Cpp.Outside, Just (L ss pragma))
| isOrmoluEnable line =
case ormoluState of
OrmoluEnabled ->
(enableMarker, OrmoluEnabled, Cpp.Outside, Nothing)
OrmoluDisabled ->
(endDisabling ++ enableMarker, OrmoluEnabled, Cpp.Outside, Nothing)
| isOrmoluDisable line =
case ormoluState of
OrmoluEnabled ->
(disableMarker ++ startDisabling, OrmoluDisabled, Cpp.Outside, Nothing)
OrmoluDisabled ->
(disableMarker, OrmoluDisabled, Cpp.Outside, Nothing)
| isShebang line =
let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length line))
in ("", ormoluState, Cpp.Outside, Just (L ss line))
| otherwise =
let (line', cppState') = Cpp.processLine line Cpp.Outside
in (line', ormoluState, cppState', Nothing)
where
mkSrcLoc' = mkSrcLoc (mkFastString path) n
processLine _ _ ormoluState cppState line =
let (line', cppState') = Cpp.processLine line cppState
in (line', ormoluState, cppState', Nothing)
getPragma ::
String ->
(String, String)
getPragma [] = error "Ormolu.Preprocess.getPragma: input must not be empty"
getPragma s@(x : xs)
| "#-}" `L.isPrefixOf` s = ("#-}", " " ++ drop 3 s)
| otherwise =
let (prag, remline) = getPragma xs
in (x : prag, ' ' : remline)
enableMarker :: String
enableMarker = "{- ORMOLU_ENABLE -}"
disableMarker :: String
disableMarker = "{- ORMOLU_DISABLE -}"
isOrmoluEnable :: String -> Bool
isOrmoluEnable = magicComment "ORMOLU_ENABLE"
isOrmoluDisable :: String -> Bool
isOrmoluDisable = magicComment "ORMOLU_DISABLE"
magicComment ::
String ->
String ->
Bool
magicComment expected s0 = isJust $ do
s1 <- dropWhile isSpace <$> L.stripPrefix "{-" s0
s2 <- dropWhile isSpace <$> L.stripPrefix expected s1
s3 <- L.stripPrefix "-}" s2
guard (all isSpace s3)