module Camfort.Input where
import Camfort.Analysis.Annotations
import Camfort.Helpers
import Camfort.Output
import qualified Language.Fortran.Parser.Any as FP
import qualified Language.Fortran.AST as F
import qualified Data.ByteString.Char8 as B
import Data.Data
import Data.Generics.Uniplate.Operations
import Data.List (foldl', nub, (\\), elemIndices, intercalate)
import Data.Monoid
import Data.Text.Encoding.Error (replace)
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
import System.Directory
class Default t where
defaultValue :: t
getOption :: forall t opt . (Data opt, Data t, Default opt) => [t] -> opt
getOption [] = defaultValue
getOption (x : xs) =
case universeBi x :: [opt] of
[] -> getOption xs
(opt : _) -> opt
doAnalysisSummary :: (Monoid s, Show' s) => (Filename -> F.ProgramFile A -> (s, F.ProgramFile A))
-> FileOrDir -> [Filename] -> Maybe FileOrDir -> IO ()
doAnalysisSummary aFun inSrc excludes outSrc = do
if excludes /= [] && excludes /= [""]
then putStrLn $ "Excluding " ++ intercalate "," excludes
++ " from " ++ inSrc ++ "/"
else return ()
ps <- readParseSrcDir inSrc excludes
let (out, ps') = callAndSummarise aFun ps
putStrLn . show' $ out
callAndSummarise aFun =
foldl' (\(n, pss) (f, _, ps) -> let (n', ps') = aFun f ps
in (n `mappend` n', ps' : pss)) (mempty, [])
doAnalysisReport :: ([(Filename, F.ProgramFile A)] -> r)
-> (r -> IO out)
-> FileOrDir -> [Filename] -> IO out
doAnalysisReport rFun sFun inSrc excludes = do
if excludes /= [] && excludes /= [""]
then putStrLn $ "Excluding " ++ intercalate "," excludes
++ " from " ++ inSrc ++ "/"
else return ()
ps <- readParseSrcDir inSrc excludes
let report = rFun (map (\(f, inp, ast) -> (f, ast)) ps)
sFun report
doRefactor ::
([(Filename, F.ProgramFile A)] -> (String, [(Filename, F.ProgramFile A)]))
-> FileOrDir -> [Filename] -> FileOrDir -> IO String
doRefactor rFun inSrc excludes outSrc = do
if excludes /= [] && excludes /= [""]
then putStrLn $ "Excluding " ++ intercalate "," excludes
++ " from " ++ inSrc ++ "/"
else return ()
ps <- readParseSrcDir inSrc excludes
let (report, ps') = rFun (map (\(f, inp, ast) -> (f, ast)) ps)
let outputs = reassociateSourceText ps ps'
outputFiles inSrc outSrc outputs
return report
doRefactorAndCreate ::
([(Filename, F.ProgramFile A)]
-> (String, [(Filename, F.ProgramFile A)], [(Filename, F.ProgramFile A)]))
-> FileOrDir -> [Filename] -> FileOrDir -> IO String
doRefactorAndCreate rFun inSrc excludes outSrc = do
if excludes /= [] && excludes /= [""]
then putStrLn $ "Excluding " ++ intercalate "," excludes
++ " from " ++ inSrc ++ "/"
else return ()
ps <- readParseSrcDir inSrc excludes
let (report, ps', ps'') = rFun (map (\(f, inp, ast) -> (f, ast)) ps)
let outputs = reassociateSourceText ps ps'
let outputs' = map (\(f, pf) -> (f, B.empty, pf)) ps''
outputFiles inSrc outSrc outputs
outputFiles inSrc outSrc outputs'
return report
reassociateSourceText :: [(Filename, SourceText, a)]
-> [(Filename, F.ProgramFile Annotation)]
-> [(Filename, SourceText, F.ProgramFile Annotation)]
reassociateSourceText ps ps' = zip3 (map fst ps') (map snd3 ps) (map snd ps')
where snd3 (a, b, c) = b
readParseSrcDir :: FileOrDir -> [Filename]
-> IO [(Filename, SourceText, F.ProgramFile A)]
readParseSrcDir inp excludes = do
isdir <- isDirectory inp
files <- if isdir
then do
files <- rGetDirContents inp
let excludes' = excludes ++ map (\x -> inp ++ "/" ++ x) excludes
return $ (map (\y -> inp ++ "/" ++ y) files) \\ excludes'
else return [inp]
mapM readParseSrcFile files
readParseSrcFile :: Filename -> IO (Filename, SourceText, F.ProgramFile A)
readParseSrcFile f = do
inp <- flexReadFile f
let ast = FP.fortranParser inp f
return (f, inp, fmap (const unitAnnotation) ast)
rGetDirContents :: FileOrDir -> IO [String]
rGetDirContents d = do
ds <- getDirectoryContents d
let ds' = ds \\ [".", ".."]
rec ds'
where
rec [] = return []
rec (x:xs) = do xs' <- rec xs
g <- doesDirectoryExist (d ++ "/" ++ x)
if g then
do x' <- rGetDirContents (d ++ "/" ++ x)
return $ (map (\y -> x ++ "/" ++ y) x') ++ xs'
else if isFortran x
then return (x : xs')
else return xs'
isFortran x = fileExt x `elem` [".f", ".f90", ".f77", ".cmn", ".inc"]
fileExt x = let ix = elemIndices '.' x
in if null ix then ""
else Prelude.drop (Prelude.last ix) x
flexReadFile :: String -> IO B.ByteString
flexReadFile = fmap (encodeUtf8 . decodeUtf8With (replace ' ')) . B.readFile