{-# LANGUAGE OverloadedStrings #-}

-- Original code from Bloomberg, used with permission.
--
-- Original authors:
--   * Daniel Beer
--   * Anthony Burzillo
--   * Raoul Hidalgo Charman
--   * Aiden Jeffrey
--   * Jason Xu
--   * Beleth Apophis
--   * Lukasz Kolodziejczyk

module Language.Fortran.Rewriter.Internal where

import           Data.Int
import           Data.Bifunctor                 ( first )
import           Data.ByteString.Lazy.Char8     ( ByteString )
import qualified Data.ByteString.Lazy.Char8    as BC
import           Control.Exception              ( Exception
                                                , throw
                                                )
import           Data.List                      ( sort
                                                , find
                                                )
import           Data.Maybe                     ( isNothing
                                                , fromMaybe
                                                , fromJust
                                                , maybeToList
                                                )
import qualified Data.Map                      as M
import           Data.Typeable                  ( Typeable )

-- | Represents location in source code.
--
-- Note that, 'SourceLocation' indicates space between characters,
-- i.e the following example:
--
-- @ SourceLocation 0 1 @
--
-- indicates position between first and second characters in a file.
data SourceLocation = SourceLocation Int Int deriving (Int -> SourceLocation -> ShowS
[SourceLocation] -> ShowS
SourceLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceLocation] -> ShowS
$cshowList :: [SourceLocation] -> ShowS
show :: SourceLocation -> String
$cshow :: SourceLocation -> String
showsPrec :: Int -> SourceLocation -> ShowS
$cshowsPrec :: Int -> SourceLocation -> ShowS
Show, SourceLocation -> SourceLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceLocation -> SourceLocation -> Bool
$c/= :: SourceLocation -> SourceLocation -> Bool
== :: SourceLocation -> SourceLocation -> Bool
$c== :: SourceLocation -> SourceLocation -> Bool
Eq)

-- | Represents range in source code.
data SourceRange = SourceRange SourceLocation SourceLocation deriving (SourceRange -> SourceRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceRange -> SourceRange -> Bool
$c/= :: SourceRange -> SourceRange -> Bool
== :: SourceRange -> SourceRange -> Bool
$c== :: SourceRange -> SourceRange -> Bool
Eq)
instance Show SourceRange where
  show :: SourceRange -> String
show (SourceRange (SourceLocation Int
l1 Int
c1) (SourceLocation Int
l2 Int
c2)) =
         String
"("
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
l1 forall a. Num a => a -> a -> a
+ Int
1) forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
c1 forall a. Num a => a -> a -> a
+ Int
1)
      forall a. [a] -> [a] -> [a]
++ String
")-("
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
l2 forall a. Num a => a -> a -> a
+ Int
1) forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
c2 forall a. Num a => a -> a -> a
+ Int
1)
      forall a. [a] -> [a] -> [a]
++ String
")"

-- | Represents a character in the original source text along with
-- any replacement operations applied to the character in place.
--
-- It expects a character (in case it's empty, Nothing should be used),
-- whether it should be removed, its 'SourceLocation' and a string that
-- should be put in place of it.
data RChar = RChar (Maybe Char) Bool SourceLocation ByteString deriving (Int -> RChar -> ShowS
[RChar] -> ShowS
RChar -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RChar] -> ShowS
$cshowList :: [RChar] -> ShowS
show :: RChar -> String
$cshow :: RChar -> String
showsPrec :: Int -> RChar -> ShowS
$cshowsPrec :: Int -> RChar -> ShowS
Show, RChar -> RChar -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RChar -> RChar -> Bool
$c/= :: RChar -> RChar -> Bool
== :: RChar -> RChar -> Bool
$c== :: RChar -> RChar -> Bool
Eq)

-- | Represents the intent to replace content in the file.
--
-- The content in 'Replacement' will be used in place of what is in
-- the range described. Note that the replacement text can be shorter
-- or larger than the original span, and it can also be multi-line.
data Replacement = Replacement SourceRange String deriving (Int -> Replacement -> ShowS
[Replacement] -> ShowS
Replacement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Replacement] -> ShowS
$cshowList :: [Replacement] -> ShowS
show :: Replacement -> String
$cshow :: Replacement -> String
showsPrec :: Int -> Replacement -> ShowS
$cshowsPrec :: Int -> Replacement -> ShowS
Show, Replacement -> Replacement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Replacement -> Replacement -> Bool
$c/= :: Replacement -> Replacement -> Bool
== :: Replacement -> Replacement -> Bool
$c== :: Replacement -> Replacement -> Bool
Eq)
instance Ord Replacement where
  (Replacement (SourceRange SourceLocation
a SourceLocation
_) String
_) <= :: Replacement -> Replacement -> Bool
<= (Replacement (SourceRange SourceLocation
b SourceLocation
_) String
_) =
    SourceLocation
a forall a. Ord a => a -> a -> Bool
< SourceLocation
b

