module Language.Fortran.Util.Files
  ( flexReadFile
  , runCPP
  , getDirContents
  , rGetDirContents
  , expandDirs
  , listFortranFiles
  , listDirectoryRecursively
  ) 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  ((</>), takeExtension)
import           System.IO.Temp   (withSystemTempDirectory)
import           System.Process   (callProcess)
import           Data.List        ((\\), foldl')
import           Data.Char        (isNumber, toLower)
-- | Obtain a UTF-8 safe 'B.ByteString' representation of a file's contents.
--
-- Invalid UTF-8 is replaced with the space character.
flexReadFile :: FilePath -> IO B.ByteString
flexReadFile :: [Char] -> 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
. [Char] -> IO ByteString
B.readFile

-- | List files in directory, with the directory prepended to each entry.
getDirContents :: FilePath -> IO [FilePath]
getDirContents :: [Char] -> IO [[Char]]
getDirContents [Char]
d = do
  [Char]
d' <- [Char] -> IO [Char]
canonicalizePath [Char]
d
  forall a b. (a -> b) -> [a] -> [b]
map ([Char]
d' [Char] -> [Char] -> [Char]
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO [[Char]]
listDirectory [Char]
d'

-- | List files in directory recursively.
rGetDirContents :: FilePath -> IO [FilePath]
rGetDirContents :: [Char] -> IO [[Char]]
rGetDirContents [Char]
d = [Char] -> IO [Char]
canonicalizePath [Char]
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
d' -> [[Char]] -> [Char] -> IO [[Char]]
go [[Char]
d'] [Char]
d'
  where
    go :: [[Char]] -> [Char] -> IO [[Char]]
go [[Char]]
seen [Char]
d'' = do
      [[Char]]
ds <- [Char] -> IO [[Char]]
getDirectoryContents [Char]
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 [Char] -> IO [[Char]]
f forall a b. (a -> b) -> a -> b
$ [[Char]]
ds forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]
".", [Char]
".."] -- remove '.' and '..' entries
        where
          f :: [Char] -> IO [[Char]]
f [Char]
x = do
            [Char]
path <- [Char] -> IO [Char]
canonicalizePath forall a b. (a -> b) -> a -> b
$ [Char]
d [Char] -> [Char] -> [Char]
</> [Char]
x
            Bool
g <- [Char] -> IO Bool
doesDirectoryExist [Char]
path
            if Bool
g Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [Char]
path [[Char]]
seen then do
              [[Char]]
x' <- [[Char]] -> [Char] -> IO [[Char]]
go ([Char]
path forall a. a -> [a] -> [a]
: [[Char]]
seen) [Char]
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 (\ [Char]
y -> [Char]
x [Char] -> [Char] -> [Char]
</> [Char]
y) [[Char]]
x'
            else forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]
x]

-- | Run the C Pre Processor over the file before reading into a bytestring
runCPP :: Maybe String -> FilePath -> IO B.ByteString
runCPP :: Maybe [Char] -> [Char] -> IO ByteString
runCPP Maybe [Char]
Nothing [Char]
path          = [Char] -> IO ByteString
flexReadFile [Char]
path -- Nothing = do not run CPP
runCPP (Just [Char]
cppOpts) [Char]
path   = do
  -- Fold over the lines, skipping CPP pragmas and inserting blank
  -- lines as needed to make the line numbers match up for the current
  -- file. CPP pragmas for other files are just ignored.
  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)
        | [Char]
linePath forall a. Eq a => a -> a -> Bool
/= [Char]
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 => [Char] -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
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 :: [Char]
linePath = ByteString -> [Char]
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) =>
[Char] -> ([Char] -> m a) -> m a
withSystemTempDirectory [Char]
"fortran-src" forall a b. (a -> b) -> a -> b
$ \ [Char]
tmpdir -> do
    let outfile :: [Char]
outfile = [Char]
tmpdir [Char] -> [Char] -> [Char]
</> [Char]
"cpp.out"
    [Char] -> [[Char]] -> IO ()
callProcess [Char]
"cpp" forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
words [Char]
cppOpts forall a. [a] -> [a] -> [a]
++ [[Char]
"-CC", [Char]
"-nostdinc", [Char]
"-o", [Char]
outfile, [Char]
path]
    ByteString
contents <- [Char] -> IO ByteString
flexReadFile [Char]
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'

-- | Expand all paths that are directories into a list of Fortran
-- files from a recursive directory listing.
expandDirs :: [FilePath] -> IO [FilePath]
expandDirs :: [[Char]] -> IO [[Char]]
expandDirs = 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 [Char] -> IO [[Char]]
each
  where
    each :: [Char] -> IO [[Char]]
each [Char]
path = do
      Bool
isDir <- [Char] -> IO Bool
doesDirectoryExist [Char]
path
      if Bool
isDir
        then [Char] -> IO [[Char]]
listFortranFiles [Char]
path
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
path]

-- | Get a list of Fortran files under the given directory.
listFortranFiles :: FilePath -> IO [FilePath]
listFortranFiles :: [Char] -> IO [[Char]]
listFortranFiles [Char]
dir = forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
isFortran forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
listDirectoryRecursively [Char]
dir
  where
    -- | True if the file has a valid fortran extension.
    isFortran :: FilePath -> Bool
    isFortran :: [Char] -> Bool
isFortran [Char]
x = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> [Char]
takeExtension [Char]
x) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
exts
      where exts :: [[Char]]
exts = [[Char]
".f", [Char]
".f90", [Char]
".f77", [Char]
".f03"]

listDirectoryRecursively :: FilePath -> IO [FilePath]
listDirectoryRecursively :: [Char] -> IO [[Char]]
listDirectoryRecursively [Char]
dir = [Char] -> [Char] -> IO [[Char]]
listDirectoryRec [Char]
dir [Char]
""
  where
    listDirectoryRec :: FilePath -> FilePath -> IO [FilePath]
    listDirectoryRec :: [Char] -> [Char] -> IO [[Char]]
listDirectoryRec [Char]
d [Char]
f = do
      let fullPath :: [Char]
fullPath = [Char]
d [Char] -> [Char] -> [Char]
</> [Char]
f
      Bool
isDir <- [Char] -> IO Bool
doesDirectoryExist [Char]
fullPath
      if Bool
isDir
      then do
        [[Char]]
conts <- [Char] -> IO [[Char]]
listDirectory [Char]
fullPath
        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Char] -> [Char] -> IO [[Char]]
listDirectoryRec [Char]
fullPath) [[Char]]
conts
      else forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
fullPath]