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

-- | List files in directory, with the directory prepended to each entry.
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'

-- | List files in directory recursively.
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
".."] -- remove '.' and '..' entries
        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]

-- | Run the C Pre Processor over the file before reading into a bytestring
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 -- Nothing = do not run CPP
runCPP (Just FilePath
cppOpts) FilePath
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)
        | 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'