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

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

-- 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 A, ByteString) -> ByteString
mkOutputText String
_ (ast :: ProgramFile A
ast@(F.ProgramFile (F.MetaInfo FortranVersion
version String
_) [ProgramUnit A]
_), 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 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)
      -- 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 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

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

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

-- Refactor use statements
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)

-- Common blocks, equivalence statements, and declarations can all
-- be refactored by the default refactoring
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
-- Arbitrary statements can be refactored *as blocks* (in order to
-- get good indenting)
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)

-- Wrapper to fix the type of refactorSyntax to deal with statements
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
                  -- If a new node is begin created then
                  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
                  -- 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
                  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 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 :: forall b. (ByteString, b) -> (String, b)
unpackFst (ByteString
x, b
y) = (ByteString -> String
B.unpack ByteString
x, b
y)