-- | Exception raised when two 'Replacement' objects overlap
-- ('OverlappingError') or 'Replacement' points at invalid locations
-- ('InvalidRangeError').
data ReplacementError
    = OverlappingError [(Replacement, Replacement)]
    | InvalidRangeError
    deriving (Int -> ReplacementError -> ShowS
[ReplacementError] -> ShowS
ReplacementError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplacementError] -> ShowS
$cshowList :: [ReplacementError] -> ShowS
show :: ReplacementError -> String
$cshow :: ReplacementError -> String
showsPrec :: Int -> ReplacementError -> ShowS
$cshowsPrec :: Int -> ReplacementError -> ShowS
Show, Typeable, ReplacementError -> ReplacementError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplacementError -> ReplacementError -> Bool
$c/= :: ReplacementError -> ReplacementError -> Bool
== :: ReplacementError -> ReplacementError -> Bool
$c== :: ReplacementError -> ReplacementError -> Bool
Eq)

-- | As we advance through the ['RChar'] list, we consider "chunks"
-- as the unit of text written out. A chunk is either:
--
--     1. original source text up to a newline character, end of file
--        or 'RChar' described in 2.
--     2. a single 'RChar' that has non-empty replacement string
--        or is deleted.
type Chunk = [RChar]

-- | Represents map of files and replacements that will be done.
type ReplacementMap = M.Map String [Replacement]

instance Exception ReplacementError
instance Ord SourceLocation where
  (SourceLocation Int
l1 Int
c1) <= :: SourceLocation -> SourceLocation -> Bool
<= (SourceLocation Int
l2 Int
c2) =
    Int
l1 forall a. Ord a => a -> a -> Bool
< Int
l2 Bool -> Bool -> Bool
|| Int
l1 forall a. Eq a => a -> a -> Bool
== Int
l2 Bool -> Bool -> Bool
&& Int
c1 forall a. Ord a => a -> a -> Bool
<= Int
c2

-- | Parses input string into a list of annotated characters.
toRCharList :: ByteString -> [RChar]
toRCharList :: ByteString -> [RChar]
toRCharList = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourceLocation -> [RChar] -> [RChar]
appendLast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Char -> a) -> a -> ByteString -> a
BC.foldl'
  (SourceLocation, [RChar]) -> Char -> (SourceLocation, [RChar])
go
  (Int -> Int -> SourceLocation
SourceLocation Int
0 Int
0, [])
 where
  go :: (SourceLocation, [RChar]) -> Char -> (SourceLocation, [RChar])
  go :: (SourceLocation, [RChar]) -> Char -> (SourceLocation, [RChar])
go (loc :: SourceLocation
loc@(SourceLocation Int
line Int
col), [RChar]
rcs) Char
c =
    let newLoc :: SourceLocation
newLoc = if Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n'
          then Int -> Int -> SourceLocation
SourceLocation Int
line (Int
col forall a. Num a => a -> a -> a
+ Int
1)
          else Int -> Int -> SourceLocation
SourceLocation (Int
line forall a. Num a => a -> a -> a
+ Int
1) Int
0
    in  (SourceLocation
newLoc, Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar (forall a. a -> Maybe a
Just Char
c) Bool
False SourceLocation
loc ByteString
"" forall a. a -> [a] -> [a]
: [RChar]
rcs)
  appendLast :: SourceLocation -> [RChar] -> [RChar]
appendLast SourceLocation
loc = (Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar forall a. Maybe a
Nothing Bool
False SourceLocation
loc ByteString
"" forall a. a -> [a] -> [a]
:)

-- | Marks 'RChars' in a given range to be removed later.
markRChars :: [RChar] -> SourceRange -> [RChar]
markRChars :: [RChar] -> SourceRange -> [RChar]
markRChars [RChar]
rchars SourceRange
sr = [RChar] -> SourceRange -> SourceLocation -> [RChar]
markRChars_ [RChar]
rchars SourceRange
sr (Int -> Int -> SourceLocation
SourceLocation Int
0 Int
0)

markRChars_ :: [RChar] -> SourceRange -> SourceLocation -> [RChar]
markRChars_ :: [RChar] -> SourceRange -> SourceLocation -> [RChar]
markRChars_ [] SourceRange
_ SourceLocation
_ = []
markRChars_ (RChar Maybe Char
x Bool
odel SourceLocation
_ ByteString
orepl : [RChar]
xs) sr :: SourceRange
sr@(SourceRange (SourceLocation Int
sl Int
sc) (SourceLocation Int
el Int
ec)) (SourceLocation Int
l Int
c) =
    RChar
rch forall a. a -> [a] -> [a]
: [RChar]
rchs
  where
    rch :: RChar
rch =
        if    Int
l forall a. Eq a => a -> a -> Bool
== Int
sl Bool -> Bool -> Bool
&& Int
l forall a. Eq a => a -> a -> Bool
== Int
el Bool -> Bool -> Bool
&& Int
c forall a. Ord a => a -> a -> Bool
>= Int
sc Bool -> Bool -> Bool
&& Int
c forall a. Ord a => a -> a -> Bool
<  Int
ec
           Bool -> Bool -> Bool
