{-# 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.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
(Int -> SourceLocation -> ShowS)
-> (SourceLocation -> String)
-> ([SourceLocation] -> ShowS)
-> Show SourceLocation
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
(SourceLocation -> SourceLocation -> Bool)
-> (SourceLocation -> SourceLocation -> Bool) -> Eq SourceLocation
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
(SourceRange -> SourceRange -> Bool)
-> (SourceRange -> SourceRange -> Bool) -> Eq SourceRange
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
"("
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")-("
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      String -> ShowS
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
(Int -> RChar -> ShowS)
-> (RChar -> String) -> ([RChar] -> ShowS) -> Show RChar
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
(RChar -> RChar -> Bool) -> (RChar -> RChar -> Bool) -> Eq RChar
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
(Int -> Replacement -> ShowS)
-> (Replacement -> String)
-> ([Replacement] -> ShowS)
-> Show Replacement
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
(Replacement -> Replacement -> Bool)
-> (Replacement -> Replacement -> Bool) -> Eq Replacement
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 SourceLocation -> SourceLocation -> Bool
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
(Int -> ReplacementError -> ShowS)
-> (ReplacementError -> String)
-> ([ReplacementError] -> ShowS)
-> Show ReplacementError
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
(ReplacementError -> ReplacementError -> Bool)
-> (ReplacementError -> ReplacementError -> Bool)
-> Eq ReplacementError
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l2 Bool -> Bool -> Bool
|| Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l2 Bool -> Bool -> Bool
&& Int
c1 Int -> Int -> Bool
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 = [RChar] -> [RChar]
forall a. [a] -> [a]
reverse ([RChar] -> [RChar])
-> (ByteString -> [RChar]) -> ByteString -> [RChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceLocation -> [RChar] -> [RChar])
-> (SourceLocation, [RChar]) -> [RChar]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourceLocation -> [RChar] -> [RChar]
appendLast ((SourceLocation, [RChar]) -> [RChar])
-> (ByteString -> (SourceLocation, [RChar]))
-> ByteString
-> [RChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SourceLocation, [RChar]) -> Char -> (SourceLocation, [RChar]))
-> (SourceLocation, [RChar])
-> ByteString
-> (SourceLocation, [RChar])
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'
          then Int -> Int -> SourceLocation
SourceLocation Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          else Int -> Int -> SourceLocation
SourceLocation (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0
    in  (SourceLocation
newLoc, Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c) Bool
False SourceLocation
loc ByteString
"" RChar -> [RChar] -> [RChar]
forall a. a -> [a] -> [a]
: [RChar]
rcs)
  appendLast :: SourceLocation -> [RChar] -> [RChar]
appendLast SourceLocation
loc = (Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar Maybe Char
forall a. Maybe a
Nothing Bool
False SourceLocation
loc ByteString
"" RChar -> [RChar] -> [RChar]
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 RChar -> [RChar] -> [RChar]
forall a. a -> [a] -> [a]
: [RChar]
rchs
  where
    rch :: RChar
rch =
        if    Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
el Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sc Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
ec
           Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
el Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sc
           Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
el Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
sl Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
ec
           Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
sl Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
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 Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Maybe Char
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 Int -> Int -> Int
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 Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ol Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> (Char -> ByteString) -> Maybe Char -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" Char -> ByteString
BC.singleton Maybe Char
och)
          RChar -> [RChar] -> [RChar]
forall a. a -> [a] -> [a]
: [RChar]
xs
      else Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar Maybe Char
och Bool
odel SourceLocation
osl ByteString
repl RChar -> [RChar] -> [RChar]
forall a. a -> [a] -> [a]
: [RChar]
xs
    else Maybe Char -> Bool -> SourceLocation -> ByteString -> RChar
RChar Maybe Char
och Bool
odel SourceLocation
osl ByteString
orepl RChar -> [RChar] -> [RChar]
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 ([ByteString] -> ByteString)
-> ([RChar] -> [ByteString]) -> [RChar] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RChar -> ByteString) -> [RChar] -> [ByteString]
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
                                      | Maybe Char -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Char
char = ByteString
""
                                      | Bool
