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

-- | Preprocessing for input source code.
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 the specified region of the input into raw snippets
-- and subregions to be formatted.
preprocess ::
  -- | Whether CPP is enabled
  Bool ->
  RegionDeltas ->
  String ->
  [Either Text RegionDeltas]
preprocess :: Bool -> RegionDeltas -> String -> [Either Text RegionDeltas]
preprocess Bool
cppEnabled RegionDeltas
region String
rawInput = [Either Text RegionDeltas]
rawSnippetsAndRegionsToFormat
  where
    (IntSet
linesNotToFormat', IntMap String
replacementLines) = Bool -> RegionDeltas -> String -> (IntSet, IntMap String)
linesNotToFormat Bool
cppEnabled RegionDeltas
region String
rawInput
    regionsToFormat :: [RegionDeltas]
regionsToFormat =
      Int -> IntSet -> [RegionDeltas]
intSetToRegions Int
rawLineLength (IntSet -> [RegionDeltas]) -> IntSet -> [RegionDeltas]
forall a b. (a -> b) -> a -> b
$
        [Int] -> IntSet
IntSet.fromAscList [Int
1 .. Int
rawLineLength] IntSet -> IntSet -> IntSet
IntSet.\\ IntSet
linesNotToFormat'
    regionsNotToFormat :: [RegionDeltas]
regionsNotToFormat = Int -> IntSet -> [RegionDeltas]
intSetToRegions Int
rawLineLength IntSet
linesNotToFormat'
    -- We want to interleave the regionsToFormat and regionsNotToFormat.
    -- If the first non-formattable region starts at the first line, it is
    -- the first interleaved region, otherwise, we start with the first
    -- region to format.
    interleave' :: [a] -> [a] -> [a]
interleave' = case [RegionDeltas]
regionsNotToFormat of
      RegionDeltas
r : [RegionDeltas]
_ | RegionDeltas -> Int
regionPrefixLength RegionDeltas
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
interleave
      [RegionDeltas]
_ -> ([a] -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
interleave
    rawSnippets :: [Text]
rawSnippets = String -> Text
T.pack (String -> Text)
-> (RegionDeltas -> String) -> RegionDeltas -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RegionDeltas -> String -> String)
-> String -> RegionDeltas -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip RegionDeltas -> String -> String
linesInRegion String
updatedInput (RegionDeltas -> Text) -> [RegionDeltas] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RegionDeltas]
regionsNotToFormat
      where
        updatedInput :: String
updatedInput = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, String) -> String) -> [(Int, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, String) -> String
updateLine ([(Int, String)] -> [String])
-> (String -> [(Int, String)]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] ([String] -> [(Int, String)])
-> (String -> [String]) -> String -> [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
rawInput
        updateLine :: (Int, String) -> String
updateLine (Int
i, String
line) = String -> Int -> IntMap String -> String
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault String
line Int
i IntMap String
replacementLines
    rawSnippetsAndRegionsToFormat :: [Either Text RegionDeltas]
rawSnippetsAndRegionsToFormat =
      [Either Text RegionDeltas]
-> [Either Text RegionDeltas] -> [Either Text RegionDeltas]
forall a. [a] -> [a] -> [a]
interleave' (Text -> Either Text RegionDeltas
forall a b. a -> Either a b
Left (Text -> Either Text RegionDeltas)
-> [Text] -> [Either Text RegionDeltas]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
rawSnippets) (RegionDeltas -> Either Text RegionDeltas
forall a b. b -> Either a b
Right (RegionDeltas -> Either Text RegionDeltas)
-> [RegionDeltas] -> [Either Text RegionDeltas]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RegionDeltas]
regionsToFormat)
        [Either Text RegionDeltas]
-> (Either Text RegionDeltas -> [Either Text RegionDeltas])
-> [Either Text RegionDeltas]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Text RegionDeltas -> [Either Text RegionDeltas]
patchSeparatingBlankLines
        [Either Text RegionDeltas]
-> ([Either Text RegionDeltas] -> [Either Text RegionDeltas])
-> [Either Text RegionDeltas]
forall a b. a -> (a -> b) -> b
& (Either Text RegionDeltas -> Bool)
-> [Either Text RegionDeltas] -> [Either Text RegionDeltas]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Either Text RegionDeltas -> Bool
forall b. Either Text b -> Bool
isBlankRawSnippet
        [Either Text RegionDeltas]