|| Int
l forall a. Eq a => a -> a -> Bool
== Int
sl Bool -> Bool -> Bool
&& Int
l forall a. Ord a => a -> a -> Bool
<  Int
el Bool -> Bool -> Bool
&& Int
c forall a. Ord a => a -> a -> Bool
>= Int
sc
           Bool -> Bool -> Bool
|| Int
l forall a. Eq a => a -> a -> Bool
== Int
el Bool -> Bool -> Bool
&& Int
l forall a. Ord a => a -> a -> Bool
>  Int
sl Bool -> Bool -> Bool
&& Int
c forall a. Ord a => a -> a -> Bool
<  Int
ec
           Bool -> Bool -> Bool
|| Int
l forall a. Ord a => a -> a -> Bool
>  Int
sl Bool -> Bool -> Bool
&& Int
l forall a. Ord a => a -> a -> Bool
<  Int
el
        then Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar Maybe Char
x Bool
True (Int -> Int -> SourceLocation
SourceLocation Int
l Int
c) ByteString
""
        else Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar Maybe Char
x Bool
odel (Int -> Int -> SourceLocation
SourceLocation Int
l Int
c) ByteString
orepl
    rchs :: [RChar]
rchs =
        if Maybe Char
x forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Char
'\n'
        then [RChar] -> SourceRange -> SourceLocation -> [RChar]
markRChars_ [RChar]
xs SourceRange
sr (Int -> Int -> SourceLocation
SourceLocation Int
l (Int
c forall a. Num a => a -> a -> a
+ Int
1))
        else [RChar] -> SourceRange -> SourceLocation -> [RChar]
markRChars_ [RChar]
xs SourceRange
sr (Int -> Int -> SourceLocation
SourceLocation (Int
l forall a. Num a => a -> a -> a
+ Int
1) Int
0)

-- | Sets replacement string to be prepended to the given location.
setReplacementStringSL
  :: [RChar] -> SourceLocation -> ByteString -> Bool -> [RChar]
setReplacementStringSL :: [RChar] -> SourceLocation -> ByteString -> Bool -> [RChar]
setReplacementStringSL [] SourceLocation
_ ByteString
_ Bool
_ = []
setReplacementStringSL (RChar Maybe Char
och Bool
odel osl :: SourceLocation
osl@(SourceLocation Int
ol Int
oc) ByteString
orepl : [RChar]
xs) sl :: SourceLocation
sl@(SourceLocation Int
l Int
c) ByteString
repl Bool
isInsert
  = if Int
l forall a. Eq a => a -> a -> Bool
== Int
ol Bool -> Bool -> Bool
&& Int
c forall a. Eq a => a -> a -> Bool
== Int
oc
    then if Bool
isInsert
      then
        Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar Maybe Char
och
              Bool
odel
              SourceLocation
osl
              -- (repl <> if isNothing och then "" else [fromJust och])
              (ByteString
repl forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" Char -> ByteString
BC.singleton Maybe Char
och)
          forall a. a -> [a] -> [a]
: [RChar]
xs
      else Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar Maybe Char
och Bool
odel SourceLocation
osl ByteString
repl forall a. a -> [a] -> [a]
: [RChar]
xs
    else Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar Maybe Char
och Bool
odel SourceLocation
osl ByteString
orepl forall a. a -> [a] -> [a]
: [RChar] -> SourceLocation -> ByteString -> Bool -> [RChar]
setReplacementStringSL [RChar]
xs SourceLocation
sl ByteString
repl Bool
isInsert

-- | Sets replacement string to be prepended to the begining of the
-- given range.
setReplacementStringSR
  :: [RChar] -> SourceRange -> ByteString -> Bool -> [RChar]
setReplacementStringSR :: [RChar] -> SourceRange -> ByteString -> Bool -> [RChar]
setReplacementStringSR [RChar]
rchars (SourceRange SourceLocation
sls SourceLocation
_) =
  [RChar] -> SourceLocation -> ByteString -> Bool -> [RChar]
setReplacementStringSL [RChar]
rchars SourceLocation
sls

-- | Applies all deletions and additions and transforms 'RChars' back
-- to a string.
evaluateRChars :: [RChar] -> ByteString
evaluateRChars :: [RChar] -> ByteString
evaluateRChars = [ByteString] -> ByteString
BC.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map RChar -> ByteString
evaluateRChar

-- | If 'RChar' is marked as deleted, it'll be evaluated to its
-- replacement string, otherwise original character will be returned.
evaluateRChar :: RChar -> ByteString
evaluateRChar :: RChar -> ByteString
evaluateRChar (RChar Maybe Char
char Bool
del SourceLocation
_ ByteString
repl) | Bool
del = ByteString
repl
                                      | forall a. Maybe a -> Bool
isNothing Maybe Char
char = ByteString
""
                                      | Bool
