{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
{- |
Module      :  Camfort.Analysis.ModFile
Description :  CamFort-specific ModFiles helpers.
Copyright   :  (c) 2017, Dominic Orchard, Andrew Rice, Mistral Contrastin, Matthew Danish
License     :  Apache-2.0

Maintainer  :  dom.orchard@gmail.com
Stability   :  experimental
-}

module Camfort.Analysis.ModFile
  (
    -- * Getting mod files
    MFCompiler
  , genModFiles
  , genModFilesP
--  , genModFilesIO
  , getModFiles
  , readParseSrcDir
  , readParseSrcDirP
  , readParseSrcFile
  , simpleCompiler
    -- * Using mod files
  , withCombinedModuleMap
  , withCombinedEnvironment
  , lookupUniqueName
  ) where

import           Control.Lens                       (ix, preview)
import           Control.Monad                      (forM)
import           Control.Monad.IO.Class
import qualified Data.ByteString.Lazy               as LB
import           Data.Char                          (toLower)
import           Data.Data                          (Data)
import           Data.List                          ((\\))
import qualified Data.Map                           as Map
import           Data.Maybe                         (catMaybes)
import           System.Directory                   (doesDirectoryExist,
                                                     listDirectory)
import           System.FilePath                    (takeExtension, (</>))


import qualified Language.Fortran.Analysis          as FA
import qualified Language.Fortran.Analysis.Renaming as FAR
import qualified Language.Fortran.Analysis.Types    as FAT
import qualified Language.Fortran.AST               as F
import qualified Language.Fortran.Parser.Any        as FP
import qualified Language.Fortran.Util.ModFile      as FM
import           Language.Fortran.Util.Files        (flexReadFile)
import           Language.Fortran.ParserMonad       (FortranVersion(..))

import           Camfort.Analysis.Annotations       (A, unitAnnotation)
import           Camfort.Helpers

import           Pipes
-- import           Pipes.Core
import qualified Pipes.Prelude                      as P
import           Prelude                            hiding (mod)

--------------------------------------------------------------------------------
--  Getting mod files
--------------------------------------------------------------------------------

-- | Compiler for ModFile information, parameterised over an underlying monad
-- and the input to the compiler.
type MFCompiler r m = r -> FM.ModFiles -> F.ProgramFile A -> m FM.ModFile

-- | Compile the Modfile with only basic information.
simpleCompiler :: (Monad m) => MFCompiler () m
simpleCompiler :: MFCompiler () m
simpleCompiler () ModFiles
mfs = ModFile -> m ModFile
forall (m :: * -> *) a. Monad m => a -> m a
return (ModFile -> m ModFile)
-> (ProgramFile A -> ModFile) -> ProgramFile A -> m ModFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramFile (Analysis A) -> ModFile
forall a. Data a => ProgramFile (Analysis a) -> ModFile
FM.genModFile (ProgramFile (Analysis A) -> ModFile)
-> (ProgramFile A -> ProgramFile (Analysis A))
-> ProgramFile A
-> ModFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgramFile (Analysis A), ModuleMap, TypeEnv)
-> ProgramFile (Analysis A)
forall a b c. (a, b, c) -> a
fst' ((ProgramFile (Analysis A), ModuleMap, TypeEnv)
 -> ProgramFile (Analysis A))
-> (ProgramFile A
    -> (ProgramFile (Analysis A), ModuleMap, TypeEnv))
-> ProgramFile A
-> ProgramFile (Analysis A)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModFiles
-> ProgramFile A -> (ProgramFile (Analysis A), ModuleMap, TypeEnv)
forall a.
Data a =>
ModFiles
-> ProgramFile a -> (ProgramFile (Analysis a), ModuleMap, TypeEnv)
withCombinedEnvironment ModFiles
mfs
  where fst' :: (a, b, c) -> a
fst' (a
x, b
_, c
_) = a
x

genCModFile :: MFCompiler r m -> r -> FM.ModFiles -> F.ProgramFile A -> m FM.ModFile
genCModFile :: MFCompiler r m -> MFCompiler r m
genCModFile = MFCompiler r m -> MFCompiler r m
forall a. a -> a
id

-- | Generate mod files based on the given mod file compiler
genModFiles
  :: (MonadIO m)
  => Maybe FortranVersion -> FM.ModFiles -> MFCompiler r m -> r -> FilePath -> [Filename] -> m FM.ModFiles