-> ([Either Text RegionDeltas] -> [Either Text RegionDeltas])
-> [Either Text RegionDeltas]
forall a b. a -> (a -> b) -> b
& (Either Text RegionDeltas -> Bool)
-> [Either Text RegionDeltas] -> [Either Text RegionDeltas]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhileEnd Either Text RegionDeltas -> Bool
forall b. Either Text b -> Bool
isBlankRawSnippet
    -- For every formattable region, we want to ensure that it is separated by
    -- a blank line from preceding/succeeding raw snippets if it starts/ends
    -- with a blank line.
    -- Empty formattable regions are replaced by a blank line instead.
    -- Extraneous raw snippets at the start/end are dropped afterwards.
    patchSeparatingBlankLines :: Either Text RegionDeltas -> [Either Text RegionDeltas]
patchSeparatingBlankLines = \case
      Right r :: RegionDeltas
r@RegionDeltas {Int
regionSuffixLength :: RegionDeltas -> Int
regionSuffixLength :: Int
regionPrefixLength :: Int
regionPrefixLength :: RegionDeltas -> Int
..} ->
        if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace (RegionDeltas -> String -> String
linesInRegion RegionDeltas
r String
rawInput)
          then [Either Text RegionDeltas
forall b. Either Text b
blankRawSnippet]
          else
            [Either Text RegionDeltas
forall b. Either Text b
blankRawSnippet | Int -> Bool
isBlankLine Int
regionPrefixLength]
              [Either Text RegionDeltas]
-> [Either Text RegionDeltas] -> [Either Text RegionDeltas]
forall a. Semigroup a => a -> a -> a
<> [RegionDeltas -> Either Text RegionDeltas
forall a b. b -> Either a b
Right RegionDeltas
r]
              [Either Text RegionDeltas]