otherwise = Char -> ByteString
BC.singleton forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe Char
char

-- | From ['RChar'], obtain a ('Chunk', ['RChars']) where the 'Chunk'
-- is the next 'Chunk' and the ['RChar'] are the remaining 'RChar's.
nextChunk :: [RChar] -> (Chunk, [RChar])
nextChunk :: [RChar] -> ([RChar], [RChar])
nextChunk [] = ([], [])
-- if the current chunk is the start of inline comment, prepend it to next
nextChunk (rchar :: RChar
rchar@(RChar (Just Char
'!') Bool
True SourceLocation
_ ByteString
_) : [RChar]
xs) = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first
  (RChar
rchar forall a. a -> [a] -> [a]
:)
  ([RChar], [RChar])
rec
  where rec :: ([RChar], [RChar])
rec = [RChar] -> ([RChar], [RChar])
nextChunk [RChar]
xs
nextChunk (rchar :: RChar
rchar@(RChar Maybe Char
_ Bool
True SourceLocation
_ ByteString
_) : [RChar]
xs) = ([RChar
rchar], [RChar]
xs)
nextChunk [RChar]
rchars                          = [RChar] -> ([RChar], [RChar])
nextChunk_ [RChar]
rchars

nextChunk_ :: [RChar] -> (Chunk, [RChar])
nextChunk_ :: [RChar] -> ([RChar], [RChar])
nextChunk_ [] = ([], [])
nextChunk_ ls :: [RChar]
ls@(RChar Maybe Char
_ Bool
True SourceLocation
_ ByteString
_ : [RChar]
_) = ([], [RChar]
ls)
nextChunk_ (rchar :: RChar
rchar@(RChar (Just Char
'\n') Bool
_ SourceLocation
_ ByteString
_) : [RChar]
xs) = ([RChar
rchar], [RChar]
xs)
nextChunk_ (RChar
rchar : [RChar]
xs) = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first (RChar
rchar forall a. a -> [a] -> [a]
:) ([RChar], [RChar])
rec
  where rec :: ([RChar], [RChar])
rec = [RChar] -> ([RChar], [RChar])
nextChunk_ [RChar]
xs

-- | Splits ['RChar'] into 'Chunk's.
allChunks :: [RChar] -> [Chunk]
allChunks :: [RChar] -> [[RChar]]
allChunks []     = []
allChunks [RChar]
rchars = [RChar]
chunk forall a. a -> [a] -> [a]
: [RChar] -> [[RChar]]
allChunks [RChar]
rest
  where ([RChar]
chunk, [RChar]
rest) = [RChar] -> ([RChar], [RChar])
nextChunk [RChar]
rchars

-- | Transform a list of 'Chunk's into a single string, applying
-- continuation lines when neccessary.
evaluateChunks :: [Chunk] -> ByteString
evaluateChunks :: [[RChar]] -> ByteString
evaluateChunks [[RChar]]
ls = [[RChar]] -> Int64 -> Maybe Char -> ByteString
evaluateChunks_ [[RChar]]
ls Int64
0 forall a. Maybe a
Nothing

-- | This expands the chunks from the left to right. If the length
-- of what has already been put into the current line exceeds the
-- limit of 72 characters (excluding inline comments starting with
-- '!' and implicit comments starting at column 73) then it ends
-- the current line with a continuation, otherwise it simply adds
-- the line as-is. It also calculates if the chunk is inside or outside
-- of a string literal, using that to determine where explicit comments are
-- if any.
--
-- In either case, we make sure that we are padding implicit
-- comments *from the original source* even if the tail of that
-- line has been moved onto a continuation line.
evaluateChunks_ :: [Chunk] -> Int64 -> Maybe Char -> ByteString
evaluateChunks_ :: [[RChar]] -> Int64 -> Maybe Char -> ByteString
evaluateChunks_ [] Int64
_ Maybe Char
_ = ByteString
""
evaluateChunks_ ([RChar]
x : [[RChar]]
xs) Int64
currLen Maybe Char
quotation =
  let chStr :: ByteString
chStr   = [RChar] -> ByteString
evaluateRChars [RChar]
x
      isQuote :: Char -> Bool
isQuote = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\'', Char
'"'])
      elemIndexOutsideStringLiteral :: Maybe Char -> Char -> String -> (Maybe Char, Maybe a)
elemIndexOutsideStringLiteral Maybe Char
currentState Char
needle String
haystack = forall {a}.
Num a =>
Maybe Char -> Char -> String -> a -> (Maybe Char, Maybe a)
impl
        Maybe Char
currentState
        Char
needle
        String
haystack
        a
0
         where
          -- Search space is empty, therefore no result is possible
          impl :: Maybe Char -> Char -> String -> a -> (Maybe Char, Maybe a)
impl Maybe Char
state Char
_ String
"" a
_ = (Maybe Char
state, forall a. Maybe a
Nothing)
          -- We have already entered a string literal
          impl state :: Maybe Char
state@(Just Char
quoteChar) Char
query (Char
top : String
rest) a
idx
            | Char