genModFiles :: Maybe FortranVersion
-> ModFiles
-> MFCompiler r m
-> r
-> FilePath
-> [FilePath]
-> m ModFiles
genModFiles Maybe FortranVersion
mv ModFiles
mfs MFCompiler r m
mfc r
opts FilePath
fp [FilePath]
excludes = do
  [ProgramFile A]
fortranFiles <- IO [ProgramFile A] -> m [ProgramFile A]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ProgramFile A] -> m [ProgramFile A])
-> IO [ProgramFile A] -> m [ProgramFile A]
forall a b. (a -> b) -> a -> b
$ ((ProgramFile A, SourceText) -> ProgramFile A)
-> [(ProgramFile A, SourceText)] -> [ProgramFile A]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProgramFile A, SourceText) -> ProgramFile A
forall a b. (a, b) -> a
fst ([(ProgramFile A, SourceText)] -> [ProgramFile A])
-> IO [(ProgramFile A, SourceText)] -> IO [ProgramFile A]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FortranVersion
-> ModFiles
-> FilePath
-> [FilePath]
-> IO [(ProgramFile A, SourceText)]
readParseSrcDir Maybe FortranVersion
mv ModFiles
mfs FilePath
fp [FilePath]
excludes
  (ProgramFile A -> m ModFile) -> [ProgramFile A] -> m ModFiles
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (MFCompiler r m -> MFCompiler r m
forall r (m :: * -> *). MFCompiler r m -> MFCompiler r m
genCModFile MFCompiler r m
mfc r
opts ModFiles
mfs) [ProgramFile A]
fortranFiles

-- | Generate mod files based on the given mod file compiler (Pipes version)
genModFilesP
  :: forall m r. (MonadIO m)
  => Maybe FortranVersion -> FM.ModFiles -> MFCompiler r m -> r -> [FilePath] -> Producer' FM.ModFile m ()
genModFilesP :: Maybe FortranVersion
-> ModFiles
-> MFCompiler r m
-> r
-> [FilePath]
-> Producer' ModFile m ()
genModFilesP Maybe FortranVersion
mv ModFiles
mfs MFCompiler r m
mfc r
opts [FilePath]
files = Proxy x' x () (ProgramFile A) m ()
forall x' x. Proxy x' x () (ProgramFile A) m ()
parse Proxy x' x () (ProgramFile A) m ()
-> Proxy () (ProgramFile A) () ModFile m ()
-> Proxy x' x () ModFile m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Proxy () (ProgramFile A) () ModFile m ()
forall r. Pipe (ProgramFile A) ModFile m r
compile
  where
    compile :: Pipe (ProgramFile A) ModFile m r
compile = (ProgramFile A -> m ModFile) -> Pipe (ProgramFile A) ModFile m r
forall (m :: * -> *) a b r. Monad m => (a -> m b) -> Pipe a b m r
P.mapM (MFCompiler r m -> MFCompiler r m
forall r (m :: * -> *). MFCompiler r m -> MFCompiler r m
genCModFile MFCompiler r m
mfc r
opts ModFiles
mfs)
    parse :: Proxy x' x () (ProgramFile A) m ()