-> [Either Text RegionDeltas] -> [Either Text RegionDeltas]
forall a. Semigroup a => a -> a -> a
<> [Either Text RegionDeltas
forall b. Either Text b
blankRawSnippet | Int -> Bool
isBlankLine (Int
rawLineLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
regionSuffixLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
      Left Text
r -> [Text -> Either Text RegionDeltas
forall a b. a -> Either a b
Left Text
r]
      where
        blankRawSnippet :: Either Text b
blankRawSnippet = Text -> Either Text b
forall a b. a -> Either a b
Left Text
"\n"
        isBlankLine :: Int -> Bool
isBlankLine Int
i = Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> (Maybe String -> Maybe String) -> Maybe String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace) (Maybe String -> Bool) -> Maybe String -> Bool
forall a b. (a -> b) -> a -> b
$ Array Int String
rawLines Array Int String -> Int -> Maybe String
forall a. Array Int a -> Int -> Maybe a
!!? Int
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 Int String
rawLines = (Int, Int) -> [String] -> Array Int String
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (Int
0, [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
rawLines' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [String]
rawLines'
      where
        rawLines' :: [String]
rawLines' = String -> [String]
lines String
rawInput
    rawLineLength :: Int
rawLineLength = Array Int String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Array Int String
rawLines

    interleave :: [a] -> [a] -> [a]
interleave [] [a]
bs = [a]
bs
    interleave (a
a : [a]
as) [a]
bs = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
interleave [a]
bs [a]
as

    Array Int a
xs !!? :: Array Int a -> Int -> Maybe a
!!? Int
i = if Array Int String -> (Int, Int)
forall i e. Array i e -> (i, i)
A.bounds Array Int String
rawLines (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
`A.inRange` Int
i then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Array Int a
xs Array Int a -> Int -> a
forall i e. Ix i => Array i e -> i -> e
A.! Int
i else Maybe a
forall a. Maybe a
Nothing

-- | All lines we are not supposed to format, and a set of replacements
-- for specific lines.
linesNotToFormat ::
  -- | Whether CPP is enabled
  Bool ->
  RegionDeltas ->
  String ->
  (IntSet, IntMap String)
linesNotToFormat :: Bool -> RegionDeltas -> String -> (IntSet, IntMap String)
linesNotToFormat Bool
cppEnabled region :: RegionDeltas
region@RegionDeltas {Int
regionSuffixLength :: Int
regionPrefixLength :: Int
regionSuffixLength :: RegionDeltas -> Int
regionPrefixLength :: RegionDeltas -> Int
..} String
input =
  (IntSet
unconsidered IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<> IntSet
magicDisabled IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
<> IntSet
otherDisabled, IntMap String
lineUpdates)
  where
    unconsidered :: IntSet
unconsidered =
      [Int] -> IntSet
IntSet.fromAscList ([Int] -> IntSet) -> [Int] -> IntSet
forall a b. (a -> b) -> a -> b
$
        [Int
1 .. Int
regionPrefixLength] [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int
totalLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
regionSuffixLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
totalLines]
    totalLines :: Int
totalLines = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
input)
    regionLines :: String
regionLines = RegionDeltas -> String -> String
linesInRegion RegionDeltas
region String
input
    (IntSet
magicDisabled, IntMap String
lineUpdates) = String -> (IntSet, IntMap String)
magicDisabledLines String
regionLines
    otherDisabled :: IntSet
otherDisabled = ([String -> IntSet] -> String -> IntSet
forall a. Monoid a => [a] -> a
mconcat [String -> IntSet]
allLines) String
regionLines
      where
        allLines :: [String -> IntSet]
allLines = [String -> IntSet
shebangLines, String -> IntSet
linePragmaLines] [String -> IntSet] -> [String -> IntSet] -> [String -> IntSet]
forall a. Semigroup a => a -> a -> a
<> [String -> IntSet
cppLines | Bool
cppEnabled]

-- | Ormolu state.
data OrmoluState
  = -- | Enabled
    OrmoluEnabled
  | -- | Disabled
    OrmoluDisabled
  deriving (OrmoluState -> OrmoluState -> Bool
(OrmoluState -> OrmoluState -> Bool)
-> (OrmoluState -> OrmoluState -> Bool) -> Eq OrmoluState
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, Int -> OrmoluState -> String -> String
[OrmoluState] -> String -> String
OrmoluState -> String
(Int -> OrmoluState -> String -> String)
-> (OrmoluState -> String)
-> ([OrmoluState] -> String -> String)
-> Show OrmoluState
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OrmoluState] -> String -> String
$cshowList :: [OrmoluState] -> String -> String
show :: OrmoluState -> String
$cshow :: OrmoluState -> String
showsPrec :: Int -> OrmoluState -> String -> String
$cshowsPrec :: Int -> OrmoluState -> String -> String
Show)

-- | All lines which are disabled by Ormolu's magic comments,
-- as well as normalizing replacements.
magicDisabledLines :: String -> (IntSet, IntMap String)
magicDisabledLines :: String -> (IntSet, IntMap String)
magicDisabledLines String
input =
  ([Int] -> IntSet)
-> ([(Int, String)] -> IntMap String)
-> ([Int], [(Int, String)])
-> (IntSet, IntMap String)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Int] -> IntSet
IntSet.fromAscList [(Int, String)] -> IntMap String
forall a. [(Int, a)] -> IntMap a
IntMap.fromAscList (([Int], [(Int, String)]) -> (IntSet, IntMap String))
-> ([([Int], [(Int, String)])] -> ([Int], [(Int, String)]))
-> [([Int], [(Int, String)])]
-> (IntSet, IntMap String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Int], [(Int, String)])] -> ([Int], [(Int, String)])
forall a. Monoid a => [a] -> a
mconcat ([([Int], [(Int, String)])] -> (IntSet, IntMap String))
-> [([Int], [(Int, String)])] -> (IntSet, IntMap String)
forall a b. (a -> b) -> a -> b
$
    OrmoluState -> [(String, Int)] -> [([Int], [(Int, String)])]
forall a. OrmoluState -> [(String, a)] -> [([a], [(a, String)])]
go OrmoluState
OrmoluEnabled (String -> [String]
lines String
input [String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
1 ..])
  where
    go :: OrmoluState -> [(String, a)] -> [([a], [(a, String)])]
go OrmoluState
_ [] = []
    go OrmoluState
state ((String
line, a
i) : [(String, a)]
ls)
      | Just String
marker <- String -> Maybe String
disablingMagicComment String
line,
        OrmoluState
state OrmoluState -> OrmoluState -> Bool
forall a. Eq a => a -> a -> Bool
== OrmoluState
OrmoluEnabled =
          ([a
i], [(a
i, String
marker)]) ([a], [(a, String)])
-> [([a], [(a, String)])] -> [([a], [(a, String)])]
forall a. a -> [a] -> [a]
: OrmoluState -> [(String, a)] -> [([a], [(a, String)])]
go OrmoluState
OrmoluDisabled [(String, a)]
ls
      | Just String
