-- | This module provides functions for handling FORTRAN source modules.
module Language.Fortran.Extras.ModFiles
  ( isModFile
  , decodeModFiles
  )
where

import           Control.Monad                  ( foldM
                                                , forM
                                                )
import           Data.Binary                    ( decodeFileOrFail )
import           Language.Fortran.Util.ModFile  ( emptyModFile
                                                , emptyModFiles
                                                , ModFiles
                                                , modFileSuffix
                                                )
import           Language.Fortran.Util.Files    ( rGetDirContents )
import           System.FilePath                ( takeExtension
                                                , (</>)
                                                )

-- | Return TRUE iff the file extension indicates a module file.
isModFile :: String -> Bool
isModFile :: String -> Bool
isModFile = (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
modFileSuffix) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension

-- | Read suspected module files from a list of files and obtain the
-- 'Language.Fortran.Util.ModFiles' object populated by their contents.
--
-- TODO: almost equal to Language.Fortran.Analysis.ModGraph.decodeModFiles
decodeModFiles :: [FilePath] -> IO ModFiles
decodeModFiles :: [String] -> IO ModFiles
decodeModFiles = (ModFiles -> String -> IO ModFiles)
-> ModFiles -> [String] -> IO ModFiles
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
  (\ModFiles
modFiles String
d -> do
    [String]
modFileNames  <- (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isModFile ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO [String]
rGetDirContents String
d
    ModFiles
addedModFiles <- [String] -> (String -> IO ModFile) -> IO ModFiles
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
modFileNames ((String -> IO ModFile) -> IO ModFiles)
-> (String -> IO ModFile) -> IO ModFiles
forall a b. (a -> b) -> a -> b
$ \String
modFileName -> do
      Either (ByteOffset, String) ModFile
eResult <- String -> IO (Either (ByteOffset, String) ModFile)
forall a. Binary a => String -> IO (Either (ByteOffset, String) a)
decodeFileOrFail (String
d String -> String -> String
</> String
modFileName)
      case Either (ByteOffset, String) ModFile
eResult of
        Left (ByteOffset
offset, String
msg) -> do
          String -> IO ()
putStrLn
            (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$  String
modFileName
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Error at offset "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteOffset -> String
forall a. Show a => a -> String
show ByteOffset
offset
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
          ModFile -> IO ModFile
forall (m :: * -> *) a. Monad m => a -> m a
return ModFile
emptyModFile
        Right ModFile
modFile -> do
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modFileName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": successfully parsed precompiled file."
          ModFile -> IO ModFile
forall (m :: * -> *) a. Monad m => a -> m a
return ModFile
modFile
    ModFiles -> IO ModFiles
forall (m :: * -> *) a. Monad m => a -> m a
return (ModFiles -> IO ModFiles) -> ModFiles -> IO ModFiles
forall a b. (a -> b) -> a -> b
$ ModFiles
addedModFiles ModFiles -> ModFiles -> ModFiles
forall a. [a] -> [a] -> [a]
++ ModFiles
modFiles
  )
  ModFiles
emptyModFiles