parse = Proxy x' x () FilePath m ()
-> (FilePath -> Proxy x' x () (ProgramFile A) m ())
-> Proxy x' x () (ProgramFile A) m ()
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for ([FilePath] -> Proxy x' x () FilePath m ()
forall (m :: * -> *) (f :: * -> *) a x' x.
(Functor m, Foldable f) =>
f a -> Proxy x' x () a m ()
each [FilePath]
files) ((FilePath -> Proxy x' x () (ProgramFile A) m ())
 -> Proxy x' x () (ProgramFile A) m ())
-> (FilePath -> Proxy x' x () (ProgramFile A) m ())
-> Proxy x' x () (ProgramFile A) m ()
forall a b. (a -> b) -> a -> b
$ \ FilePath
file -> do
      Maybe (ProgramFile A, SourceText)
mProgSrc <- IO (Maybe (ProgramFile A, SourceText))
-> Proxy
     x' x () (ProgramFile A) m (Maybe (ProgramFile A, SourceText))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (ProgramFile A, SourceText))
 -> Proxy
      x' x () (ProgramFile A) m (Maybe (ProgramFile A, SourceText)))
-> IO (Maybe (ProgramFile A, SourceText))
-> Proxy
     x' x () (ProgramFile A) m (Maybe (ProgramFile A, SourceText))
forall a b. (a -> b) -> a -> b
$ Maybe FortranVersion
-> ModFiles -> FilePath -> IO (Maybe (ProgramFile A, SourceText))
readParseSrcFile Maybe FortranVersion
mv ModFiles
mfs FilePath
file
      case Maybe (ProgramFile A, SourceText)
mProgSrc of
        Just (ProgramFile A
pf, SourceText
_) -> ProgramFile A -> Proxy x' x () (ProgramFile A) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield ProgramFile A
pf
        Maybe (ProgramFile A, SourceText)
Nothing -> () -> Proxy x' x () (ProgramFile A) m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Generate mod files based on the given mod file compiler (Pipes version)
-- (testing 'bi-directional' pipes)
-- genModFilesP'
--   :: forall x' x m r. (MonadIO m)
--   => Maybe FortranVersion -> FM.ModFiles -> MFCompiler r m -> r -> [FilePath] -> [FilePath] -> Proxy x' x () FM.ModFile m ()
-- genModFilesP' mv mfs mfc opts files incDirs = parse //> compile
--   where
--     compile :: F.ProgramFile A -> Proxy x' x () FM.ModFile m FM.ModFile
--     compile pf = do
--       mod <- liftIO undefined -- (genCModFile mfc opts mfs pf)
--       yield mod
--       -- request mod
--       pure mod

--     parse :: Proxy x' x (FM.ModFile) (F.ProgramFile A) m ()
--     parse = loop files
--       where loop [] = pure ()
--             loop (f:fs) = do
--               mProgSrc <- liftIO $ readParseSrcFile mv mfs f
--               case mProgSrc of
--                 Just (pf, _) -> do
--                   _ <- respond pf
--                   loop fs
--                 Nothing -> loop fs

-- | Generate mod files based on the given mod file compiler (PipesIO version)
-- Accumulates mods as it goes.
-- (testing)
-- genModFilesIO
--   :: Maybe FortranVersion -> FM.ModFiles -> MFCompiler r IO -> r -> [FilePath] -> IO FM.ModFiles
-- genModFilesIO mv mfs mfc opts files = fst <$> P.foldM' f (pure mfs) pure (each files)
--   where
--     f :: FM.ModFiles -> Filename -> IO [FM.ModFile]
--     f mods file = do
--       mProgSrc <- readParseSrcFile mv mods file
--       case mProgSrc of
--         Just (pf, _) -> do
--           mod <- genCModFile mfc opts mods pf
--           -- yield mod
--           pure $ mod:mods
--         Nothing -> pure mods

-- | Retrieve the ModFiles under a given path.
getModFiles :: FilePath -> IO FM.ModFiles
getModFiles :: FilePath -> IO ModFiles
getModFiles FilePath
dir = do
  -- Figure out the camfort mod files and parse them.
  [FilePath]
modFileNames <- ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isModFile ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> FilePath -> FilePath
</>)) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectoryRecursively FilePath
dir
  ModFiles
mods <- ([ModFiles] -> ModFiles) -> IO [ModFiles] -> IO ModFiles
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ModFiles] -> ModFiles
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [ModFiles] -> IO ModFiles)
-> ((FilePath -> IO ModFiles) -> IO [ModFiles])
-> (FilePath -> IO ModFiles)
-> IO ModFiles
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO ModFiles) -> IO [ModFiles]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
modFileNames ((FilePath -> IO ModFiles) -> IO ModFiles)
-> (FilePath -> IO ModFiles) -> IO ModFiles
forall a b. (a -> b) -> a -> b
$ \FilePath
modFileName -> do
    ByteString
modData <- FilePath -> IO ByteString
LB.readFile FilePath
modFileName
    let eResult :: Either FilePath ModFiles
eResult = ByteString -> Either FilePath ModFiles
FM.decodeModFile ByteString
modData
    case Either FilePath ModFiles
eResult of
      Left FilePath
msg -> do
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
modFileName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": Error: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
msg
        ModFiles -> IO ModFiles
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Right ModFiles
modFiles -> do
        ModFiles -> IO ModFiles
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModFiles
modFiles
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Successfully parsed " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (ModFiles -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ModFiles
mods) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" summary file(s)."
  ModFiles -> IO ModFiles
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModFiles
mods

  where
    isModFile :: String -> Bool
    isModFile :: FilePath -> Bool
