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
)
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
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
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)
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))
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))