-- | 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           Data.List                      ( partition )
import qualified Data.Map                      as M
import           Language.Fortran.Util.Position ( lineCol
                                                , SrcSpan(..)
                                                )
import           System.Directory               ( renameFile )
import           System.FilePath                ( (</>)
                                                , takeFileName
                                                , takeDirectory
                                                )
import           System.IO.Temp                 ( withTempDirectory )

-- | 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
r:[Replacement]
rs) =
  -- partition current list using front element, recurse on the disjoints
  -- (r is always treated as disjoint, which gives the precedence)
  let ([Replacement]
disjoint,     [Replacement]
overlapping)     = (Replacement -> Bool)
-> [Replacement] -> ([Replacement], [Replacement])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Replacement -> Replacement -> Bool
RI.areDisjoint Replacement
r) [Replacement]
rs
      ([Replacement]
disjointRest, [Replacement]
overlappingRest) = [Replacement] -> ([Replacement], [Replacement])
partitionOverlapping [Replacement]
disjoint
  in  (Replacement
r Replacement -> [Replacement] -> [Replacement]
forall a. a -> [a] -> [a]
: [Replacement]
disjointRest, [Replacement]
overlapping [Replacement] -> [Replacement] -> [Replacement]
forall a. Semigroup a => a -> a -> a
<> [Replacement]
overlappingRest)

-- | 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_ ([(String, [Replacement])] -> IO ())
-> [(String, [Replacement])] -> IO ()
forall a b. (a -> b) -> a -> b
$ ReplacementMap -> [(String, [Replacement])]
forall k a. Map k a -> [(k, a)]
M.toList ReplacementMap
rm

processReplacements_ :: [(String, [RI.Replacement])] -> IO ()
processReplacements_ :: [(String, [Replacement])] -> IO ()
processReplacements_ = ((String, [Replacement]) -> IO ())
-> [(String, [Replacement])] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, [Replacement]) -> IO ()
go
  where
    go :: (String, [RI.Replacement]) -> IO ()
    go :: (String, [Replacement]) -> IO ()
go (String
filePath, [Replacement]
repls) = do
      ByteString
contents <- String -> IO ByteString
BC.readFile String
filePath
      let newContents :: ByteString
newContents  = ByteString -> [Replacement] -> ByteString
RI.applyReplacements ByteString
contents [Replacement]
repls
      String -> String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
String -> String -> (String -> m a) -> m a
withTempDirectory (String -> String
takeDirectory String
filePath) (Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
takeFileName String
filePath) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmpDir ->
        let tmpFile :: String
tmpFile = String
tmpDir String -> String -> String
</> String
"tmp.f"
         in do String -> IO ()
putStrLn String
tmpFile
               String -> ByteString -> IO ()
BC.writeFile String
tmpFile ByteString
newContents
               String -> String -> IO ()
renameFile String
tmpFile String
filePath

-- | 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
                     (Int -> Int -> SourceLocation
RI.SourceLocation (Int
l2 Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
                     (Int -> Int -> SourceLocation
RI.SourceLocation (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
c2 Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
c1)
                     (Int -> Int -> SourceLocation
RI.SourceLocation (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))