isModFile = (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
FM.modFileSuffix) (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension

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

readParseSrcDir :: Maybe FortranVersion
                -> FM.ModFiles
                -> FileOrDir
                -> [Filename]
                -> IO [(F.ProgramFile A, SourceText)]
readParseSrcDir :: Maybe FortranVersion
-> ModFiles
-> FilePath
-> [FilePath]
-> IO [(ProgramFile A, SourceText)]
readParseSrcDir Maybe FortranVersion
mv ModFiles
mods FilePath
inp [FilePath]
excludes = do
  Bool
isdir <- FilePath -> IO Bool
isDirectory FilePath
inp
  [FilePath]
files <-
    if Bool
isdir
    then do
      [FilePath]
files <- FilePath -> IO [FilePath]
getFortranFiles FilePath
inp
      -- Compute alternate list of excludes with the
      -- the directory appended
      let excludes' :: [FilePath]
excludes' = [FilePath]
excludes [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
x -> FilePath
inp FilePath -> FilePath -> FilePath
</> FilePath
x) [FilePath]
excludes
      [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
excludes'
    else [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
inp]
  (FilePath -> IO (Maybe (ProgramFile A, SourceText)))
-> [FilePath] -> IO [(ProgramFile A, SourceText)]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (Maybe FortranVersion
-> ModFiles -> FilePath -> IO (Maybe (ProgramFile A, SourceText))
readParseSrcFile Maybe FortranVersion
mv ModFiles
mods) [FilePath]
files
  where
    mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM :: (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f = ([Maybe b] -> [b]) -> m [Maybe b] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe b] -> [b]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe b] -> m [b]) -> ([a] -> m [Maybe b]) -> [a] -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (Maybe b)) -> [a] -> m [Maybe b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m (Maybe b)
f

readParseSrcDirP :: MonadIO m
                => Maybe FortranVersion
                -> FM.ModFiles
                -> FileOrDir
                -> [Filename]
                -> Producer' (F.ProgramFile A, SourceText) m ()
readParseSrcDirP :: Maybe FortranVersion
-> ModFiles
-> FilePath
-> [FilePath]
-> Producer' (ProgramFile A, SourceText) m ()
readParseSrcDirP Maybe FortranVersion
mv ModFiles
mods FilePath
inp [FilePath]
excludes = do
  Bool
isdir <- IO Bool -> Proxy x' x () (ProgramFile A, SourceText) m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Proxy x' x () (ProgramFile A, SourceText) m Bool)
-> IO Bool -> Proxy x' x () (ProgramFile A, SourceText) m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
isDirectory FilePath
inp
  [FilePath]
files <-
    if Bool
isdir
    then do
      [FilePath]
files <- IO [FilePath]
-> Proxy x' x () (ProgramFile A, SourceText) m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath]
 -> Proxy x' x () (ProgramFile A, SourceText) m [FilePath])
-> IO [FilePath]
-> Proxy x' x () (ProgramFile A, SourceText) m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getFortranFiles FilePath
inp
      -- Compute alternate list of excludes with the
      -- the directory appended
      let excludes' :: [FilePath]
excludes' = [FilePath]
excludes [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
x -> FilePath
inp FilePath -> FilePath -> FilePath
</> FilePath
x) [FilePath]
excludes
      [FilePath]
-> Proxy x' x () (ProgramFile A, SourceText) m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath]
 -> Proxy x' x () (ProgramFile A, SourceText) m [FilePath])
-> [FilePath]
-> Proxy x' x () (ProgramFile A, SourceText) m [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
excludes'
    else [FilePath]
-> Proxy x' x () (ProgramFile A, SourceText) m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
inp]
  Proxy x' x () FilePath m ()