top forall a. Eq a => a -> a -> Bool
== Char
quoteChar = Maybe Char -> Char -> String -> a -> (Maybe Char, Maybe a)
impl forall a. Maybe a
Nothing Char
query String
rest (a
idx forall a. Num a => a -> a -> a
+ a
1)
            | Bool
otherwise        = Maybe Char -> Char -> String -> a -> (Maybe Char, Maybe a)
impl Maybe Char
state Char
query String
rest (a
idx forall a. Num a => a -> a -> a
+ a
1)
          -- Searching outside a string literal, might find the query or
          -- enter a string literal
          impl Maybe Char
Nothing Char
query (Char
top : String
rest) a
idx
            | Char
top forall a. Eq a => a -> a -> Bool
== Char
query = (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just a
idx)
            | Char -> Bool
isQuote Char
top  = Maybe Char -> Char -> String -> a -> (Maybe Char, Maybe a)
impl (forall a. a -> Maybe a
Just Char
top) Char
query String
rest (a
idx forall a. Num a => a -> a -> a
+ a
1)
            | Bool
otherwise    = Maybe Char -> Char -> String -> a -> (Maybe Char, Maybe a)
impl forall a. Maybe a
Nothing Char
query String
rest (a
idx forall a. Num a => a -> a -> a
+ a
1)

      -- length to the last line
      lastLen :: Maybe Int64
lastLen = Char -> ByteString -> Maybe Int64
BC.elemIndex Char
'\n' forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BC.reverse ByteString
chStr
      (Maybe Char
nextState, Maybe Int64
explicitCommentIdx) =
          forall {a}.
Num a =>
Maybe Char -> Char -> String -> (Maybe Char, Maybe a)
elemIndexOutsideStringLiteral Maybe Char
quotation Char
'!' (ByteString -> String
BC.unpack ByteString
chStr)
      -- length of rest of the line ignoring explicit comments
      nextLen :: Int64
nextLen = forall a. a -> Maybe a -> a
fromMaybe
        (ByteString -> Int64
BC.length ByteString
chStr)
        -- \n cannot occur inside of string literals so it is okay to search
        -- directly for it. '!' on the other hand is allowed inside strings
        -- so it needs to be searched for outside string literals
        (forall {a}. Ord a => Maybe a -> Maybe a -> Maybe a
myMin (Char -> ByteString -> Maybe Int64
BC.elemIndex Char
'\n' ByteString
chStr) Maybe Int64
explicitCommentIdx)
      overLength :: Bool
overLength = Int64
currLen forall a. Num a => a -> a -> a
+ Int64
nextLen forall a. Ord a => a -> a -> Bool
> Int64
72 Bool -> Bool -> Bool
&& Int64
currLen forall a. Ord a => a -> a -> Bool
> Int64
0
  in  if Bool
overLength
   -- start a new line
        then
          let targetCol :: Int
targetCol = Int
72 forall a. Num a => a -> a -> a
- Int
6
          in  ByteString
"\n     +"
              forall a. Semigroup a => a -> a -> a
<> [RChar] -> ByteString
evaluateRChars ([RChar] -> Int -> [RChar]
padImplicitComments [RChar]
x Int
targetCol)
              forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([[RChar]] -> Int64 -> Maybe Char -> ByteString
evaluateChunks_ [[RChar]]
xs (Int64
6 forall a. Num a => a -> a -> a
+ Int64
nextLen) Maybe Char
nextState)
                       (\Int64
len -> [[RChar]] -> Int64 -> Maybe Char -> ByteString
evaluateChunks_ [[RChar]]
xs Int64
len Maybe Char
nextState)
                       Maybe Int64
lastLen
   -- continue with the current line
        else
          let targetCol :: Int
targetCol = Int
72 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
currLen
          in  [RChar] -> ByteString
evaluateRChars ([RChar] -> Int -> [RChar]
padImplicitComments [RChar]
x Int
targetCol)
                forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([[RChar]] -> Int64 -> Maybe Char -> ByteString
evaluateChunks_ [[RChar]]
xs (Int64
currLen forall a. Num a => a -> a -> a
+ Int64
nextLen) Maybe Char
nextState)
                         (\Int64
len -> [[RChar]] -> Int64 -> Maybe Char -> ByteString
evaluateChunks_ [[RChar]]
xs Int64
len Maybe Char
nextState)
                         Maybe Int64
lastLen
 where
  -- min for maybes that doesn't short circuit if there's a Nothing
  myMin :: Maybe a -> Maybe a -> Maybe a
myMin Maybe a
Nothing  Maybe a
m        = Maybe a
m
  myMin Maybe a
m        Maybe a
Nothing  = Maybe a
m
  myMin (Just a
a) (Just a
b) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min a
a a
b
  -- Text after line 72 is an implicit comment, so should stay there regardless
  -- of what happens to the rest of the source
  padImplicitComments :: Chunk -> Int -> Chunk
  padImplicitComments :: [RChar] -> Int -> [RChar]
