-- | This module provides an interface for rewriting textual, unparsed Fortran
-- using a diff-like algorithm.
--
-- 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
  ( RI.SourceLocation(..)
  , RI.SourceRange(..)
  , RI.Replacement(..)
  , RI.ReplacementError(..)
  , RI.ReplacementMap
  , partitionOverlapping
  , processReplacements
  , spanToSourceRange
  , spanToSourceRange2
  , sourceRangeBetweenTwoSpans
  )
where

import qualified Data.ByteString.Lazy.Char8    as BC
import qualified Language.Fortran.Rewriter.Internal
                                               as RI
import           Control.Exception              ( finally )
import           Control.Monad                  ( when )
import           Data.Bifunctor                 ( bimap )
import           Data.List                      ( partition )
import qualified Data.Map                      as M
import           Language.Fortran.Util.Position ( lineCol
                                                , SrcSpan(..)
                                                )
import           System.Directory               ( doesFileExist
                                                , removeFile
                                                , renameFile
                                                )

-- | Remove overlapping items from a list of replacements and return a pair of
-- lists containing disjoint items and overlapping items, respectively.
--
-- __Important notes:__
--
-- Replacements that come first in the list will be given precedence over later
-- items.
partitionOverlapping :: [RI.Replacement] -> ([RI.Replacement], [RI.Replacement])
partitionOverlapping :: [Replacement] -> ([Replacement], [Replacement])
partitionOverlapping [] = ([], [])
partitionOverlapping [Replacement]
repls =
  let currentRepl :: Replacement
currentRepl = forall a. [a] -> a
head [Replacement]
repls
      ([Replacement]
overlapping, [Replacement]
remaining) =
          forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement -> Replacement -> Bool
RI.areDisjoint Replacement
currentRepl) (forall a. [a] -> [a]
tail [Replacement]
repls)
      nextResult :: ([Replacement], [Replacement])
nextResult = [Replacement] -> ([Replacement], [Replacement])
partitionOverlapping [Replacement]
remaining
  in  forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
Data.Bifunctor.bimap (Replacement
currentRepl forall a. a -> [a] -> [a]
:) ([Replacement]
overlapping forall a. Semigroup a => a -> a -> a
<>) ([Replacement], [Replacement])
nextResult

-- | Apply a list of 'Replacement's to the orginal source file.
--
-- __Important notes:__
--
-- Source locations specified in replacements are 0-indexed.
--
-- Rewriting applies continuation lines when lines are longer than 72 characters.
--
-- __Example replacements:__
--
-- Delete the first character in a file
--
-- @ Replacement (SourceRange (SourceLocation 0 0) (SourceLocation 0 1)) "" @
--
-- Prepend "a" to 1 line, 2 column character
--
-- @ Replacement (SourceRange (SourceLocation 0 1) (SourceLocation 0 1)) "a" @
--
-- Replace a character located in 2 line, 4 column with "a"
--
-- @ Replacement (SourceRange (SourceLocation 1 3) (SourceLocation 1 4)) "a" @
--
-- Replace string starting in 2 line, 4 column and ending in 2 line, 6 column (inclusive) with "a"
--
-- @ Replacement (SourceRange (SourceLocation 1 3) (SourceLocation 1 6)) "a" @
--
-- @since 0.1.0.0
processReplacements :: RI.ReplacementMap -> IO ()
processReplacements :: ReplacementMap -> IO ()
processReplacements ReplacementMap
rm = [(String, [Replacement])] -> IO ()
processReplacements_ forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList ReplacementMap
rm

processReplacements_ :: [(String, [RI.Replacement])] -> IO ()
processReplacements_ :: [(String, [Replacement])] -> IO ()
processReplacements_ []                       = forall (m :: * -> *) a. Monad m => a -> m a
return ()
processReplacements_ ((String
filePath, [Replacement]
repls) : [(String, [Replacement])]
xs) = do
  ByteString
contents <- String -> IO ByteString
BC.readFile String
filePath
  let newContents :: ByteString