-> (FilePath -> Proxy x' x () (ProgramFile A, SourceText) m ())
-> Proxy x' x () (ProgramFile A, SourceText) m ()
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for ([FilePath] -> Proxy x' x () FilePath m ()
forall (m :: * -> *) (f :: * -> *) a x' x.
(Functor m, Foldable f) =>
f a -> Proxy x' x () a m ()
each [FilePath]
files) ((FilePath -> Proxy x' x () (ProgramFile A, SourceText) m ())
 -> Proxy x' x () (ProgramFile A, SourceText) m ())
-> (FilePath -> Proxy x' x () (ProgramFile A, SourceText) m ())
-> Proxy x' x () (ProgramFile A, SourceText) m ()
forall a b. (a -> b) -> a -> b
$ \ FilePath
file -> do
    Maybe (ProgramFile A, SourceText)
mProgSrc <- IO (Maybe (ProgramFile A, SourceText))
-> Proxy
     x'
     x
     ()
     (ProgramFile A, SourceText)
     m
     (Maybe (ProgramFile A, SourceText))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (ProgramFile A, SourceText))
 -> Proxy
      x'
      x
      ()
      (ProgramFile A, SourceText)
      m
      (Maybe (ProgramFile A, SourceText)))
-> IO (Maybe (ProgramFile A, SourceText))
-> Proxy
     x'
     x
     ()
     (ProgramFile A, SourceText)
     m
     (Maybe (ProgramFile A, SourceText))
forall a b. (a -> b) -> a -> b
$ Maybe FortranVersion
-> ModFiles -> FilePath -> IO (Maybe (ProgramFile A, SourceText))
readParseSrcFile Maybe FortranVersion
mv ModFiles
mods FilePath
file
    case Maybe (ProgramFile A, SourceText)
mProgSrc of
      Just (ProgramFile A, SourceText)
progSrc -> (ProgramFile A, SourceText)
-> Proxy x' x () (ProgramFile A, SourceText) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (ProgramFile A, SourceText)
progSrc
      Maybe (ProgramFile A, SourceText)
Nothing -> () -> Proxy x' x () (ProgramFile A, SourceText) m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  () -> Proxy x' x () (ProgramFile A, SourceText) m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

readParseSrcFile :: Maybe FortranVersion -> FM.ModFiles -> Filename -> IO (Maybe (F.ProgramFile A, SourceText))
readParseSrcFile :: Maybe FortranVersion
-> ModFiles -> FilePath -> IO (Maybe (ProgramFile A, SourceText))
readParseSrcFile Maybe FortranVersion
mv ModFiles
mods FilePath
f = do
  -- get file as ByteString, replacing non UTF-8 with space
  SourceText
inp <- FilePath -> IO SourceText
flexReadFile FilePath
f
  let result :: Either ParseErrorSimple (ProgramFile ())
result = case Maybe FortranVersion
mv of
        Maybe FortranVersion
Nothing -> ParserWithModFiles
FP.fortranParserWithModFiles ModFiles
mods SourceText
inp FilePath
f
        Just FortranVersion
v  -> FortranVersion -> ParserWithModFiles
FP.fortranParserWithModFilesAndVersion FortranVersion
v ModFiles
mods SourceText
inp FilePath
f
  case Either ParseErrorSimple (ProgramFile ())
result of
    Right ProgramFile ()
ast -> Maybe (ProgramFile A, SourceText)
-> IO (Maybe (ProgramFile A, SourceText))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ProgramFile A, SourceText)
 -> IO (Maybe (ProgramFile A, SourceText)))
-> Maybe (ProgramFile A, SourceText)
-> IO (Maybe (ProgramFile A, SourceText))
forall a b. (a -> b) -> a -> b
$ (ProgramFile A, SourceText) -> Maybe (ProgramFile A, SourceText)
forall a. a -> Maybe a
Just ((() -> A) -> ProgramFile () -> ProgramFile A
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (A -> () -> A
forall a b. a -> b -> a
const A
unitAnnotation) ProgramFile ()
ast, SourceText
inp)
    Left  ParseErrorSimple
err -> ParseErrorSimple -> IO ()
forall a. Show a => a -> IO ()
print ParseErrorSimple
err IO ()
-> IO (Maybe (ProgramFile A, SourceText))
-> IO (Maybe (ProgramFile A, SourceText))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ProgramFile A, SourceText)
-> IO (Maybe (ProgramFile A, SourceText))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ProgramFile A, SourceText)
forall a. Maybe a
Nothing

getFortranFiles :: FileOrDir -> IO [String]
getFortranFiles :: FilePath -> IO [FilePath]
getFortranFiles FilePath
dir =
  (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isFortran ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectoryRecursively FilePath
dir
  where
    -- | True if the file has a valid fortran extension.
    isFortran :: Filename -> Bool
    isFortran :: FilePath -> Bool
isFortran FilePath
x = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (FilePath -> FilePath
takeExtension FilePath
x) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
exts
      where exts :: [FilePath]
exts = [FilePath
".f", FilePath
".f90", FilePath
".f77", FilePath
".cmn", FilePath
".inc"]

--------------------------------------------------------------------------------
--  Using mod files
--------------------------------------------------------------------------------

-- | Normalize the 'ProgramFile' to include module map information from the
-- 'ModFiles'. Also return the module map, which links source names to unique
-- names within each program unit.
withCombinedModuleMap
  :: (Data a)
  => FM.ModFiles
  -> F.ProgramFile (FA.Analysis a)
  -> (F.ProgramFile (FA.Analysis a), FAR.ModuleMap)
withCombinedModuleMap :: ModFiles
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), ModuleMap)
withCombinedModuleMap ModFiles
mfs ProgramFile (Analysis a)
pf =
  let
    -- Use the module map derived from all of the included Camfort Mod files.
    mmap :: ModuleMap