padImplicitComments [RChar]
chunk Int
targetCol
    | [RChar] -> Bool
isMarkedForRemoval [RChar]
chunk = [RChar]
chunk
    | Bool
otherwise =
      let zippedChunk :: [(Int, RChar)]
zippedChunk = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [RChar]
chunk
      in  case forall {a}. [(a, RChar)] -> Maybe (a, RChar)
findCommentRChar [(Int, RChar)]
zippedChunk of
            Just (Int
index, RChar
rc) ->
              case
                  forall {a}. [(a, RChar)] -> Maybe (a, RChar)
findExclamationRChar [(Int, RChar)]
zippedChunk
                    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int
id2, RChar
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
id2 forall a. Ord a => a -> a -> Bool
>= Int
index)
                of
                  Just Bool
False -> [RChar]
chunk -- in this case there's a "!" before column 73
                  Maybe Bool
_ ->
                    forall a. Int -> [a] -> [a]
take Int
index [RChar]
chunk
                      forall a. [a] -> [a] -> [a]
++ RChar -> Int -> RChar
padCommentRChar RChar
rc (Int
targetCol forall a. Num a => a -> a -> a
- Int
index)
                      forall a. a -> [a] -> [a]
:  forall a. Int -> [a] -> [a]
drop (Int
index forall a. Num a => a -> a -> a
+ Int
1) [RChar]
chunk
            Maybe (Int, RChar)
Nothing -> [RChar]
chunk
   where
    -- Find the first location of a '!' in the chunks
    findExclamationRChar :: [(a, RChar)] -> Maybe (a, RChar)
findExclamationRChar = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((\(RChar Maybe Char
c Bool
_ SourceLocation
_ ByteString
_) -> Maybe Char
c forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Char
'!') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
    -- Find the location at column 73 in the original source.
    -- If that character is a newline, ignore it
    findCommentRChar :: [(a, RChar)] -> Maybe (a, RChar)
findCommentRChar     = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
      ( (\(RChar Maybe Char
ch Bool
_ (SourceLocation Int
_ Int
cl) ByteString
_) -> Int
cl forall a. Eq a => a -> a -> Bool
== Int
72 Bool -> Bool -> Bool
&& Maybe Char
ch forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Char
'\n')
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
      )
    padCommentRChar :: RChar -> Int -> RChar
    padCommentRChar :: RChar -> Int -> RChar
padCommentRChar (RChar Maybe Char
char Bool
_ SourceLocation
loc ByteString
repl) Int
padding = Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar
      Maybe Char
char
      Bool
True
      SourceLocation
loc
      (String -> ByteString
BC.pack (forall a. Int -> a -> [a]
replicate Int
padding Char
' ' forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe Char
char) ByteString -> ByteString -> ByteString
`BC.append` ByteString
repl)


isMarkedForRemoval :: [RChar] -> Bool
isMarkedForRemoval (RChar Maybe Char
_ Bool
True SourceLocation
_ ByteString
_ : [RChar]
_) = Bool
True
isMarkedForRemoval (RChar
_ : [RChar]
rs) = [RChar] -> Bool
isMarkedForRemoval [RChar]
rs
isMarkedForRemoval [] = Bool
False

-- | Return TRUE iff the 'Replacement' constitutes a character
-- insertion.
isInsertion :: Replacement -> Bool
isInsertion :: Replacement -> Bool
isInsertion (Replacement (SourceRange (SourceLocation Int
sl Int
sc) (SourceLocation Int
el Int
ec)) String
repl)
  = Int
sl forall a. Eq a => a -> a -> Bool
== Int
el Bool -> Bool -> Bool
&& Int
sc forall a. Eq a => a -> a -> Bool
== Int
ec Bool -> Bool -> Bool
&& String
repl forall a. Eq a => a -> a -> Bool
/= String
""

insertionSR :: SourceRange -> SourceRange
insertionSR :: SourceRange -> SourceRange
insertionSR (SourceRange (SourceLocation Int
sl Int
sc) SourceLocation
_) =
  SourceLocation -> SourceLocation -> SourceRange
SourceRange (Int -> Int -> SourceLocation
SourceLocation Int
sl Int
sc) (Int -> Int -> SourceLocation
SourceLocation Int
sl (Int
sc forall a. Num a => a -> a -> a
+ Int
1))

-- | Sets a single 'Replacement' given a list of 'RChar's.
setReplacement :: [RChar] -> Replacement -> [RChar]
setReplacement :: [RChar] -> Replacement -> [RChar]
setReplacement [RChar]
rchars repl :: Replacement
repl@(Replacement SourceRange
sr String
replS) =
  let replBS :: ByteString
replBS = String -> ByteString
BC.pack String
replS
  in  if Replacement -> Bool
isInsertion Replacement
repl
        then [RChar] -> SourceRange -> ByteString -> Bool -> [RChar]
setReplacementStringSR ([RChar] -> SourceRange -> [RChar]
markRChars [RChar]
rchars (SourceRange -> SourceRange
insertionSR SourceRange
sr))
                                    (SourceRange -> SourceRange
insertionSR SourceRange
sr)
                                    ByteString
replBS
                                    Bool
True
        else [RChar] -> SourceRange -> ByteString -> Bool -> [RChar]
setReplacementStringSR ([RChar] -> SourceRange -> [RChar]
markRChars [RChar]
rchars SourceRange
sr) SourceRange
sr ByteString
replBS Bool
False

-- | Sets a list of 'Replacement's given a list of 'RChar's.
setReplacements :: [RChar] -> [Replacement] -> [RChar]
setReplacements :: [RChar] -> [Replacement] -> [RChar]
setReplacements [RChar]
rchars [Replacement]
repls =
  let rchar' :: [RChar]
rchar' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [RChar] -> Replacement -> [RChar]
setReplacement [RChar]
rchars [Replacement]
repls in [RChar] -> [RChar]
adjustLineWrap [RChar]
rchar'


-- | heuristic to wrap line after comma or right parenthesis if applicable
adjustLineWrap :: [RChar] -> [RChar]
adjustLineWrap :: [RChar] -> [RChar]
adjustLineWrap []  = []
adjustLineWrap [RChar
x] = [RChar
x]
adjustLineWrap (rc :: RChar
rc@(RChar Maybe Char
_ Bool
True SourceLocation
_ ByteString
_) : rs :: [RChar]
rs@(RChar (Just Char
c) Bool
False SourceLocation
_ ByteString
_ : [RChar]
_))
  | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
',', Char
')'] = RChar -> [RChar] -> [RChar] -> [RChar]
adjustLineWrapAux RChar
rc [] [RChar]
rs
adjustLineWrap (RChar
x : [RChar]
xs) = RChar
x forall a. a -> [a] -> [a]
: [RChar] -> [RChar]
adjustLineWrap [RChar]
xs


