{-# 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            as FP
import qualified Language.Fortran.Util.ModFile      as FM
import           Language.Fortran.Util.Files        (flexReadFile)
import           Language.Fortran.Version           (FortranVersion(..)
                                                    ,deduceFortranVersion)

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 :: forall (m :: * -> *). Monad m => MFCompiler () m
simpleCompiler () ModFiles
mfs = ModFile -> m ModFile
forall a. a -> m a
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), Map ProgramUnitName ModEnv, TypeEnv)
-> ProgramFile (Analysis A)
forall {a} {b} {c}. (a, b, c) -> a
fst' ((ProgramFile (Analysis A), Map ProgramUnitName ModEnv, TypeEnv)
 -> ProgramFile (Analysis A))
-> (ProgramFile A
    -> (ProgramFile (Analysis A), Map ProgramUnitName ModEnv, TypeEnv))
-> ProgramFile A
-> ProgramFile (Analysis A)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModFiles
-> ProgramFile A
-> (ProgramFile (Analysis A), Map ProgramUnitName ModEnv, TypeEnv)
forall a.
Data a =>
ModFiles
-> ProgramFile a
-> (ProgramFile (Analysis a), Map ProgramUnitName ModEnv, 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 :: forall r (m :: * -> *). 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 :: forall (m :: * -> *) r.
MonadIO m =>
Maybe FortranVersion
-> ModFiles -> MFCompiler r m -> r -> Name -> [Name] -> m ModFiles
genModFiles Maybe FortranVersion
mv ModFiles
mfs MFCompiler r m
mfc r
opts Name
fp [Name]
excludes = do
  [ProgramFile A]
fortranFiles <- IO [ProgramFile A] -> m [ProgramFile A]
forall a. IO a -> m 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 a b. (a -> b) -> [a] -> [b]
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 -> Name -> [Name] -> IO [(ProgramFile A, SourceText)]
readParseSrcDir Maybe FortranVersion
mv ModFiles
mfs Name
fp [Name]
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 :: forall (m :: * -> *) r.
MonadIO m =>
Maybe FortranVersion
-> ModFiles
-> MFCompiler r m
-> r
-> [Name]
-> Producer' ModFile m ()
genModFilesP Maybe FortranVersion
mv ModFiles
mfs MFCompiler r m
mfc r
opts [Name]
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 () Name m ()
-> (Name -> 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 ([Name] -> Proxy x' x () Name m ()
forall (m :: * -> *) (f :: * -> *) a x' x.
(Functor m, Foldable f) =>
f a -> Proxy x' x () a m ()
each [Name]
files) ((Name -> Proxy x' x () (ProgramFile A) m ())
 -> Proxy x' x () (ProgramFile A) m ())
-> (Name -> Proxy x' x () (ProgramFile A) m ())
-> Proxy x' x () (ProgramFile A) m ()
forall a b. (a -> b) -> a -> b
$ \ Name
file -> do
      Maybe (ProgramFile A, SourceText)
mProgSrc <- IO (Maybe (ProgramFile A, SourceText))
-> Proxy
     x' x () (ProgramFile A) m (Maybe (ProgramFile A, SourceText))
forall a. IO a -> Proxy x' x () (ProgramFile A) m a
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 -> Name -> IO (Maybe (ProgramFile A, SourceText))
readParseSrcFile Maybe FortranVersion
mv ModFiles
mfs Name
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 a. a -> Proxy x' x () (ProgramFile A) m a
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 :: Name -> IO ModFiles
getModFiles Name
dir = do
  -- Figure out the camfort mod files and parse them.
  [Name]
modFileNames <- ((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
isModFile ([Name] -> [Name]) -> ([Name] -> [Name]) -> [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name
dir Name -> Name -> Name
</>)) ([Name] -> [Name]) -> IO [Name] -> IO [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IO [Name]
listDirectoryRecursively Name
dir
  ModFiles
mods <- ([ModFiles] -> ModFiles) -> IO [ModFiles] -> IO ModFiles
forall a b. (a -> b) -> IO a -> IO b
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)
-> ((Name -> IO ModFiles) -> IO [ModFiles])
-> (Name -> IO ModFiles)
-> IO ModFiles
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> (Name -> IO ModFiles) -> IO [ModFiles]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Name]
modFileNames ((Name -> IO ModFiles) -> IO ModFiles)
-> (Name -> IO ModFiles) -> IO ModFiles
forall a b. (a -> b) -> a -> b
$ \Name
modFileName -> do
    ByteString
modData <- Name -> IO ByteString
LB.readFile Name
modFileName
    let eResult :: Either Name ModFiles
eResult = ByteString -> Either Name ModFiles
FM.decodeModFile ByteString
modData
    case Either Name ModFiles
eResult of
      Left Name
msg -> do
        Name -> IO ()
putStrLn (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Name
modFileName Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
": Error: " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name -> Name
forall a. Show a => a -> Name
show Name
msg
        ModFiles -> IO ModFiles
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Right ModFiles
modFiles -> do
        ModFiles -> IO ModFiles
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModFiles
modFiles
  Name -> IO ()
putStrLn (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Name
"Successfully parsed " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Int -> Name
forall a. Show a => a -> Name
show (ModFiles -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ModFiles
mods) Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" summary file(s)."
  ModFiles -> IO ModFiles
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModFiles
mods

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

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

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

readParseSrcDirP :: MonadIO m
                => Maybe FortranVersion
                -> FM.ModFiles
                -> FileOrDir
                -> [Filename]
                -> Producer' (F.ProgramFile A, SourceText) m ()
readParseSrcDirP :: forall (m :: * -> *).
MonadIO m =>
Maybe FortranVersion
-> ModFiles
-> Name
-> [Name]
-> Producer' (ProgramFile A, SourceText) m ()
readParseSrcDirP Maybe FortranVersion
mv ModFiles
mods Name
inp [Name]
excludes = do
  Bool
isdir <- IO Bool -> Proxy x' x () (ProgramFile A, SourceText) m Bool
forall a. IO a -> Proxy x' x () (ProgramFile A, SourceText) m a
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
$ Name -> IO Bool
isDirectory Name
inp
  [Name]
files <-
    if Bool
isdir
    then do
      [Name]
files <- IO [Name] -> Proxy x' x () (ProgramFile A, SourceText) m [Name]
forall a. IO a -> Proxy x' x () (ProgramFile A, SourceText) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Name] -> Proxy x' x () (ProgramFile A, SourceText) m [Name])
-> IO [Name] -> Proxy x' x () (ProgramFile A, SourceText) m [Name]
forall a b. (a -> b) -> a -> b
$ Name -> IO [Name]
getFortranFiles Name
inp
      -- Compute alternate list of excludes with the
      -- the directory appended
      let excludes' :: [Name]
excludes' = [Name]
excludes [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
x -> Name
inp Name -> Name -> Name
</> Name
x) [Name]
excludes
      [Name] -> Proxy x' x () (ProgramFile A, SourceText) m [Name]
forall a. a -> Proxy x' x () (ProgramFile A, SourceText) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Name] -> Proxy x' x () (ProgramFile A, SourceText) m [Name])
-> [Name] -> Proxy x' x () (ProgramFile A, SourceText) m [Name]
forall a b. (a -> b) -> a -> b
$ [Name]
files [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
excludes'
    else [Name] -> Proxy x' x () (ProgramFile A, SourceText) m [Name]
forall a. a -> Proxy x' x () (ProgramFile A, SourceText) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Name
inp]
  Proxy x' x () Name m ()
-> (Name -> 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 ([Name] -> Proxy x' x () Name m ()
forall (m :: * -> *) (f :: * -> *) a x' x.
(Functor m, Foldable f) =>
f a -> Proxy x' x () a m ()
each [Name]
files) ((Name -> Proxy x' x () (ProgramFile A, SourceText) m ())
 -> Proxy x' x () (ProgramFile A, SourceText) m ())
-> (Name -> Proxy x' x () (ProgramFile A, SourceText) m ())
-> Proxy x' x () (ProgramFile A, SourceText) m ()
forall a b. (a -> b) -> a -> b
$ \ Name
file -> do
    Maybe (ProgramFile A, SourceText)
mProgSrc <- IO (Maybe (ProgramFile A, SourceText))
-> Proxy
     x'
     x
     ()
     (ProgramFile A, SourceText)
     m
     (Maybe (ProgramFile A, SourceText))
forall a. IO a -> Proxy x' x () (ProgramFile A, SourceText) m a
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 -> Name -> IO (Maybe (ProgramFile A, SourceText))
readParseSrcFile Maybe FortranVersion
mv ModFiles
mods Name
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 a. a -> Proxy x' x () (ProgramFile A, SourceText) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  () -> Proxy x' x () (ProgramFile A, SourceText) m ()
forall a. a -> Proxy x' x () (ProgramFile A, SourceText) m a
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 -> Name -> IO (Maybe (ProgramFile A, SourceText))
readParseSrcFile Maybe FortranVersion
mv ModFiles
mods Name
f = do
  -- get file as ByteString, replacing non UTF-8 with space
  SourceText
inp <- Name -> IO SourceText
flexReadFile Name
f
  case ModFiles -> FortranVersion -> Parser (ProgramFile ())
FP.byVerWithMods ModFiles
mods FortranVersion
v Name
f SourceText
inp of
    Right ProgramFile ()
ast -> Maybe (ProgramFile A, SourceText)
-> IO (Maybe (ProgramFile A, SourceText))
forall a. a -> IO a
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 a b. (a -> b) -> ProgramFile a -> ProgramFile b
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ProgramFile A, SourceText)
-> IO (Maybe (ProgramFile A, SourceText))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ProgramFile A, SourceText)
forall a. Maybe a
Nothing
  where
    v :: FortranVersion
v = case Maybe FortranVersion
mv of Just FortranVersion
v' -> FortranVersion
v'
                   Maybe FortranVersion
Nothing -> Name -> FortranVersion
deduceFortranVersion Name
f

getFortranFiles :: FileOrDir -> IO [String]
getFortranFiles :: Name -> IO [Name]
getFortranFiles Name
dir =
  (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
isFortran ([Name] -> [Name]) -> IO [Name] -> IO [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IO [Name]
listDirectoryRecursively Name
dir
  where
    -- | True if the file has a valid fortran extension.
    isFortran :: Filename -> Bool
    isFortran :: Name -> Bool
isFortran Name
x = (Char -> Char) -> Name -> Name
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Name -> Name
takeExtension Name
x) Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
exts
      where exts :: [Name]
exts = [Name
".f", Name
".f90", Name
".f77", Name
".cmn", Name
".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 :: forall a.
Data a =>
ModFiles
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), Map ProgramUnitName ModEnv)
withCombinedModuleMap ModFiles
mfs ProgramFile (Analysis a)
pf =
  let
    -- Use the module map derived from all of the included Camfort Mod files.
    mmap :: Map ProgramUnitName ModEnv
mmap = ModFiles -> Map ProgramUnitName ModEnv
FM.combinedModuleMap ModFiles
mfs
    pfRenamed :: ProgramFile (Analysis a)
pfRenamed = Map ProgramUnitName ModEnv
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
Map ProgramUnitName ModEnv
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
FAR.analyseRenamesWithModuleMap Map ProgramUnitName ModEnv
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, Map ProgramUnitName ModEnv
mmap Map ProgramUnitName ModEnv
-> Map ProgramUnitName ModEnv -> Map ProgramUnitName ModEnv
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` ProgramFile (Analysis a) -> Map ProgramUnitName ModEnv
forall a.
Data a =>
ProgramFile (Analysis a) -> Map ProgramUnitName ModEnv
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 :: forall a.
Data a =>
ModFiles
-> ProgramFile a
-> (ProgramFile (Analysis a), Map ProgramUnitName ModEnv, TypeEnv)
withCombinedEnvironment ModFiles
mfs ProgramFile a
pf =
  let (ProgramFile (Analysis a)
pfRenamed, Map ProgramUnitName ModEnv
mmap) = ModFiles
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), Map ProgramUnitName ModEnv)
forall a.
Data a =>
ModFiles
-> ProgramFile (Analysis a)
-> (ProgramFile (Analysis a), Map ProgramUnitName ModEnv)
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', Map ProgramUnitName ModEnv
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
-> Name -> Map ProgramUnitName ModEnv -> Maybe (Name, NameType)
lookupUniqueName ProgramUnitName
puName Name
srcName = Getting
  (First (Name, NameType))
  (Map ProgramUnitName ModEnv)
  (Name, NameType)
-> Map ProgramUnitName ModEnv -> Maybe (Name, NameType)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting
   (First (Name, NameType))
   (Map ProgramUnitName ModEnv)
   (Name, NameType)
 -> Map ProgramUnitName ModEnv -> Maybe (Name, NameType))
-> Getting
     (First (Name, NameType))
     (Map ProgramUnitName ModEnv)
     (Name, NameType)
-> Map ProgramUnitName ModEnv
-> Maybe (Name, NameType)
forall a b. (a -> b) -> a -> b
$ Index (Map ProgramUnitName ModEnv)
-> Traversal'
     (Map ProgramUnitName ModEnv) (IxValue (Map ProgramUnitName ModEnv))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix ProgramUnitName
Index (Map ProgramUnitName ModEnv)
puName ((IxValue (Map ProgramUnitName ModEnv)
  -> Const
       (First (Name, NameType)) (IxValue (Map ProgramUnitName ModEnv)))
 -> Map ProgramUnitName ModEnv
 -> Const (First (Name, NameType)) (Map ProgramUnitName ModEnv))
-> (((Name, NameType)
     -> Const (First (Name, NameType)) (Name, NameType))
    -> IxValue (Map ProgramUnitName ModEnv)
    -> Const
         (First (Name, NameType)) (IxValue (Map ProgramUnitName ModEnv)))
-> Getting
     (First (Name, NameType))
     (Map ProgramUnitName ModEnv)
     (Name, NameType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IxValue (Map ProgramUnitName ModEnv))
-> Traversal'
     (IxValue (Map ProgramUnitName ModEnv))
     (IxValue (IxValue (Map ProgramUnitName ModEnv)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Name
Index (IxValue (Map ProgramUnitName ModEnv))
srcName