{-# LANGUAGE OverloadedStrings #-}

-- | Support for CPP.
module Ormolu.Processing.Cpp
  ( State (..),
    processLine,
    unmaskLine,
  )
where

import Control.Monad
import Data.Char (isSpace)
import qualified Data.List as L
import Data.Maybe (isJust)
import Data.String
import Data.Text (Text)
import qualified Data.Text as T

-- | State of the CPP processor.
data State
  = -- | Outside of CPP directives
    Outside
  | -- | In a conditional expression
    InConditional
  | -- | In a continuation (after @\\@)
    InContinuation
  deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show)

-- | Automatically mask the line when needed and update the 'State'.
processLine :: String -> State -> (String, State)
processLine :: String -> State -> (String, State)
processLine String
line State
state
  | String -> Bool
for String
"define " = (String
masked, State
state')
  | String -> Bool
for String
"include " = (String
masked, State
state')
  | String -> Bool
for String
"undef " = (String
masked, State
state')
  | String -> Bool
for String
"ifdef " = (String
masked, State
InConditional)
  | String -> Bool
for String
"ifndef " = (String
masked, State
InConditional)
  | String -> Bool
for String
"if " = (String
masked, State
InConditional)
  | String -> Bool
for String
"else" = (String
masked, State
InConditional)
  | String -> Bool
for String
"elif" = (String
masked, State
InConditional)
  | String -> Bool
for String
"endif" = (String
masked, State
state')
  | Bool
otherwise =
    case State
state of
      State
Outside -> (String
line, State
Outside)
      State
InConditional -> (String
masked, State
InConditional)
      State
InContinuation -> (String
masked, State
state')
  where
    for :: String -> Bool
for String
directive = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
      String
s <- (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix String
"#" String
line
      Maybe String -> Maybe ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix String
directive String
s)
    masked :: String
masked = ShowS
maskLine String
line
    state' :: State
state' =
      if String
"\\" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` String
line
        then State
InContinuation
        else State
Outside

-- | Mask the given line.
maskLine :: String -> String
maskLine :: ShowS
maskLine String
x = String
forall s. IsString s => s
maskPrefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x

-- | If the given line is masked, unmask it. Otherwise return the line
-- unchanged.
unmaskLine :: Text -> Text
unmaskLine :: Text -> Text
unmaskLine Text
x =
  case Text -> Text -> Maybe Text
T.stripPrefix Text
forall s. IsString s => s
maskPrefix (Text -> Text
T.stripStart Text
x) of
    Maybe Text
Nothing -> Text
x
    Just Text
x' -> Text
x'

-- | Mask prefix for CPP.
maskPrefix :: IsString s => s
maskPrefix :: s
maskPrefix = s
"-- ORMOLU_CPP_MASK"