{-# LANGUAGE FlexibleInstances, UndecidableInstances,
DoAndIfThenElse, MultiParamTypeClasses, FlexibleContexts,
ScopedTypeVariables #-}
module Camfort.Output
(
OutputFiles(..)
, Show'(..)
, refactoring
) where
import Prelude hiding (span)
import qualified Language.Fortran.AST as F
import qualified Language.Fortran.PrettyPrint as PP
import qualified Language.Fortran.Util.Position as FU
import Language.Fortran.Version ( FortranVersion )
import Camfort.Analysis.Annotations
import Camfort.Reprint
import Camfort.Helpers
import Camfort.Helpers.Syntax
import System.Directory
import qualified Data.ByteString.Char8 as B
import Data.Generics
import Data.Functor.Identity
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Lazy
class Show' s where
show' :: s -> String
instance {-# OVERLAPS #-} Show' String where
show' :: String -> String
show' = String -> String
forall a. a -> a
id
instance {-# OVERLAPS #-} (Show' a, Show' b) => Show' (a, b) where
show' :: (a, b) -> String
show' (a
a, b
b) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall s. Show' s => s -> String
show' a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall s. Show' s => s -> String
show' b
b String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"
instance {-# OVERLAPPABLE #-} (Show a) => Show' a where
show' :: a -> String
show' = a -> String
forall a. Show a => a -> String
show
class OutputFiles t where
mkOutputText :: FileOrDir -> t -> SourceText
outputFile :: t -> Filename
isNewFile :: t -> Bool
outputFiles :: FileOrDir -> FileOrDir -> [t] -> IO ()
outputFiles String
inp String
outp [t]
pdata = do
Bool
outIsDir <- String -> IO Bool
isDirectory String
outp
if Bool
outIsDir then do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
outp
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Writing refactored files to directory: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
Bool
isdir <- String -> IO Bool
isDirectory String
inp
let inSrc :: String
inSrc = if Bool
isdir then String
inp else String -> String
getDir String
inp
[t] -> (t -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [t]
pdata (\t
x -> let f' :: String
f' = String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
changeDir String
outp String
inSrc (t -> String
forall t. OutputFiles t => t -> String
outputFile t
x)
in do String -> IO ()
checkDir String
f'
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Writing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f'
String -> ByteString -> IO ()
B.writeFile String
f' (String -> t -> ByteString
forall t. OutputFiles t => String -> t -> ByteString
mkOutputText String
outp t
x))
else
[t] -> (t -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [t]
pdata (\t
x -> do
let out :: String
out = if t -> Bool
forall t. OutputFiles t => t -> Bool
isNewFile t
x then t -> String
forall t. OutputFiles t => t -> String
outputFile t
x else String
outp
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Writing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
out
String -> ByteString -> IO ()
B.writeFile String
out (String -> t -> ByteString
forall t. OutputFiles t => String -> t -> ByteString
mkOutputText String
outp t
x))
changeDir :: Eq a => [a] -> [a] -> [a] -> [a]
changeDir :: forall a. Eq a => [a] -> [a] -> [a] -> [a]
changeDir [a]
newDir [a]
oldDir [a]
oldFilename =
[a]
newDir [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a] -> [a]
forall {a}. Eq a => [a] -> [a] -> [a]
listDiffL [a]
oldDir [a]
oldFilename
where
listDiffL :: [a] -> [a] -> [a]
listDiffL [] [a]
ys = [a]
ys
listDiffL [a]
_ [] = []
listDiffL (a
x:[a]
xs) (a
y:[a]
ys)
| a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y = [a] -> [a] -> [a]
listDiffL [a]
xs [a]
ys
| Bool
otherwise = [a]
ys
instance OutputFiles (Filename, SourceText) where
mkOutputText :: String -> (String, ByteString) -> ByteString
mkOutputText String
_ (String
_, ByteString
output) = ByteString
output
outputFile :: (String, ByteString) -> String
outputFile (String
f, ByteString
_) = String
f
isNewFile :: (String, ByteString) -> Bool
isNewFile (String, ByteString)
_ = Bool
True
instance OutputFiles (F.ProgramFile Annotation, SourceText) where
mkOutputText :: String -> (ProgramFile A, ByteString) -> ByteString
mkOutputText String
_ (ast :: ProgramFile A
ast@(F.ProgramFile (F.MetaInfo FortranVersion
version String
_) [ProgramUnit A]
_), ByteString
input) =
if ByteString -> Bool
B.null ByteString
input
then String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ FortranVersion -> ProgramFile A -> Indentation -> String
forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> String
PP.pprintAndRender FortranVersion
version ProgramFile A
ast (Int -> Indentation
forall a. a -> Maybe a
Just Int
0)
else Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity (Identity ByteString -> ByteString)
-> Identity ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Refactoring Identity
-> ProgramFile A -> ByteString -> Identity ByteString
forall (m :: * -> *) p.
(Monad m, Data p) =>
Refactoring m -> p -> ByteString -> m ByteString
reprint (FortranVersion
-> b -> ByteString -> StateT Position Identity (ByteString, Bool)
forall a.
Typeable a =>
FortranVersion
-> a -> ByteString -> StateT Position Identity (ByteString, Bool)
refactoring FortranVersion
version) ProgramFile A
ast ByteString
input
outputFile :: (ProgramFile A, ByteString) -> String
outputFile (ProgramFile A
pf, ByteString
_) = ProgramFile A -> String
forall a. ProgramFile a -> String
F.pfGetFilename ProgramFile A
pf
isNewFile :: (ProgramFile A, ByteString) -> Bool
isNewFile (ProgramFile A
_, ByteString
inp) = ByteString -> Bool
B.null ByteString
inp
refactoring :: Typeable a
=> FortranVersion
-> a -> SourceText -> StateT FU.Position Identity (SourceText, Bool)
refactoring :: forall a.
Typeable a =>
FortranVersion
-> a -> ByteString -> StateT Position Identity (ByteString, Bool)
refactoring FortranVersion
v a
z ByteString
inp = ((ByteString -> a -> StateT Position Identity (ByteString, Bool)
forall a.
ByteString -> a -> StateT Position Identity (ByteString, Bool)
catchAll ByteString
inp (a -> StateT Position Identity (ByteString, Bool))
-> (ProgramUnit A -> StateT Position Identity (ByteString, Bool))
-> a
-> StateT Position Identity (ByteString, Bool)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` FortranVersion
-> ByteString
-> ProgramUnit A
-> StateT Position Identity (ByteString, Bool)
refactoringsForProgramUnits FortranVersion
v ByteString
inp) (a -> StateT Position Identity (ByteString, Bool))
-> (Block A -> StateT Position Identity (ByteString, Bool))
-> a
-> StateT Position Identity (ByteString, Bool)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` FortranVersion
-> ByteString
-> Block A
-> StateT Position Identity (ByteString, Bool)
refactoringsForBlocks FortranVersion
v ByteString
inp) (a -> StateT Position Identity (ByteString, Bool))
-> a -> StateT Position Identity (ByteString, Bool)
forall a b. (a -> b) -> a -> b
$ a
z
where
catchAll :: SourceText -> a -> StateT FU.Position Identity (SourceText, Bool)
catchAll :: forall a.
ByteString -> a -> StateT Position Identity (ByteString, Bool)
catchAll ByteString
_ a
_ = (ByteString, Bool) -> StateT Position Identity (ByteString, Bool)
forall a. a -> StateT Position Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)
refactoringsForProgramUnits :: FortranVersion
-> SourceText
-> F.ProgramUnit Annotation
-> StateT FU.Position Identity (SourceText, Bool)
refactoringsForProgramUnits :: FortranVersion
-> ByteString
-> ProgramUnit A
-> StateT Position Identity (ByteString, Bool)
refactoringsForProgramUnits FortranVersion
v ByteString
inp ProgramUnit A
z =
(StateT Int Identity ((ByteString, Bool), Position)
-> Identity ((ByteString, Bool), Position))
-> StateT Position (State Int) (ByteString, Bool)
-> StateT Position Identity (ByteString, Bool)
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (\StateT Int Identity ((ByteString, Bool), Position)
n -> ((ByteString, Bool), Position)
-> Identity ((ByteString, Bool), Position)
forall a. a -> Identity a
Identity (((ByteString, Bool), Position)
-> Identity ((ByteString, Bool), Position))
-> ((ByteString, Bool), Position)
-> Identity ((ByteString, Bool), Position)
forall a b. (a -> b) -> a -> b
$ StateT Int Identity ((ByteString, Bool), Position)
n StateT Int Identity ((ByteString, Bool), Position)
-> Int -> ((ByteString, Bool), Position)
forall s a. State s a -> s -> a
`evalState` Int
0) (FortranVersion
-> ByteString
-> ProgramUnit A
-> StateT Position (State Int) (ByteString, Bool)
refactorProgramUnits FortranVersion
v ByteString
inp ProgramUnit A
z)
refactorProgramUnits :: FortranVersion
-> SourceText
-> F.ProgramUnit Annotation
-> StateT FU.Position (State Int) (SourceText, Bool)
refactorProgramUnits :: FortranVersion
-> ByteString
-> ProgramUnit A
-> StateT Position (State Int) (ByteString, Bool)
refactorProgramUnits FortranVersion
_ ByteString
inp (F.PUComment A
ann SrcSpan
span (F.Comment String
comment)) = do
Position
cursor <- StateT Position (State Int) Position
forall (m :: * -> *) s. Monad m => StateT s m s
get
if A -> Bool
pRefactored A
ann
then let (FU.SrcSpan Position
lb Position
ub) = SrcSpan
span
(ByteString
p0, ByteString
_) = (Position, Position) -> ByteString -> (ByteString, ByteString)
takeBounds (Position
cursor, Position
lb) ByteString
inp
nl :: ByteString
nl = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
comment then ByteString
B.empty else String -> ByteString
B.pack String
"\n"
in (Position -> StateT Position (State Int) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Position
ub StateT Position (State Int) ()
-> StateT Position (State Int) (ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a b.
StateT Position (State Int) a
-> StateT Position (State Int) b -> StateT Position (State Int) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
B.concat [ByteString
p0, String -> ByteString
B.pack String
comment, ByteString
nl], Bool
True))
else (ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)
refactorProgramUnits FortranVersion
_ ByteString
_ ProgramUnit A
_ = (ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)
refactoringsForBlocks :: FortranVersion
-> SourceText
-> F.Block Annotation
-> StateT FU.Position Identity (SourceText, Bool)
refactoringsForBlocks :: FortranVersion
-> ByteString
-> Block A
-> StateT Position Identity (ByteString, Bool)
refactoringsForBlocks FortranVersion
v ByteString
inp Block A
z =
(StateT Int Identity ((ByteString, Bool), Position)
-> Identity ((ByteString, Bool), Position))
-> StateT Position (State Int) (ByteString, Bool)
-> StateT Position Identity (ByteString, Bool)
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (\StateT Int Identity ((ByteString, Bool), Position)
n -> ((ByteString, Bool), Position)
-> Identity ((ByteString, Bool), Position)
forall a. a -> Identity a
Identity (((ByteString, Bool), Position)
-> Identity ((ByteString, Bool), Position))
-> ((ByteString, Bool), Position)
-> Identity ((ByteString, Bool), Position)
forall a b. (a -> b) -> a -> b
$ StateT Int Identity ((ByteString, Bool), Position)
n StateT Int Identity ((ByteString, Bool), Position)
-> Int -> ((ByteString, Bool), Position)
forall s a. State s a -> s -> a
`evalState` Int
0) (FortranVersion
-> ByteString
-> Block A
-> StateT Position (State Int) (ByteString, Bool)
refactorBlocks FortranVersion
v ByteString
inp Block A
z)
refactorBlocks :: FortranVersion
-> SourceText
-> F.Block Annotation
-> StateT FU.Position (State Int) (SourceText, Bool)
refactorBlocks :: FortranVersion
-> ByteString
-> Block A
-> StateT Position (State Int) (ByteString, Bool)
refactorBlocks FortranVersion
_ ByteString
inp (F.BlComment A
ann SrcSpan
span (F.Comment String
comment)) = do
Position
cursor <- StateT Position (State Int) Position
forall (m :: * -> *) s. Monad m => StateT s m s
get
let FU.SrcSpan Position
lb Position
ub = SrcSpan
span
lb' :: Position
lb' | A -> Bool
deleteNode A
ann = Position
lb { posColumn :: Int
FU.posColumn = Int
0 }
| Bool
otherwise = Position
lb
(ByteString
p0, ByteString
_) = (Position, Position) -> ByteString -> (ByteString, ByteString)
takeBounds (Position
cursor, Position
lb') ByteString
inp
nl :: ByteString
nl | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
comment Bool -> Bool -> Bool
||
A -> Bool
deleteNode A
ann = ByteString
B.empty
| Bool
otherwise = String -> ByteString
B.pack String
"\n"
if A -> Bool
pRefactored A
ann
then Position -> StateT Position (State Int) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Position
ub StateT Position (State Int) ()
-> StateT Position (State Int) (ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a b.
StateT Position (State Int) a
-> StateT Position (State Int) b -> StateT Position (State Int) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
B.concat [ByteString
p0, String -> ByteString
B.pack String
comment, ByteString
nl], Bool
True)
else (ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)
refactorBlocks FortranVersion
v ByteString
inp b :: Block A
b@(F.BlStatement A
_ SrcSpan
_ Maybe (Expression A)
_ u :: Statement A
u@F.StUse{}) = do
Position
cursor <- StateT Position (State Int) Position
forall (m :: * -> *) s. Monad m => StateT s m s
get
case A -> Maybe Position
refactored (A -> Maybe Position) -> A -> Maybe Position
forall a b. (a -> b) -> a -> b
$ Statement A -> A
forall a. Statement a -> a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation Statement A
u of
Just (FU.Position Int
_ Int
rCol Int
_ String
_ Maybe (Int, String)
_) -> do
let (FU.SrcSpan Position
lb Position
_) = Statement A -> SrcSpan
forall a. Spanned a => a -> SrcSpan
FU.getSpan Statement A
u
let (ByteString
p0, ByteString
_) = (Position, Position) -> ByteString -> (ByteString, ByteString)
takeBounds (Position
cursor, Position
lb) ByteString
inp
let out :: ByteString
out = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ FortranVersion -> Block A -> Indentation -> String
forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> String
PP.pprintAndRender FortranVersion
v Block A
b (Int -> Indentation
forall a. a -> Maybe a
Just (Int
rCol Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
Int
added <- State Int Int -> StateT Position (State Int) Int
forall (m :: * -> *) a. Monad m => m a -> StateT Position m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift State Int Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
Bool
-> StateT Position (State Int) () -> StateT Position (State Int) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (A -> Bool
newNode (A -> Bool) -> A -> Bool
forall a b. (a -> b) -> a -> b
$ Statement A -> A
forall a. Statement a -> a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation Statement A
u)
(State Int () -> StateT Position (State Int) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Position m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State Int () -> StateT Position (State Int) ())
-> State Int () -> StateT Position (State Int) ()
forall a b. (a -> b) -> a -> b
$ Int -> State Int ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int -> State Int ()) -> Int -> State Int ()
forall a b. (a -> b) -> a -> b
$ Int
added Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
countLines ByteString
out)
Position -> StateT Position (State Int) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Position -> StateT Position (State Int) ())
-> Position -> StateT Position (State Int) ()
forall a b. (a -> b) -> a -> b
$ Position -> Position
toCol0 Position
lb
(ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
p0 ByteString -> ByteString -> ByteString
`B.append` ByteString
out, Bool
True)
Maybe Position
Nothing -> (ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)
refactorBlocks FortranVersion
v ByteString
inp (F.BlStatement A
_ SrcSpan
_ Maybe (Expression A)
_ s :: Statement A
s@F.StEquivalence{}) =
FortranVersion
-> ByteString
-> Statement A
-> StateT Position (State Int) (ByteString, Bool)
refactorStatements FortranVersion
v ByteString
inp Statement A
s
refactorBlocks FortranVersion
v ByteString
inp (F.BlStatement A
_ SrcSpan
_ Maybe (Expression A)
_ s :: Statement A
s@F.StCommon{}) =
FortranVersion
-> ByteString
-> Statement A
-> StateT Position (State Int) (ByteString, Bool)
refactorStatements FortranVersion
v ByteString
inp Statement A
s
refactorBlocks FortranVersion
v ByteString
inp b :: Block A
b@F.BlStatement {} = FortranVersion
-> ByteString
-> Block A
-> StateT Position (State Int) (ByteString, Bool)
forall (s :: * -> *).
(Typeable s, Annotated s, Spanned (s A), IndentablePretty (s A)) =>
FortranVersion
-> ByteString
-> s A
-> StateT Position (State Int) (ByteString, Bool)
refactorSyntax FortranVersion
v ByteString
inp Block A
b
refactorBlocks FortranVersion
_ ByteString
_ Block A
_ = (ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)
refactorStatements :: FortranVersion -> SourceText
-> F.Statement A -> StateT FU.Position (State Int) (SourceText, Bool)
refactorStatements :: FortranVersion
-> ByteString
-> Statement A
-> StateT Position (State Int) (ByteString, Bool)
refactorStatements = FortranVersion
-> ByteString
-> Statement A
-> StateT Position (State Int) (ByteString, Bool)
forall (s :: * -> *).
(Typeable s, Annotated s, Spanned (s A), IndentablePretty (s A)) =>
FortranVersion
-> ByteString
-> s A
-> StateT Position (State Int) (ByteString, Bool)
refactorSyntax
refactorSyntax ::
(Typeable s, F.Annotated s, FU.Spanned (s A), PP.IndentablePretty (s A))
=> FortranVersion -> SourceText
-> s A -> StateT FU.Position (State Int) (SourceText, Bool)
refactorSyntax :: forall (s :: * -> *).
(Typeable s, Annotated s, Spanned (s A), IndentablePretty (s A)) =>
FortranVersion
-> ByteString
-> s A
-> StateT Position (State Int) (ByteString, Bool)
refactorSyntax FortranVersion
v ByteString
inp s A
e = do
Position
cursor <- StateT Position (State Int) Position
forall (m :: * -> *) s. Monad m => StateT s m s
get
let a :: A
a = s A -> A
forall a. s a -> a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation s A
e
case A -> Maybe Position
refactored A
a of
Maybe Position
Nothing -> (ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)
Just (FU.Position Int
_ Int
rCol Int
_ String
_ Maybe (Int, String)
_) -> do
let FU.SrcSpan Position
lb Position
ub = s A -> SrcSpan
forall a. Spanned a => a -> SrcSpan
FU.getSpan s A
e
lb' :: Position
lb' | A -> Bool
deleteNode A
a = Position
lb { posColumn :: Int
FU.posColumn = Int
0 }
| Bool
otherwise = Position
lb
(ByteString
pre, ByteString
_) = (Position, Position) -> ByteString -> (ByteString, ByteString)
takeBounds (Position
cursor, Position
lb') ByteString
inp
let indent :: Indentation
indent | A -> Bool
newNode A
a = Int -> Indentation
forall a. a -> Maybe a
Just (Int
rCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Bool
otherwise = Indentation
forall a. Maybe a
Nothing
let output :: ByteString
output | A -> Bool
deleteNode A
a = ByteString
B.empty
| Bool
otherwise = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ FortranVersion -> s A -> Indentation -> String
forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> String
PP.pprintAndRender FortranVersion
v s A
e Indentation
indent
ByteString
out <- if A -> Bool
newNode A
a then do
Int
numAdded <- State Int Int -> StateT Position (State Int) Int
forall (m :: * -> *) a. Monad m => m a -> StateT Position m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift State Int Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
let diff :: Int
diff = Position -> Position -> Int
linesCovered Position
ub Position
lb
let (ByteString
out, Int
numRemoved) = if Int
numAdded Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
diff
then ByteString -> Int -> (ByteString, Int)
removeNewLines ByteString
output Int
numAdded
else ByteString -> Int -> (ByteString, Int)
removeNewLines ByteString
output Int
diff
State Int () -> StateT Position (State Int) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Position m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State Int () -> StateT Position (State Int) ())
-> State Int () -> StateT Position (State Int) ()
forall a b. (a -> b) -> a -> b
$ Int -> State Int ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
numAdded Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numRemoved)
ByteString -> StateT Position (State Int) ByteString
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
out
else ByteString -> StateT Position (State Int) ByteString
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
output
Position -> StateT Position (State Int) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Position -> StateT Position (State Int) ())
-> Position -> StateT Position (State Int) ()
forall a b. (a -> b) -> a -> b
$ if Position -> Int
FU.posColumn Position
ub Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then Position
ub else Position
ub { posLine :: Int
FU.posLine = Position -> Int
FU.posLine Position
ub Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, posColumn :: Int
FU.posColumn = Int
1 }
(ByteString, Bool)
-> StateT Position (State Int) (ByteString, Bool)
forall a. a -> StateT Position (State Int) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
B.concat [ByteString
pre, ByteString
out], Bool
True)
countLines :: B.ByteString -> Int
countLines :: ByteString -> Int
countLines = Char -> ByteString -> Int
B.count Char
'\n'
removeNewLines :: B.ByteString -> Int -> (B.ByteString, Int)
removeNewLines :: ByteString -> Int -> (ByteString, Int)
removeNewLines ByteString
xs Int
0 = (ByteString
xs, Int
0)
removeNewLines ByteString
topXS Int
n =
case (ByteString, ByteString) -> (String, ByteString)
forall b. (ByteString, b) -> (String, b)
unpackFst (Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
4 ByteString
topXS) of
(String
"\r\n\r\n", ByteString
xs) -> (ByteString
xs', Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where (ByteString
xs', Int
n') = ByteString -> Int -> (ByteString, Int)
removeNewLines (String -> ByteString
B.pack String
"\r\n" ByteString -> ByteString -> ByteString
`B.append` ByteString
xs) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
(String, ByteString)
_ ->
case (ByteString, ByteString) -> (String, ByteString)
forall b. (ByteString, b) -> (String, b)
unpackFst (Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
2 ByteString
topXS) of
(String
"\n\n", ByteString
xs) -> (ByteString
xs', Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where (ByteString
xs', Int
n') = ByteString -> Int -> (ByteString, Int)
removeNewLines (String -> ByteString
B.pack String
"\n" ByteString -> ByteString -> ByteString
`B.append` ByteString
xs) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
(String, ByteString)
_ ->
case ByteString -> Maybe (Char, ByteString)
B.uncons ByteString
topXS of
Maybe (Char, ByteString)
Nothing -> (ByteString
topXS, Int
0)
Just (Char
x, ByteString
xs) -> (Char -> ByteString -> ByteString
B.cons Char
x ByteString
xs', Int
n)
where (ByteString
xs', Int
_) = ByteString -> Int -> (ByteString, Int)
removeNewLines ByteString
xs Int
n
unpackFst :: (B.ByteString, b) -> (String, b)
unpackFst :: forall b. (ByteString, b) -> (String, b)
unpackFst (ByteString
x, b
y) = (ByteString -> String
B.unpack ByteString
x, b
y)