{-
   Copyright 2016, Dominic Orchard, Andrew Rice, Mistral Contrastin, Matthew Danish

   Licensed under the Apache License, Version 2.0 (the "License");
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

       http://www.apache.org/licenses/LICENSE-2.0

   Unless required by applicable law or agreed to in writing, software
   distributed under the License is distributed on an "AS IS" BASIS,
   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
   See the License for the specific language governing permissions and
   limitations under the License.
-}

{-# LANGUAGE FlexibleInstances, UndecidableInstances,
    DoAndIfThenElse, MultiParamTypeClasses, FlexibleContexts,
    ScopedTypeVariables #-}

{- Provides support for outputting source files and analysis information -}

module Camfort.Output
  (
    -- * Classes
    OutputFiles(..)
  , Show'(..)
    -- * Refactoring
  , 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 qualified Language.Fortran.ParserMonad as FPM

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

-- Custom 'Show' which on strings is the identity
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
  {-| Given a directory and list of triples of filenames, with their source
       text (if it exists) and their AST, write these to the directory -}
  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
          -- Output to a directory, create if missing
          Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
outp
          -- Report which directory the files are going to
          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
"/"
          -- If the input was a directory then work out the path prefix
          -- which needs to be replaced with the new directory path
          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 is used to change the directory of a filename string.
    If the filename string has no directory then this is an identity  -}
changeDir :: Eq a => [a] -> [a] -> [a] -> [a]
changeDir :: [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

-- When the new source text is already provided
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

-- When there is a file to be reprinted (for refactoring)
instance OutputFiles (F.ProgramFile Annotation, SourceText) where
  mkOutputText :: String -> (ProgramFile Annotation, ByteString) -> ByteString
mkOutputText String
_ (ast :: ProgramFile Annotation
ast@(F.ProgramFile (F.MetaInfo FortranVersion
version String
_) [ProgramUnit Annotation]
_), ByteString
input) =
     -- If we are create a file, call the pretty printer directly
     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 Annotation -> Indentation -> String
forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> String
PP.pprintAndRender FortranVersion
version ProgramFile Annotation
ast (Int -> Indentation
forall a. a -> Maybe a
Just Int
0)
      -- Otherwise, applying the refactoring system with reprint
      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 Annotation -> 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 Annotation
ast ByteString
input

  outputFile :: (ProgramFile Annotation, ByteString) -> String
outputFile (ProgramFile Annotation
pf, ByteString
_) = ProgramFile Annotation -> String
forall a. ProgramFile a -> String
F.pfGetFilename ProgramFile Annotation
pf
  isNewFile :: (ProgramFile Annotation, ByteString) -> Bool
isNewFile (ProgramFile Annotation
_, ByteString
inp) = ByteString -> Bool
B.null ByteString
inp

{- Specifies how to do specific refactorings
  (uses generic query extension - remember extQ is non-symmetric) -}

refactoring :: Typeable a
            => FPM.FortranVersion
            -> a -> SourceText -> StateT FU.Position Identity (SourceText, Bool)
refactoring :: 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 Annotation
    -> 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 Annotation
-> StateT Position Identity (ByteString, Bool)
refactoringsForProgramUnits FortranVersion
v ByteString
inp) (a -> StateT Position Identity (ByteString, Bool))
-> (Block Annotation
    -> 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 Annotation
-> 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 :: ByteString -> a -> StateT Position Identity (ByteString, Bool)
catchAll ByteString
_ a
_ = (ByteString, Bool) -> StateT Position Identity (ByteString, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)

refactoringsForProgramUnits :: FPM.FortranVersion
                            -> SourceText
                            -> F.ProgramUnit Annotation
                            -> StateT FU.Position Identity (SourceText, Bool)
refactoringsForProgramUnits :: FortranVersion
-> ByteString
-> ProgramUnit Annotation
-> StateT Position Identity (ByteString, Bool)
refactoringsForProgramUnits FortranVersion
v ByteString
inp ProgramUnit Annotation
z =
   (StateT Int Identity ((ByteString, Bool), Position)
 -> Identity ((ByteString, Bool), Position))
-> StateT Position (StateT Int Identity) (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 Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
refactorProgramUnits FortranVersion
v ByteString
inp ProgramUnit Annotation
z)

refactorProgramUnits :: FPM.FortranVersion
                     -> SourceText
                     -> F.ProgramUnit Annotation
                     -> StateT FU.Position (State Int) (SourceText, Bool)
-- Output comments
refactorProgramUnits :: FortranVersion
-> ByteString
-> ProgramUnit Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
refactorProgramUnits FortranVersion
_ ByteString
inp (F.PUComment Annotation
ann SrcSpan
span (F.Comment String
comment)) = do
    Position
cursor <- StateT Position (StateT Int Identity) Position
forall (m :: * -> *) s. Monad m => StateT s m s
get
    if Annotation -> Bool
pRefactored Annotation
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 (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 (StateT Int Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Position
ub StateT Position (StateT Int Identity) ()
-> StateT Position (StateT Int Identity) (ByteString, Bool)
-> StateT Position (StateT Int Identity) (ByteString, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString, Bool)
-> StateT Position (StateT Int Identity) (ByteString, Bool)
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 (StateT Int Identity) (ByteString, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)

refactorProgramUnits FortranVersion
_ ByteString
_ ProgramUnit Annotation
_ = (ByteString, Bool)
-> StateT Position (StateT Int Identity) (ByteString, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)

refactoringsForBlocks :: FPM.FortranVersion
                      -> SourceText
                      -> F.Block Annotation
                      -> StateT FU.Position Identity (SourceText, Bool)
refactoringsForBlocks :: FortranVersion
-> ByteString
-> Block Annotation
-> StateT Position Identity (ByteString, Bool)
refactoringsForBlocks FortranVersion
v ByteString
inp Block Annotation
z =
   (StateT Int Identity ((ByteString, Bool), Position)
 -> Identity ((ByteString, Bool), Position))
-> StateT Position (StateT Int Identity) (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 Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
refactorBlocks FortranVersion
v ByteString
inp Block Annotation
z)

refactorBlocks :: FPM.FortranVersion
               -> SourceText
               -> F.Block Annotation
               -> StateT FU.Position (State Int) (SourceText, Bool)
-- Output comments
refactorBlocks :: FortranVersion
-> ByteString
-> Block Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
refactorBlocks FortranVersion
_ ByteString
inp (F.BlComment Annotation
ann SrcSpan
span (F.Comment String
comment)) = do
    Position
cursor <- StateT Position (StateT Int Identity) Position
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let FU.SrcSpan Position
lb Position
ub     = SrcSpan
span
        lb' :: Position
lb' | Annotation -> Bool
deleteNode Annotation
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 (t :: * -> *) a. Foldable t => t a -> Bool
null String
comment Bool -> Bool -> Bool
||
             Annotation -> Bool
deleteNode Annotation
ann  = ByteString
B.empty
           | Bool
otherwise       =  String -> ByteString
B.pack String
"\n"
    if Annotation -> Bool
pRefactored Annotation
ann
      then Position -> StateT Position (StateT Int Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Position
ub StateT Position (StateT Int Identity) ()
-> StateT Position (StateT Int Identity) (ByteString, Bool)
-> StateT Position (StateT Int Identity) (ByteString, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString, Bool)
-> StateT Position (StateT Int Identity) (ByteString, Bool)
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 (StateT Int Identity) (ByteString, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)

-- Refactor use statements
refactorBlocks FortranVersion
v ByteString
inp b :: Block Annotation
b@(F.BlStatement Annotation
_ SrcSpan
_ Maybe (Expression Annotation)
_ u :: Statement Annotation
u@F.StUse{}) = do
    Position
cursor <- StateT Position (StateT Int Identity) Position
forall (m :: * -> *) s. Monad m => StateT s m s
get
    case Annotation -> Maybe Position
refactored (Annotation -> Maybe Position) -> Annotation -> Maybe Position
forall a b. (a -> b) -> a -> b
$ Statement Annotation -> Annotation
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation Statement Annotation
u of
           Just (FU.Position Int
_ Int
rCol Int
_ String
_ Maybe (Int, String)
_) -> do
               let (FU.SrcSpan Position
lb Position
_) = Statement Annotation -> SrcSpan
forall a. Spanned a => a -> SrcSpan
FU.getSpan Statement Annotation
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 Annotation -> Indentation -> String
forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> String
PP.pprintAndRender FortranVersion
v Block Annotation
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 <- StateT Int Identity Int
-> StateT Position (StateT Int Identity) Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
               Bool
-> StateT Position (StateT Int Identity) ()
-> StateT Position (StateT Int Identity) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Annotation -> Bool
newNode (Annotation -> Bool) -> Annotation -> Bool
forall a b. (a -> b) -> a -> b
$ Statement Annotation -> Annotation
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation Statement Annotation
u)
                    (StateT Int Identity () -> StateT Position (StateT Int Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Int Identity ()
 -> StateT Position (StateT Int Identity) ())
-> StateT Int Identity ()
-> StateT Position (StateT Int Identity) ()
forall a b. (a -> b) -> a -> b
$ Int -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int -> StateT Int Identity ()) -> Int -> StateT Int Identity ()
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 (StateT Int Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Position -> StateT Position (StateT Int Identity) ())
-> Position -> StateT Position (StateT Int Identity) ()
forall a b. (a -> b) -> a -> b
$ Position -> Position
toCol0 Position
lb
               (ByteString, Bool)
-> StateT Position (StateT Int Identity) (ByteString, Bool)
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 (StateT Int Identity) (ByteString, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)

-- Common blocks, equivalence statements, and declarations can all
-- be refactored by the default refactoring
refactorBlocks FortranVersion
v ByteString
inp (F.BlStatement Annotation
_ SrcSpan
_ Maybe (Expression Annotation)
_ s :: Statement Annotation
s@F.StEquivalence{}) =
    FortranVersion
-> ByteString
-> Statement Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
refactorStatements FortranVersion
v ByteString
inp Statement Annotation
s
refactorBlocks FortranVersion
v ByteString
inp (F.BlStatement Annotation
_ SrcSpan
_ Maybe (Expression Annotation)
_ s :: Statement Annotation
s@F.StCommon{}) =
    FortranVersion
-> ByteString
-> Statement Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
refactorStatements FortranVersion
v ByteString
inp Statement Annotation
s
-- Arbitrary statements can be refactored *as blocks* (in order to
-- get good indenting)
refactorBlocks FortranVersion
v ByteString
inp b :: Block Annotation
b@F.BlStatement {} = FortranVersion
-> ByteString
-> Block Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
forall (s :: * -> *).
(Typeable s, Annotated s, Spanned (s Annotation),
 IndentablePretty (s Annotation)) =>
FortranVersion
-> ByteString
-> s Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
refactorSyntax FortranVersion
v ByteString
inp Block Annotation
b
refactorBlocks FortranVersion
_ ByteString
_ Block Annotation
_ = (ByteString, Bool)
-> StateT Position (StateT Int Identity) (ByteString, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
B.empty, Bool
False)

-- Wrapper to fix the type of refactorSyntax to deal with statements
refactorStatements :: FPM.FortranVersion -> SourceText
                   -> F.Statement A -> StateT FU.Position (State Int) (SourceText, Bool)
refactorStatements :: FortranVersion
-> ByteString
-> Statement Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
refactorStatements = FortranVersion
-> ByteString
-> Statement Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
forall (s :: * -> *).
(Typeable s, Annotated s, Spanned (s Annotation),
 IndentablePretty (s Annotation)) =>
FortranVersion
-> ByteString
-> s Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
refactorSyntax

refactorSyntax ::
   (Typeable s, F.Annotated s, FU.Spanned (s A), PP.IndentablePretty (s A))
   => FPM.FortranVersion -> SourceText
   -> s A -> StateT FU.Position (State Int) (SourceText, Bool)
refactorSyntax :: FortranVersion
-> ByteString
-> s Annotation
-> StateT Position (StateT Int Identity) (ByteString, Bool)
refactorSyntax FortranVersion
v ByteString
inp s Annotation
e = do
    Position
cursor <- StateT Position (StateT Int Identity) Position
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let a :: Annotation
a = s Annotation -> Annotation
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation s Annotation
e
    case Annotation -> Maybe Position
refactored Annotation
a of
      Maybe Position
Nothing -> (ByteString, Bool)
-> StateT Position (StateT Int Identity) (ByteString, Bool)
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 Annotation -> SrcSpan
forall a. Spanned a => a -> SrcSpan
FU.getSpan s Annotation
e
            lb' :: Position
lb' | Annotation -> Bool
deleteNode Annotation
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 | Annotation -> Bool
newNode Annotation
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 | Annotation -> Bool
deleteNode Annotation
a = ByteString
B.empty
                   | Bool
otherwise = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ FortranVersion -> s Annotation -> Indentation -> String
forall t.
IndentablePretty t =>
FortranVersion -> t -> Indentation -> String
PP.pprintAndRender FortranVersion
v s Annotation
e Indentation
indent
        ByteString
out <- if Annotation -> Bool
newNode Annotation
a then do
                  -- If a new node is begin created then
                  Int
numAdded <- StateT Int Identity Int
-> StateT Position (StateT Int Identity) Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
                  let diff :: Int
diff = Position -> Position -> Int
linesCovered Position
ub Position
lb
                  -- remove empty newlines here if extra lines were added
                  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
                  StateT Int Identity () -> StateT Position (StateT Int Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Int Identity ()
 -> StateT Position (StateT Int Identity) ())
-> StateT Int Identity ()
-> StateT Position (StateT Int Identity) ()
forall a b. (a -> b) -> a -> b
$ Int -> StateT Int Identity ()
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 (StateT Int Identity) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
out
                else ByteString -> StateT Position (StateT Int Identity) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
output
        Position -> StateT Position (StateT Int Identity) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Position -> StateT Position (StateT Int Identity) ())
-> Position -> StateT Position (StateT Int Identity) ()
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 (StateT Int Identity) (ByteString, Bool)
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 xs n' removes at most 'n' new lines characters from
the input string xs, returning the new string and the number of new
lines that were removed. Note that the number of new lines removed
might actually be less than 'n'- but in principle this should not
happen with the usaage in 'refactorDecl' -}

removeNewLines :: B.ByteString -> Int -> (B.ByteString, Int)
removeNewLines :: ByteString -> Int -> (ByteString, Int)
removeNewLines ByteString
xs Int
0 = (ByteString
xs, Int
0)
-- Deal with CR LF in the same way as just LF
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 :: (ByteString, b) -> (String, b)
unpackFst (ByteString
x, b
y) = (ByteString -> String
B.unpack ByteString
x, b
y)