module Language.Fortran.Util.Files
( flexReadFile
, runCPP
, getDirContents
, rGetDirContents
) where
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import qualified Data.ByteString.Char8 as B
import System.Directory (listDirectory, canonicalizePath,
doesDirectoryExist, getDirectoryContents)
import System.FilePath ((</>))
import System.IO.Temp (withSystemTempDirectory)
import System.Process (callProcess)
import Data.List ((\\), foldl')
import Data.Char (isNumber)
flexReadFile :: FilePath -> IO B.ByteString
flexReadFile :: FilePath -> IO ByteString
flexReadFile = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
T.decodeUtf8With (forall b a. b -> OnError a b
T.replace Char
' ')) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
B.readFile
getDirContents :: FilePath -> IO [FilePath]
getDirContents :: FilePath -> IO [FilePath]
getDirContents FilePath
d = do
FilePath
d' <- FilePath -> IO FilePath
canonicalizePath FilePath
d
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
d' FilePath -> FilePath -> FilePath
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO [FilePath]
listDirectory FilePath
d'
rGetDirContents :: FilePath -> IO [FilePath]
rGetDirContents :: FilePath -> IO [FilePath]
rGetDirContents FilePath
d = FilePath -> IO FilePath
canonicalizePath FilePath
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
d' -> [FilePath] -> FilePath -> IO [FilePath]
go [FilePath
d'] FilePath
d'
where
go :: [FilePath] -> FilePath -> IO [FilePath]
go [FilePath]
seen FilePath
d'' = do
[FilePath]
ds <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
d''
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
f forall a b. (a -> b) -> a -> b
$ [FilePath]
ds forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath
".", FilePath
".."]
where
f :: FilePath -> IO [FilePath]
f FilePath
x = do
FilePath
path <- FilePath -> IO FilePath
canonicalizePath forall a b. (a -> b) -> a -> b
$ FilePath
d forall a. [a] -> [a] -> [a]
++ FilePath
"/" forall a. [a] -> [a] -> [a]
++ FilePath
x
Bool
g <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
if Bool
g Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem FilePath
path [FilePath]
seen then do
[FilePath]
x' <- [FilePath] -> FilePath -> IO [FilePath]
go (FilePath
path forall a. a -> [a] -> [a]
: [FilePath]
seen) FilePath
path
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ FilePath
y -> FilePath
x forall a. [a] -> [a] -> [a]
++ FilePath
"/" forall a. [a] -> [a] -> [a]
++ FilePath
y) [FilePath]
x'
else forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
x]
runCPP :: Maybe String -> FilePath -> IO B.ByteString
runCPP :: Maybe FilePath -> FilePath -> IO ByteString
runCPP Maybe FilePath
Nothing FilePath
path = FilePath -> IO ByteString
flexReadFile FilePath
path
runCPP (Just FilePath
cppOpts) FilePath
path = do
let processCPPLine :: ([B.ByteString], Int) -> B.ByteString -> ([B.ByteString], Int)
processCPPLine :: ([ByteString], Int) -> ByteString -> ([ByteString], Int)
processCPPLine ([ByteString]
revLs, Int
curLineNo) ByteString
curLine
| ByteString -> Bool
B.null ByteString
curLine Bool -> Bool -> Bool
|| ByteString -> Char
B.head ByteString
curLine forall a. Eq a => a -> a -> Bool
/= Char
'#' = (ByteString
curLineforall a. a -> [a] -> [a]
:[ByteString]
revLs, Int
curLineNo forall a. Num a => a -> a -> a
+ Int
1)
| FilePath
linePath forall a. Eq a => a -> a -> Bool
/= FilePath
path = ([ByteString]
revLs, Int
curLineNo)
| Int
newLineNo forall a. Ord a => a -> a -> Bool
<= Int
curLineNo = ([ByteString]
revLs, Int
curLineNo)
| Bool
otherwise = (forall a. Int -> a -> [a]
replicate (Int
newLineNo forall a. Num a => a -> a -> a
- Int
curLineNo) ByteString
B.empty forall a. [a] -> [a] -> [a]
++ [ByteString]
revLs,
Int
newLineNo)
where
newLineNo :: Int
newLineNo = forall a. Read a => FilePath -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
B.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
B.takeWhile Char -> Bool
isNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop Int
2 forall a b. (a -> b) -> a -> b
$ ByteString
curLine
linePath :: FilePath
linePath = ByteString -> FilePath
B.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
B.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'"') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
B.dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'"') forall a b. (a -> b) -> a -> b
$ ByteString
curLine
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> m a) -> m a
withSystemTempDirectory FilePath
"fortran-src" forall a b. (a -> b) -> a -> b
$ \ FilePath
tmpdir -> do
let outfile :: FilePath
outfile = FilePath
tmpdir FilePath -> FilePath -> FilePath
</> FilePath
"cpp.out"
FilePath -> [FilePath] -> IO ()
callProcess FilePath
"cpp" forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words FilePath
cppOpts forall a. [a] -> [a] -> [a]
++ [FilePath
"-CC", FilePath
"-nostdinc", FilePath
"-o", FilePath
outfile, FilePath
path]
ByteString
contents <- FilePath -> IO ByteString
flexReadFile FilePath
outfile
let ls :: [ByteString]
ls = ByteString -> [ByteString]
B.lines ByteString
contents
let ls' :: [ByteString]
ls' = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([ByteString], Int) -> ByteString -> ([ByteString], Int)
processCPPLine ([], Int
1) [ByteString]
ls
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.unlines [ByteString]
ls'