otherwise = Char -> ByteString
BC.singleton (Char -> ByteString) -> Char -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Char -> Char
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) = (RChar
rchar RChar -> [RChar] -> [RChar]
forall a. a -> [a] -> [a]
: ([RChar], [RChar]) -> [RChar]
forall a b. (a, b) -> a
fst ([RChar], [RChar])
rec, ([RChar], [RChar]) -> [RChar]
forall a b. (a, b) -> b
snd ([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) = (RChar
rchar RChar -> [RChar] -> [RChar]
forall a. a -> [a] -> [a]
: ([RChar], [RChar]) -> [RChar]
forall a b. (a, b) -> a
fst ([RChar], [RChar])
rec, ([RChar], [RChar]) -> [RChar]
forall a b. (a, b) -> b
snd ([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 [RChar] -> [[RChar]] -> [[RChar]]
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 -> ByteString
evaluateChunks_ [[RChar]]
ls Int64
0

evaluateChunks_ :: [Chunk] -> Int64 -> ByteString
evaluateChunks_ :: [[RChar]] -> Int64 -> ByteString
evaluateChunks_ []       Int64
_       = ByteString
""
evaluateChunks_ ([RChar]
x : [[RChar]]
xs) Int64
currLen =
    if Bool
overLength
    then ByteString
"\n     +"
         ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [RChar] -> ByteString
evaluateRChars [RChar]
xPadded
         ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> (Int64 -> ByteString) -> Maybe Int64 -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([[RChar]] -> Int64 -> ByteString
evaluateChunks_ [[RChar]]
xs (Int64
6 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
nextLen)) ([[RChar]] -> Int64 -> ByteString
evaluateChunks_ [[RChar]]
xs)
                Maybe Int64
lastLen
    else ByteString
chStr
         ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> (Int64 -> ByteString) -> Maybe Int64 -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([[RChar]] -> Int64 -> ByteString
evaluateChunks_ [[RChar]]
xs (Int64
currLen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
nextLen)) ([[RChar]] -> Int64 -> ByteString
evaluateChunks_ [[RChar]]
xs)
                Maybe Int64
lastLen
 where
  overLength :: Bool
overLength = Int64
currLen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
nextLen Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
72 Bool -> Bool -> Bool
&& Int64
currLen Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
  xPadded :: [RChar]
xPadded    = [RChar] -> Int -> [RChar]
padImplicitComments [RChar]
x (Int
72 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6)
  chStr :: ByteString
chStr      = [RChar] -> ByteString
evaluateRChars [RChar]
x
  nextLen :: Int64
nextLen    = Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe
    (ByteString -> Int64
BC.length ByteString
chStr)
    (Maybe Int64 -> Maybe Int64 -> Maybe Int64
forall a. Ord a => Maybe a -> Maybe a -> Maybe a
myMin (Char -> ByteString -> Maybe Int64
BC.elemIndex Char
'\n' ByteString
chStr) (Char -> ByteString -> Maybe Int64
BC.elemIndex Char
'!' ByteString
chStr)) -- don't line break for comments
  lastLen :: Maybe Int64
lastLen = Char -> ByteString -> Maybe Int64
BC.elemIndex Char
'\n' (ByteString -> Maybe Int64) -> ByteString -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BC.reverse ByteString
chStr
  -- min for maybes that doesn't short circuit if there's a Nothing
  myMin :: Maybe a -> Maybe a -> Maybe a
myMin Maybe a
y Maybe a
z = case (Maybe a
y, Maybe a
z) of
    (Just a
a , Just a
b ) -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
min a
a a
b
    (Maybe a
Nothing, Just a
a ) -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
    (Just a
a , Maybe a
Nothing) -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
    (Maybe a
Nothing, Maybe a
Nothing) -> Maybe a
forall a. Maybe a
Nothing
  -- Text after line 72 is an implicit comment, so should stay there
  padImplicitComments :: Chunk -> Int -> Chunk
  padImplicitComments :: [RChar] -> Int -> [RChar]
padImplicitComments [RChar]
chunk Int
targetCol = case [RChar] -> Maybe (Int, RChar)
findCommentRChar [RChar]
chunk of
    Just (Int
index, RChar
rc) ->
      Int -> [RChar] -> [RChar]
forall a. Int -> [a] -> [a]
take Int
index [RChar]
chunk
        [RChar] -> [RChar] -> [RChar]
forall a. [a] -> [a] -> [a]
++ RChar -> Int -> RChar
padCommentRChar RChar
rc (Int
targetCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        RChar -> [RChar] -> [RChar]
forall a. a -> [a] -> [a]
:  Int -> [RChar] -> [RChar]
forall a. Int -> [a] -> [a]
drop (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [RChar]
chunk
    Maybe (Int, RChar)
Nothing -> [RChar]
chunk
   where
    findCommentRChar :: Chunk -> Maybe (Int, RChar)
    findCommentRChar :: [RChar] -> Maybe (Int, RChar)
findCommentRChar =
      ((Int, RChar) -> Bool) -> [(Int, RChar)] -> Maybe (Int, RChar)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((\(RChar Maybe Char
_ Bool
_ (SourceLocation Int
_ Int
cl) ByteString
_) -> Int
cl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
72) (RChar -> Bool) -> ((Int, RChar) -> RChar) -> (Int, RChar) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, RChar) -> RChar
forall a b. (a, b) -> b
snd)
        ([(Int, RChar)] -> Maybe (Int, RChar))
-> ([RChar] -> [(Int, RChar)]) -> [RChar] -> Maybe (Int, RChar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [RChar] -> [(Int, RChar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..]
    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 (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
padding Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Char -> String
forall a. Maybe a -> [a]
maybeToList Maybe Char
char) ByteString -> ByteString -> ByteString
`BC.append` ByteString
repl)



-- | 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
el Bool -> Bool -> Bool
&& Int
sc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ec Bool -> Bool -> Bool
&& String
repl String -> String -> Bool
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 Int -> Int -> Int
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' = ([RChar] -> Replacement -> [RChar])
-> [RChar] -> [Replacement] -> [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 Char -> String -> Bool
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 RChar -> [RChar] -> [RChar]
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 Char -> String -> Bool
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 RChar -> [RChar] -> [RChar]
forall a. a -> [a] -> [a]
: [RChar]
deleted)
                                            [RChar]
rs
adjustLineWrapAux RChar
rc1 [RChar]
deleted [RChar]
rs = (RChar
rc1 RChar -> [RChar] -> [RChar]
forall a. a -> [a] -> [a]
: [RChar] -> [RChar]
forall a. [a] -> [a]
reverse [RChar]
deleted) [RChar] -> [RChar] -> [RChar]
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 Maybe Char
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
r1el Bool -> Bool -> Bool
|| Int
r1sl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
r2el = Bool
True
  | Int
r1el Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r2sl Bool -> Bool -> Bool
&& Int
r1ec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r2sc = Bool
True
  | Int
r1sl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r2el Bool -> Bool -> Bool
&& Int
r1sc Int -> Int -> Bool
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 SourceLocation -> SourceLocation -> Bool
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 SourceLocation -> SourceLocation -> Bool
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 [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
validList
  then [RChar]
rchars
  else ReplacementError -> [RChar]
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 [(Replacement, Replacement)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Replacement, Replacement)]
overlappingPairs
  then [Replacement]
repls
  else ReplacementError -> [Replacement]
forall a e. Exception e => e -> a
throw (ReplacementError -> [Replacement])
-> ReplacementError -> [Replacement]
forall a b. (a -> b) -> a -> b
$ [(Replacement, Replacement)] -> ReplacementError
OverlappingError [(Replacement, Replacement)]
overlappingPairs
 where
  overlappingPairs :: [(Replacement, Replacement)]
overlappingPairs = [Replacement] -> [(Replacement, Replacement)]
findOverlappingPairs ([Replacement] -> [Replacement]
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 = [Replacement] -> Replacement
forall a. [a] -> a
head [Replacement]
repls'
        overlapping :: [Replacement]
overlapping = (Replacement -> Bool) -> [Replacement] -> [Replacement]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Replacement -> Bool) -> Replacement -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement -> Replacement -> Bool
areDisjoint Replacement
currentRepl) ([Replacement] -> [Replacement]
forall a. [a] -> [a]
tail [Replacement]
repls')
        nextResult :: [(Replacement, Replacement)]
nextResult  = [Replacement] -> [(Replacement, Replacement)]
findOverlappingPairs ([Replacement] -> [Replacement]
forall a. [a] -> [a]
tail [Replacement]
repls')
    in  [ (Replacement
currentRepl, Replacement
x) | Replacement
x <- [Replacement]
overlapping ] [(Replacement, Replacement)]
-> [(Replacement, Replacement)] -> [(Replacement, Replacement)]
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