newContents  = ByteString -> [Replacement] -> ByteString
RI.applyReplacements ByteString
contents [Replacement]
repls
      tempFilePath :: String
tempFilePath = String
filePath forall a. [a] -> [a] -> [a]
++ String
".temp"
      maybeRm :: IO ()
maybeRm      = do
        Bool
exists <- String -> IO Bool
doesFileExist String
tempFilePath
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFile String
tempFilePath
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. IO a -> IO b -> IO a
finally IO ()
maybeRm forall a b. (a -> b) -> a -> b
$ do
    String -> ByteString -> IO ()
BC.writeFile String
tempFilePath ByteString
newContents
    String -> String -> IO ()
renameFile String
tempFilePath String
filePath
  [(String, [Replacement])] -> IO ()
processReplacements_ [(String, [Replacement])]
xs

-- | Utility function to convert 'SrcSpan' to 'SourceRange'
--
-- @since 0.1.13.7
spanToSourceRange :: SrcSpan -> RI.SourceRange
spanToSourceRange :: SrcSpan -> SourceRange
spanToSourceRange (SrcSpan Position
start Position
end) =
  let (Int
l1, Int
c1) = Position -> (Int, Int)
lineCol Position
start
      (Int
l2, Int
c2) = Position -> (Int, Int)
lineCol Position
end
  in  SourceLocation -> SourceLocation -> SourceRange
RI.SourceRange (Int -> Int -> SourceLocation
RI.SourceLocation (Int
l1 forall a. Num a => a -> a -> a
- Int
1) (Int
c1 forall a. Num a => a -> a -> a
- Int
1))
                     (Int -> Int -> SourceLocation
RI.SourceLocation (Int
l2 forall a. Num a => a -> a -> a
- Int
1) Int
c2)

-- | Given two 'Span's, returns a 'SourceRange' that starts at the starting
-- location of the first span, and ends at the starting location of the second
-- span
--
-- @since 0.1.17.2
spanToSourceRange2 :: SrcSpan -> SrcSpan -> RI.SourceRange
spanToSourceRange2 :: SrcSpan -> SrcSpan -> SourceRange
spanToSourceRange2 (SrcSpan Position
start1 Position
_) (SrcSpan Position
start2 Position
_) =
  let (Int
l1, Int
c1) = Position -> (Int, Int)
lineCol Position
start1
      (Int
l2, Int
c2) = Position -> (Int, Int)
lineCol Position
start2
  in  SourceLocation -> SourceLocation -> SourceRange
RI.SourceRange (Int -> Int -> SourceLocation
RI.SourceLocation (Int
l1 forall a. Num a => a -> a -> a
- Int
1) (Int
c1 forall a. Num a => a -> a -> a
- Int
1))
                     (Int -> Int -> SourceLocation
RI.SourceLocation (Int
l2 forall a. Num a => a -> a -> a
- Int
1) (Int
c2 forall a. Num a => a -> a -> a
- Int
1))

-- | Given two 'Span's, returns a 'SourceRange' that starts at the ending
-- location of the first span, and ends at the starting location of the second
-- span
--
-- @since 0.1.17.2
sourceRangeBetweenTwoSpans :: SrcSpan -> SrcSpan -> RI.SourceRange
sourceRangeBetweenTwoSpans :: SrcSpan -> SrcSpan -> SourceRange
sourceRangeBetweenTwoSpans (SrcSpan Position
_ Position
end1) (SrcSpan Position
start2 Position
_) =
  let (Int
l1, Int
c1) = Position -> (Int, Int)
lineCol Position
end1
      (Int
l2, Int
c2) = Position -> (Int, Int)
lineCol Position
start2
  in  SourceLocation -> SourceLocation -> SourceRange
RI.SourceRange (Int -> Int -> SourceLocation
RI.SourceLocation (Int
l1 forall a. Num a => a -> a -> a
- Int
1) Int
c1)
                     (Int -> Int -> SourceLocation
RI.SourceLocation (Int
l2 forall a. Num a => a -> a -> a
- Int
1) (Int
c2 forall a. Num a => a -> a -> a
- Int
1))