adjustLineWrapAux :: RChar -> [RChar] -> [RChar] -> [RChar]
adjustLineWrapAux :: RChar -> [RChar] -> [RChar] -> [RChar]
adjustLineWrapAux RChar
rc1 [RChar]
deleted (rc2 :: RChar
rc2@(RChar (Just Char
c) Bool
False SourceLocation
_ ByteString
_) : [RChar]
rs)
  | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
',', Char
')'] = RChar -> [RChar] -> [RChar] -> [RChar]
adjustLineWrapAux (RChar -> Char -> RChar
appendRC RChar
rc1 Char
c)
                                            (RChar -> RChar
deleteRC RChar
rc2 forall a. a -> [a] -> [a]
: [RChar]
deleted)
                                            [RChar]
rs
adjustLineWrapAux RChar
rc1 [RChar]
deleted [RChar]
rs = (RChar
rc1 forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
reverse [RChar]
deleted) forall a. Semigroup a => a -> a -> a
<> [RChar] -> [RChar]
adjustLineWrap [RChar]
rs


-- | Mark removal for the input 'RChar'
deleteRC :: RChar -> RChar
deleteRC :: RChar -> RChar
deleteRC (RChar Maybe Char
_ Bool
_ SourceLocation
loc ByteString
s) = Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar forall a. Maybe a
Nothing Bool
True SourceLocation
loc ByteString
s


-- | Append the input character to the replacement string
appendRC :: RChar -> Char -> RChar
appendRC :: RChar -> Char -> RChar
appendRC (RChar Maybe Char
mc Bool
_ SourceLocation
loc ByteString
s) Char
c = Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar Maybe Char
mc Bool
True SourceLocation
loc (ByteString
s ByteString -> Char -> ByteString
`BC.snoc` Char
c)


-- | Checks whether two 'Replacement's are not overlapping.
areDisjoint :: Replacement -> Replacement -> Bool
areDisjoint :: Replacement -> Replacement -> Bool
areDisjoint (Replacement (SourceRange (SourceLocation Int
r1sl Int
r1sc) (SourceLocation Int
r1el Int
r1ec)) String
_) (Replacement (SourceRange (SourceLocation Int
r2sl Int
r2sc) (SourceLocation Int
r2el Int
r2ec)) String
_)
  | Int
r2sl forall a. Ord a => a -> a -> Bool
>  Int
r1el Bool -> Bool -> Bool
|| Int
r1sl forall a. Ord a => a -> a -> Bool
>  Int
r2el = Bool
True
  | Int
r1el forall a. Eq a => a -> a -> Bool
== Int
r2sl Bool -> Bool -> Bool
&& Int
r1ec forall a. Ord a => a -> a -> Bool
<= Int
r2sc = Bool
True
  | Int
r1sl forall a. Eq a => a -> a -> Bool
== Int
r2el Bool -> Bool -> Bool
&& Int
r1sc forall a. Ord a => a -> a -> Bool
>= Int
r2ec = Bool
True
  | Bool
otherwise                    = Bool
False