mmap = ModFiles -> ModuleMap
FM.combinedModuleMap ModFiles
mfs
    pfRenamed :: ProgramFile (Analysis a)
pfRenamed = ModuleMap -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
ModuleMap -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
FAR.analyseRenamesWithModuleMap ModuleMap
mmap (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a b. (a -> b) -> a -> b
$ ProgramFile (Analysis a)
pf
  in (ProgramFile (Analysis a)
pfRenamed, ModuleMap
mmap ModuleMap -> ModuleMap -> ModuleMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` ProgramFile (Analysis a) -> ModuleMap
forall a. Data a => ProgramFile (Analysis a) -> ModuleMap
FM.extractModuleMap ProgramFile (Analysis a)
pfRenamed)

-- | Normalize the 'ProgramFile' to include environment information from
-- the 'ModFiles'. Also return the module map and type environment.
withCombinedEnvironment
  :: (Data a)
  => FM.ModFiles -> F.ProgramFile a -> (F.ProgramFile (FA.Analysis a), FAR.ModuleMap, FAT.TypeEnv)
withCombinedEnvironment :: ModFiles
-> ProgramFile a -> (ProgramFile (Analysis a), ModuleMap, TypeEnv)
withCombinedEnvironment ModFiles
mfs ProgramFile a
pf =
  let (ProgramFile (Analysis a)
pfRenamed, ModuleMap
mmap) = ModFiles
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), ModuleMap)
forall a.
Data a =>
ModFiles
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), ModuleMap)
withCombinedModuleMap ModFiles
mfs (ProgramFile a -> ProgramFile (Analysis a)
forall (b :: * -> *) a. Functor b => b a -> b (Analysis a)
FA.initAnalysis ProgramFile a
pf)
      moduleTEnv :: TypeEnv
moduleTEnv        = ModFiles -> TypeEnv
FM.combinedTypeEnv ModFiles
mfs
      (ProgramFile (Analysis a)
pf', TypeEnv
tenv)       = TypeEnv
-> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
forall a.
Data a =>
TypeEnv
-> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
FAT.analyseTypesWithEnv TypeEnv
moduleTEnv (ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv))
-> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
forall a b. (a -> b) -> a -> b
$ ProgramFile (Analysis a)
pfRenamed
  in (ProgramFile (Analysis a)
pf', ModuleMap
mmap, TypeEnv
tenv)

-- | From a module map, look up the unique name associated with a given source
-- name in the given program unit. Also returns the name type, which tells you
-- whether the name belongs to a subprogram, variable or intrinsic.
lookupUniqueName :: F.ProgramUnitName -> F.Name -> FAR.ModuleMap -> Maybe (F.Name, FA.NameType)
lookupUniqueName :: ProgramUnitName
-> FilePath -> ModuleMap -> Maybe (FilePath, NameType)
lookupUniqueName ProgramUnitName
puName FilePath
srcName = Getting (First (FilePath, NameType)) ModuleMap (FilePath, NameType)
-> ModuleMap -> Maybe (FilePath, NameType)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting
   (First (FilePath, NameType)) ModuleMap (FilePath, NameType)
 -> ModuleMap -> Maybe (FilePath, NameType))
-> Getting
     (First (FilePath, NameType)) ModuleMap (FilePath, NameType)
-> ModuleMap
-> Maybe (FilePath, NameType)
forall a b. (a -> b) -> a -> b
$ Index ModuleMap -> Traversal' ModuleMap (IxValue ModuleMap)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix ProgramUnitName
Index ModuleMap
puName ((Map FilePath (FilePath, NameType)
  -> Const
       (First (FilePath, NameType)) (Map FilePath (FilePath, NameType)))
 -> ModuleMap -> Const (First (FilePath, NameType)) ModuleMap)
-> (((FilePath, NameType)
     -> Const (First (FilePath, NameType)) (FilePath, NameType))
    -> Map FilePath (FilePath, NameType)
    -> Const
         (First (FilePath, NameType)) (Map FilePath (FilePath, NameType)))
-> Getting
     (First (FilePath, NameType)) ModuleMap (FilePath, NameType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map FilePath (FilePath, NameType))
-> Traversal'
     (Map FilePath (FilePath, NameType))
     (IxValue (Map FilePath (FilePath, NameType)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix FilePath
Index (Map FilePath (FilePath, NameType))
srcName