marker <- String -> Maybe String
enablingMagicComment String
line,
        OrmoluState
state OrmoluState -> OrmoluState -> Bool
forall a. Eq a => a -> a -> Bool
== OrmoluState
OrmoluDisabled =
          ([a
i], [(a
i, String
marker)]) ([a], [(a, String)])
-> [([a], [(a, String)])] -> [([a], [(a, String)])]
forall a. a -> [a] -> [a]
: OrmoluState -> [(String, a)] -> [([a], [(a, String)])]
go OrmoluState
OrmoluEnabled [(String, a)]
ls
      | Bool
otherwise = ([a], [(a, String)])
forall a. ([a], [a])
iIfDisabled ([a], [(a, String)])
-> [([a], [(a, String)])] -> [([a], [(a, String)])]
forall a. a -> [a] -> [a]
: OrmoluState -> [(String, a)] -> [([a], [(a, String)])]
go OrmoluState
state [(String, a)]
ls
      where
        iIfDisabled :: ([a], [a])
iIfDisabled = case OrmoluState
state of
          OrmoluState
OrmoluDisabled -> ([a
i], [])
          OrmoluState
OrmoluEnabled -> ([], [])

-- | All lines which satisfy a predicate.
linesFiltered :: (String -> Bool) -> String -> IntSet
linesFiltered :: (String -> Bool) -> String -> IntSet
linesFiltered String -> Bool
p =
  [Int] -> IntSet
IntSet.fromAscList ([Int] -> IntSet) -> (String -> [Int]) -> String -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Int) -> Int
forall a b. (a, b) -> b
snd ([(String, Int)] -> [Int])
-> (String -> [(String, Int)]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Int) -> Bool) -> [(String, Int)] -> [(String, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
p (String -> Bool)
-> ((String, Int) -> String) -> (String, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Int) -> String
forall a b. (a, b) -> a
fst) ([(String, Int)] -> [(String, Int)])
-> (String -> [(String, Int)]) -> String -> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
1 ..]) ([String] -> [(String, Int)])
-> (String -> [String]) -> String -> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

-- | Lines which contain a shebang.
shebangLines :: String -> IntSet
shebangLines :: String -> IntSet
shebangLines = (String -> Bool) -> String -> IntSet
linesFiltered (String
"#!" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`)

-- | Lines which contain a LINE pragma.
linePragmaLines :: String -> IntSet
linePragmaLines :: String -> IntSet
linePragmaLines = (String -> Bool) -> String -> IntSet
linesFiltered (String
"{-# LINE" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`)

-- | If the given string is an enabling marker (Ormolu or Fourmolu style), then
-- return 'Just' the enabling marker + rest of the string. Otherwise return 'Nothing'.
enablingMagicComment :: String -> Maybe String
enablingMagicComment :: String -> Maybe String
enablingMagicComment String
s
  | Just String
rest <- String -> String -> Maybe String
isMagicComment String
"ORMOLU_ENABLE" String
s = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"{- ORMOLU_ENABLE -}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rest
  | Just String
rest <- String -> String -> Maybe String
isMagicComment String
"FOURMOLU_ENABLE" String
s = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"{- FOURMOLU_ENABLE -}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rest
  | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing

-- | If the given string is a disabling marker (Ormolu or Fourmolu style), then
-- return 'Just' the disabling marker + rest of the string. Otherwise return 'Nothing'.
disablingMagicComment :: String -> Maybe String
disablingMagicComment :: String -> Maybe String
disablingMagicComment String
s
  | Just String
rest <- String -> String -> Maybe String
isMagicComment String
"ORMOLU_DISABLE" String
s = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"{- ORMOLU_DISABLE -}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rest
  | Just String
rest <- String -> String -> Maybe String
isMagicComment String
"FOURMOLU_DISABLE" String
s = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"{- FOURMOLU_DISABLE -}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rest
  | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing

-- | Construct a function for whitespace-insensitive matching of string.
isMagicComment ::
  -- | What to expect
  String ->
  -- | String to test
  String ->
  -- | If the two strings match, we return the rest of the line.
  Maybe String
isMagicComment :: String -> String -> Maybe String
isMagicComment String
expected String
s0 = do
  let trim :: String -> String
trim = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
  String
s1 <- String -> String
trim (String -> String) -> 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 -> String
trim String
s0)
  String
s2 <- String -> String
trim (String -> String) -> 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
expected String
s1
  String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix String
"-}" String
s2