-- | Checks whether:
--
--     1. the start is before the end of the range and
--     2. both start and end locations are within the code.
isValidRange :: SourceRange -> [RChar] -> Bool
isValidRange :: SourceRange -> [RChar] -> Bool
isValidRange (SourceRange SourceLocation
sl1 SourceLocation
sl2) [RChar]
rchars =
  SourceLocation
sl1 forall a. Ord a => a -> a -> Bool
<= SourceLocation
sl2 Bool -> Bool -> Bool
&& SourceLocation -> [RChar] -> Bool
isValidLocation SourceLocation
sl1 [RChar]
rchars Bool -> Bool -> Bool
&& SourceLocation -> [RChar] -> Bool
isValidLocation SourceLocation
sl2 [RChar]
rchars

isValidLocation :: SourceLocation -> [RChar] -> Bool
isValidLocation :: SourceLocation -> [RChar] -> Bool
isValidLocation SourceLocation
_  []                     = Bool
False
isValidLocation SourceLocation
sl (RChar Maybe Char
_ Bool
_ SourceLocation
csl ByteString
_ : [RChar]
xs) = SourceLocation
sl forall a. Eq a => a -> a -> Bool
== SourceLocation
csl Bool -> Bool -> Bool
|| SourceLocation -> [RChar] -> Bool
isValidLocation SourceLocation
sl [RChar]
xs

checkRanges :: [RChar] -> [Replacement] -> [RChar]
checkRanges :: [RChar] -> [Replacement] -> [RChar]
checkRanges [RChar]
rchars [Replacement]
repls = if forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
validList
  then [RChar]
rchars
  else forall a e. Exception e => e -> a
throw ReplacementError
InvalidRangeError
  where validList :: [Bool]
validList = [ SourceRange -> [RChar] -> Bool
isValidRange SourceRange
sr [RChar]
rchars | (Replacement SourceRange
sr String
_) <- [Replacement]
repls ]

checkOverlapping :: [Replacement] -> [Replacement]
checkOverlapping :: [Replacement] -> [Replacement]
checkOverlapping [Replacement]
repls = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Replacement, Replacement)]
overlappingPairs
  then [Replacement]
repls
  else forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [(Replacement, Replacement)] -> ReplacementError
OverlappingError [(Replacement, Replacement)]
overlappingPairs
 where
  overlappingPairs :: [(Replacement, Replacement)]
overlappingPairs = [Replacement] -> [(Replacement, Replacement)]
findOverlappingPairs (forall a. Ord a => [a] -> [a]
sort [Replacement]
repls)

  findOverlappingPairs :: [Replacement] -> [(Replacement, Replacement)]
  findOverlappingPairs :: [Replacement] -> [(Replacement, Replacement)]
findOverlappingPairs [] = []
  findOverlappingPairs [Replacement]
repls' =
    let currentRepl :: Replacement
currentRepl = forall a. [a] -> a
head [Replacement]
repls'
        overlapping :: [Replacement]
overlapping = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement -> Replacement -> Bool
areDisjoint Replacement
currentRepl) (forall a. [a] -> [a]
tail [Replacement]
repls')
        nextResult :: [(Replacement, Replacement)]
nextResult  = [Replacement] -> [(Replacement, Replacement)]
findOverlappingPairs (forall a. [a] -> [a]
tail [Replacement]
repls')
    in  [ (Replacement
currentRepl, Replacement
x) | Replacement
x <- [Replacement]
overlapping ] forall a. Semigroup a => a -> a -> a
<> [(Replacement, Replacement)]
nextResult

-- | Applies 'Replacement's to a string and return it.
--
-- Firstly, it transforms the string into a list of 'RChar's.
--
-- After that, it validates the 'SourceRange' of each 'Replacement'.
--
-- In the end, it splits up 'RChar's in 'Chunk's, set the
-- 'Replacement's and evaluates the 'Chunk's.
applyReplacements :: ByteString -> [Replacement] -> ByteString
applyReplacements :: ByteString -> [Replacement] -> ByteString
applyReplacements ByteString
str [Replacement]
repls = [RChar] -> [Replacement] -> ByteString
applyReplacements_ ([RChar] -> [Replacement] -> [RChar]
checkRanges [RChar]
rchars [Replacement]
repls)
                                                 ([Replacement] -> [Replacement]
checkOverlapping [Replacement]
repls)
  where rchars :: [RChar]
rchars = ByteString -> [RChar]
toRCharList ByteString
str

applyReplacements_ :: [RChar] -> [Replacement] -> ByteString
applyReplacements_ :: [RChar] -> [Replacement] -> ByteString
applyReplacements_ [RChar]
rchars [Replacement]
repls = [[RChar]] -> ByteString
evaluateChunks [[RChar]]
chunks
 where
  replRchars :: [RChar]
replRchars = [RChar] -> [Replacement] -> [RChar]
setReplacements [RChar]
rchars [Replacement]
repls
  chunks :: [[RChar]]
chunks     = [RChar] -> [[RChar]]
allChunks [RChar]
replRchars