{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

-- | Preprocessing for input source code.
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

-- | Transform given input possibly returning comments extracted from it.
-- This handles LINE pragmas, CPP, shebangs, and the magic comments for
-- enabling\/disabling of Ormolu.
preprocess ::
  -- | File name, just to use in the spans
  FilePath ->
  -- | Input to process
  String ->
  -- | Region deltas
  RegionDeltas ->
  -- | Literal prefix, pre-processed input, literal suffix, extra comments
  (String, String, String, [Located String])
preprocess :: FilePath
-> FilePath
-> RegionDeltas
-> (FilePath, FilePath, FilePath, [Located FilePath])
preprocess FilePath
path FilePath
input RegionDeltas {Int
regionSuffixLength :: RegionDeltas -> Int
regionPrefixLength :: RegionDeltas -> Int
regionSuffixLength :: Int
regionPrefixLength :: Int
..} =
  Int
-> OrmoluState
-> State
-> ([FilePath] -> [FilePath])
-> ([Located FilePath] -> [Located FilePath])
-> [FilePath]
-> (FilePath, FilePath, FilePath, [Located FilePath])
forall c.
Int
-> OrmoluState
-> State
-> ([FilePath] -> [FilePath])
-> ([Located FilePath] -> c)
-> [FilePath]
-> (FilePath, FilePath, FilePath, c)
go Int
1 OrmoluState
OrmoluEnabled State
Cpp.Outside [FilePath] -> [FilePath]
forall a. a -> a
id [Located FilePath] -> [Located FilePath]
forall a. a -> a
id [FilePath]
regionLines
  where
    ([FilePath]
prefixLines, [FilePath]
otherLines) = Int -> [FilePath] -> ([FilePath], [FilePath])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
regionPrefixLength (FilePath -> [FilePath]
lines FilePath
input)
    ([FilePath]
regionLines, [FilePath]
suffixLines) =
      let regionLength :: Int
regionLength = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
otherLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
regionSuffixLength
       in Int -> [FilePath] -> ([FilePath], [FilePath])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
regionLength [FilePath]
otherLines
    go :: Int
-> OrmoluState
-> State
-> ([FilePath] -> [FilePath])
-> ([Located FilePath] -> c)
-> [FilePath]
-> (FilePath, FilePath, FilePath, c)
go !Int
n OrmoluState
ormoluState State
cppState [FilePath] -> [FilePath]
inputSoFar [Located FilePath] -> c
csSoFar = \case
      [] ->
        let input' :: FilePath
input' = [FilePath] -> FilePath
unlines ([FilePath] -> [FilePath]
inputSoFar [])
         in ( [FilePath] -> FilePath
unlines [FilePath]
prefixLines,
              case OrmoluState
ormoluState of
                OrmoluState
OrmoluEnabled -> FilePath
input'
                OrmoluState
OrmoluDisabled -> FilePath
input' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
forall s. IsString s => s
endDisabling,
              [FilePath] -> FilePath
unlines [FilePath]
suffixLines,
              [Located FilePath] -> c
csSoFar []
            )
      (FilePath
x : [FilePath]
xs) ->
        let (FilePath
x', OrmoluState
ormoluState', State
cppState', Maybe (Located FilePath)
cs) =
              FilePath
-> Int
-> OrmoluState
-> State
-> FilePath
-> (FilePath, OrmoluState, State, Maybe (Located FilePath))
processLine FilePath
path Int
n OrmoluState
ormoluState State
cppState FilePath
x
         in Int
-> OrmoluState
-> State
-> ([FilePath] -> [FilePath])
-> ([Located FilePath] -> c)
-> [FilePath]
-> (FilePath, FilePath, FilePath, c)
go
              (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              OrmoluState
ormoluState'
              State
cppState'
              ([FilePath] -> [FilePath]
inputSoFar ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
x' FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:))
              ([Located FilePath] -> c
csSoFar ([Located FilePath] -> c)
-> ([Located FilePath] -> [Located FilePath])
-> [Located FilePath]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Located FilePath) -> [Located FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe (Located FilePath)
cs [Located FilePath] -> [Located FilePath] -> [Located FilePath]
forall a. [a] -> [a] -> [a]
++))
              [FilePath]
xs

-- | Transform a given line possibly returning a comment extracted from it.
processLine ::
  -- | File name, just to use in the spans
  FilePath ->
  -- | Line number of this line
  Int ->
  -- | Whether Ormolu is currently enabled
  OrmoluState ->
  -- | CPP state
  Cpp.State ->
  -- | The actual line
  String ->
  -- | Adjusted line and possibly a comment extracted from it
  (String, OrmoluState, Cpp.State, Maybe (Located String))
processLine :: FilePath
-> Int
-> OrmoluState
-> State
-> FilePath
-> (FilePath, OrmoluState, State, Maybe (Located FilePath))
processLine FilePath
path Int
n OrmoluState
ormoluState State
Cpp.Outside FilePath
line
  | FilePath
"{-# LINE" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` FilePath
line =
    let (FilePath
pragma, FilePath
res) = FilePath -> (FilePath, FilePath)
getPragma FilePath
line
        size :: Int
size = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
pragma
        ss :: SrcSpan
ss = SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (Int -> SrcLoc
mkSrcLoc' Int
1) (Int -> SrcLoc
mkSrcLoc' (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
     in (FilePath
res, OrmoluState
ormoluState, State
Cpp.Outside, Located FilePath -> Maybe (Located FilePath)
forall a. a -> Maybe a
Just (SrcSpan -> FilePath -> Located FilePath
forall l e. l -> e -> GenLocated l e
L SrcSpan
ss FilePath
pragma))
  | FilePath -> Bool
isOrmoluEnable FilePath
line =
    case OrmoluState
ormoluState of
      OrmoluState
OrmoluEnabled ->
        (FilePath
enableMarker, OrmoluState
OrmoluEnabled, State
Cpp.Outside, Maybe (Located FilePath)
forall a. Maybe a
Nothing)
      OrmoluState
OrmoluDisabled ->
        (FilePath
forall s. IsString s => s
endDisabling FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
enableMarker, OrmoluState
OrmoluEnabled, State
Cpp.Outside, Maybe (Located FilePath)
forall a. Maybe a
Nothing)
  | FilePath -> Bool
isOrmoluDisable FilePath
line =
    case OrmoluState
ormoluState of
      OrmoluState
OrmoluEnabled ->
        (FilePath
disableMarker FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
forall s. IsString s => s
startDisabling, OrmoluState
OrmoluDisabled, State
Cpp.Outside, Maybe (Located FilePath)
forall a. Maybe a
Nothing)
      OrmoluState
OrmoluDisabled ->
        (FilePath
disableMarker, OrmoluState
OrmoluDisabled, State
Cpp.Outside, Maybe (Located FilePath)
forall a. Maybe a
Nothing)
  | FilePath -> Bool
isShebang FilePath
line =
    let ss :: SrcSpan
ss = SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (Int -> SrcLoc
mkSrcLoc' Int
1) (Int -> SrcLoc
mkSrcLoc' (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
line))
     in (FilePath
"", OrmoluState
ormoluState, State
Cpp.Outside, Located FilePath -> Maybe (Located FilePath)
forall a. a -> Maybe a
Just (SrcSpan -> FilePath -> Located FilePath
forall l e. l -> e -> GenLocated l e
L SrcSpan
ss FilePath
line))
  | Bool
otherwise =
    let (FilePath
line', State
cppState') = FilePath -> State -> (FilePath, State)
Cpp.processLine FilePath
line State
Cpp.Outside
     in (FilePath
line', OrmoluState
ormoluState, State
cppState', Maybe (Located FilePath)
forall a. Maybe a
Nothing)
  where
    mkSrcLoc' :: Int -> SrcLoc
mkSrcLoc' = FastString -> Int -> Int -> SrcLoc
mkSrcLoc (FilePath -> FastString
mkFastString FilePath
path) Int
n
processLine FilePath
_ Int
_ OrmoluState
ormoluState State
cppState FilePath
line =
  let (FilePath
line', State
cppState') = FilePath -> State -> (FilePath, State)
Cpp.processLine FilePath
line State
cppState
   in (FilePath
line', OrmoluState
ormoluState, State
cppState', Maybe (Located FilePath)
forall a. Maybe a
Nothing)

-- | Take a line pragma and output its replacement (where line pragma is
-- replaced with spaces) and the contents of the pragma itself.
getPragma ::
  -- | Pragma line to analyze
  String ->
  -- | Contents of the pragma and its replacement line
  (String, String)
getPragma :: FilePath -> (FilePath, FilePath)
getPragma [] = FilePath -> (FilePath, FilePath)
forall a. HasCallStack => FilePath -> a
error FilePath
"Ormolu.Preprocess.getPragma: input must not be empty"
getPragma s :: FilePath
s@(Char
x : FilePath
xs)
  | FilePath
"#-}" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` FilePath
s = (FilePath
"#-}", FilePath
"   " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
3 FilePath
s)
  | Bool
otherwise =
    let (FilePath
prag, FilePath
remline) = FilePath -> (FilePath, FilePath)
getPragma FilePath
xs
     in (Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
prag, Char
' ' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
remline)

-- | Canonical enable marker.
enableMarker :: String
enableMarker :: FilePath
enableMarker = FilePath
"{- ORMOLU_ENABLE -}"

-- | Canonical disable marker.
disableMarker :: String
disableMarker :: FilePath
disableMarker = FilePath
"{- ORMOLU_DISABLE -}"

-- | Return 'True' if the given string is an enabling marker.
isOrmoluEnable :: String -> Bool
isOrmoluEnable :: FilePath -> Bool
isOrmoluEnable = FilePath -> FilePath -> Bool
magicComment FilePath
"ORMOLU_ENABLE"

-- | Return 'True' if the given string is a disabling marker.
isOrmoluDisable :: String -> Bool
isOrmoluDisable :: FilePath -> Bool
isOrmoluDisable = FilePath -> FilePath -> Bool
magicComment FilePath
"ORMOLU_DISABLE"

-- | Construct a function for whitespace-insensitive matching of string.
magicComment ::
  -- | What to expect
  String ->
  -- | String to test
  String ->
  -- | Whether or not the two strings watch
  Bool
magicComment :: FilePath -> FilePath -> Bool
magicComment FilePath
expected FilePath
s0 = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
  FilePath
s1 <- (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix FilePath
"{-" FilePath
s0
  FilePath
s2 <- (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix FilePath
expected FilePath
s1
  FilePath
s3 <- FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix FilePath
"-}" FilePath
s2
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
s3)