{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, PatternGuards, TupleSections #-}

-- | Generate a module use-graph.
module Language.Fortran.Analysis.ModGraph
  (genModGraph, ModGraph(..), ModOrigin(..), modGraphToDOT, takeNextMods, delModNodes)
where

import Prelude hiding (mod)
import Control.Monad
import Control.Monad.State.Strict
import Data.Data
import Data.Generics.Uniplate.Data
import Data.Graph.Inductive hiding (version)
import Data.Maybe
import Language.Fortran.AST hiding (setName)
import Language.Fortran.Version (FortranVersion(..), deduceFortranVersion)
import Language.Fortran.Parser.Any (parserWithModFilesVersions)
import Language.Fortran.ParserMonad (fromRight)
import Language.Fortran.Util.ModFile
import Language.Fortran.Util.Files
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.Map as M
import System.IO
import System.FilePath

--------------------------------------------------

data ModOrigin = MOFile FilePath | MOFSMod FilePath
  deriving (ModOrigin -> ModOrigin -> Bool
(ModOrigin -> ModOrigin -> Bool)
-> (ModOrigin -> ModOrigin -> Bool) -> Eq ModOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModOrigin -> ModOrigin -> Bool
$c/= :: ModOrigin -> ModOrigin -> Bool
== :: ModOrigin -> ModOrigin -> Bool
$c== :: ModOrigin -> ModOrigin -> Bool
Eq, Typeable ModOrigin
DataType
Constr
Typeable ModOrigin
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ModOrigin -> c ModOrigin)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ModOrigin)
-> (ModOrigin -> Constr)
-> (ModOrigin -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ModOrigin))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModOrigin))
-> ((forall b. Data b => b -> b) -> ModOrigin -> ModOrigin)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ModOrigin -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ModOrigin -> r)
-> (forall u. (forall d. Data d => d -> u) -> ModOrigin -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ModOrigin -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin)
-> Data ModOrigin
ModOrigin -> DataType
ModOrigin -> Constr
(forall b. Data b => b -> b) -> ModOrigin -> ModOrigin
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModOrigin -> c ModOrigin
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModOrigin
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ModOrigin -> u
forall u. (forall d. Data d => d -> u) -> ModOrigin -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModOrigin -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModOrigin -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModOrigin
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModOrigin -> c ModOrigin
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModOrigin)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModOrigin)
$cMOFSMod :: Constr
$cMOFile :: Constr
$tModOrigin :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin
gmapMp :: (forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin
gmapM :: (forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModOrigin -> m ModOrigin
gmapQi :: Int -> (forall d. Data d => d -> u) -> ModOrigin -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ModOrigin -> u
gmapQ :: (forall d. Data d => d -> u) -> ModOrigin -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ModOrigin -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModOrigin -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModOrigin -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModOrigin -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModOrigin -> r
gmapT :: (forall b. Data b => b -> b) -> ModOrigin -> ModOrigin
$cgmapT :: (forall b. Data b => b -> b) -> ModOrigin -> ModOrigin
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModOrigin)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModOrigin)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ModOrigin)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModOrigin)
dataTypeOf :: ModOrigin -> DataType
$cdataTypeOf :: ModOrigin -> DataType
toConstr :: ModOrigin -> Constr
$ctoConstr :: ModOrigin -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModOrigin
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModOrigin
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModOrigin -> c ModOrigin
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModOrigin -> c ModOrigin
$cp1Data :: Typeable ModOrigin
Data, Int -> ModOrigin -> ShowS
[ModOrigin] -> ShowS
ModOrigin -> String
(Int -> ModOrigin -> ShowS)
-> (ModOrigin -> String)
-> ([ModOrigin] -> ShowS)
-> Show ModOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModOrigin] -> ShowS
$cshowList :: [ModOrigin] -> ShowS
show :: ModOrigin -> String
$cshow :: ModOrigin -> String
showsPrec :: Int -> ModOrigin -> ShowS
$cshowsPrec :: Int -> ModOrigin -> ShowS
Show)

instance Ord ModOrigin where
  MOFSMod String
_ <= :: ModOrigin -> ModOrigin -> Bool
<= MOFSMod String
_ = Bool
True
  ModOrigin
a <= ModOrigin
b = ModOrigin
a ModOrigin -> ModOrigin -> Bool
forall a. Eq a => a -> a -> Bool
== ModOrigin
b

data ModGraph = ModGraph { ModGraph -> Map String (Int, Maybe ModOrigin)
mgModNodeMap :: M.Map String (Node, Maybe ModOrigin)
                         , ModGraph -> Gr String ()
mgGraph      :: Gr String ()
                         , ModGraph -> Int
mgNumNodes   :: Int }
  deriving (ModGraph -> ModGraph -> Bool
(ModGraph -> ModGraph -> Bool)
-> (ModGraph -> ModGraph -> Bool) -> Eq ModGraph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModGraph -> ModGraph -> Bool
$c/= :: ModGraph -> ModGraph -> Bool
== :: ModGraph -> ModGraph -> Bool
$c== :: ModGraph -> ModGraph -> Bool
Eq, Typeable ModGraph
DataType
Constr
Typeable ModGraph
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ModGraph -> c ModGraph)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ModGraph)
-> (ModGraph -> Constr)
-> (ModGraph -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ModGraph))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModGraph))
-> ((forall b. Data b => b -> b) -> ModGraph -> ModGraph)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ModGraph -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ModGraph -> r)
-> (forall u. (forall d. Data d => d -> u) -> ModGraph -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ModGraph -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ModGraph -> m ModGraph)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ModGraph -> m ModGraph)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ModGraph -> m ModGraph)
-> Data ModGraph
ModGraph -> DataType
ModGraph -> Constr
(forall b. Data b => b -> b) -> ModGraph -> ModGraph
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModGraph -> c ModGraph
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModGraph
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ModGraph -> u
forall u. (forall d. Data d => d -> u) -> ModGraph -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModGraph -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModGraph -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModGraph -> m ModGraph
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModGraph -> m ModGraph
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModGraph
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModGraph -> c ModGraph
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModGraph)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModGraph)
$cModGraph :: Constr
$tModGraph :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ModGraph -> m ModGraph
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModGraph -> m ModGraph
gmapMp :: (forall d. Data d => d -> m d) -> ModGraph -> m ModGraph
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModGraph -> m ModGraph
gmapM :: (forall d. Data d => d -> m d) -> ModGraph -> m ModGraph
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModGraph -> m ModGraph
gmapQi :: Int -> (forall d. Data d => d -> u) -> ModGraph -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ModGraph -> u
gmapQ :: (forall d. Data d => d -> u) -> ModGraph -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ModGraph -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModGraph -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModGraph -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModGraph -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModGraph -> r
gmapT :: (forall b. Data b => b -> b) -> ModGraph -> ModGraph
$cgmapT :: (forall b. Data b => b -> b) -> ModGraph -> ModGraph
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModGraph)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModGraph)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ModGraph)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModGraph)
dataTypeOf :: ModGraph -> DataType
$cdataTypeOf :: ModGraph -> DataType
toConstr :: ModGraph -> Constr
$ctoConstr :: ModGraph -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModGraph
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModGraph
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModGraph -> c ModGraph
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModGraph -> c ModGraph
$cp1Data :: Typeable ModGraph
Data)

modGraph0 :: ModGraph
modGraph0 :: ModGraph
modGraph0 = Map String (Int, Maybe ModOrigin)
-> Gr String () -> Int -> ModGraph
ModGraph Map String (Int, Maybe ModOrigin)
forall k a. Map k a
M.empty Gr String ()
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty Int
0

type ModGrapher a = StateT ModGraph IO a

maybeAddModName :: String -> Maybe ModOrigin -> ModGrapher Node
maybeAddModName :: String -> Maybe ModOrigin -> ModGrapher Int
maybeAddModName String
modName Maybe ModOrigin
org = do
  mg :: ModGraph
mg@ModGraph { mgModNodeMap :: ModGraph -> Map String (Int, Maybe ModOrigin)
mgModNodeMap = Map String (Int, Maybe ModOrigin)
mnmap, mgGraph :: ModGraph -> Gr String ()
mgGraph = Gr String ()
gr, mgNumNodes :: ModGraph -> Int
mgNumNodes = Int
numNodes } <- StateT ModGraph IO ModGraph
forall s (m :: * -> *). MonadState s m => m s
get
  case String
-> Map String (Int, Maybe ModOrigin)
-> Maybe (Int, Maybe ModOrigin)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
modName Map String (Int, Maybe ModOrigin)
mnmap of
    Just (Int
i, Maybe ModOrigin
org') | Maybe ModOrigin
org Maybe ModOrigin -> Maybe ModOrigin -> Bool
forall a. Ord a => a -> a -> Bool
<= Maybe ModOrigin
org' -> Int -> ModGrapher Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
                   | Bool
otherwise   -> do
                       let mnmap' :: Map String (Int, Maybe ModOrigin)
mnmap' = String
-> (Int, Maybe ModOrigin)
-> Map String (Int, Maybe ModOrigin)
-> Map String (Int, Maybe ModOrigin)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
modName (Int
i, Maybe ModOrigin
org) Map String (Int, Maybe ModOrigin)
mnmap
                       ModGraph -> StateT ModGraph IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ModGraph -> StateT ModGraph IO ())
-> ModGraph -> StateT ModGraph IO ()
forall a b. (a -> b) -> a -> b
$ ModGraph
mg { mgModNodeMap :: Map String (Int, Maybe ModOrigin)
mgModNodeMap = Map String (Int, Maybe ModOrigin)
mnmap' }
                       Int -> ModGrapher Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
    Maybe (Int, Maybe ModOrigin)
Nothing -> do
      let i :: Int
i = Int
numNodes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      let mnmap' :: Map String (Int, Maybe ModOrigin)
mnmap' = String
-> (Int, Maybe ModOrigin)
-> Map String (Int, Maybe ModOrigin)
-> Map String (Int, Maybe ModOrigin)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
modName (Int
i, Maybe ModOrigin
org) Map String (Int, Maybe ModOrigin)
mnmap
      let gr' :: Gr String ()
gr' = LNode String -> Gr String () -> Gr String ()
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (Int
i, String
modName) Gr String ()
gr
      ModGraph -> StateT ModGraph IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ModGraph -> StateT ModGraph IO ())
-> ModGraph -> StateT ModGraph IO ()
forall a b. (a -> b) -> a -> b
$ ModGraph
mg { mgModNodeMap :: Map String (Int, Maybe ModOrigin)
mgModNodeMap = Map String (Int, Maybe ModOrigin)
mnmap', mgGraph :: Gr String ()
mgGraph = Gr String ()
gr', mgNumNodes :: Int
mgNumNodes = Int
i }
      Int -> ModGrapher Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i

addModDep :: String -> String -> ModGrapher ()
addModDep :: String -> String -> StateT ModGraph IO ()
addModDep String
modName String
depName = do
  Int
i <- String -> Maybe ModOrigin -> ModGrapher Int
maybeAddModName String
modName Maybe ModOrigin
forall a. Maybe a
Nothing
  Int
j <- String -> Maybe ModOrigin -> ModGrapher Int
maybeAddModName String
depName Maybe ModOrigin
forall a. Maybe a
Nothing
  mg :: ModGraph
mg@ModGraph { mgGraph :: ModGraph -> Gr String ()
mgGraph = Gr String ()
gr } <- StateT ModGraph IO ModGraph
forall s (m :: * -> *). MonadState s m => m s
get
  ModGraph -> StateT ModGraph IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ModGraph -> StateT ModGraph IO ())
-> ModGraph -> StateT ModGraph IO ()
forall a b. (a -> b) -> a -> b
$ ModGraph
mg { mgGraph :: Gr String ()
mgGraph = LEdge () -> Gr String () -> Gr String ()
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge (Int
i, Int
j, ()) Gr String ()
gr }

genModGraph :: Maybe FortranVersion -> [FilePath] -> [FilePath] -> IO ModGraph
genModGraph :: Maybe FortranVersion -> [String] -> [String] -> IO ModGraph
genModGraph Maybe FortranVersion
mversion [String]
includeDirs [String]
paths = do
  let perModule :: String -> ProgramUnit a -> StateT ModGraph IO ()
perModule String
path pu :: ProgramUnit a
pu@(PUModule a
_ SrcSpan
_ String
modName [Block a]
_ Maybe [ProgramUnit a]
_) = do
        Int
_ <- String -> Maybe ModOrigin -> ModGrapher Int
maybeAddModName String
modName (ModOrigin -> Maybe ModOrigin
forall a. a -> Maybe a
Just (ModOrigin -> Maybe ModOrigin) -> ModOrigin -> Maybe ModOrigin
forall a b. (a -> b) -> a -> b
$ String -> ModOrigin
MOFile String
path)
        let uses :: [String]
uses = [ String
usedName | StUse ()
_ SrcSpan
_ (ExpValue ()
_ SrcSpan
_ (ValVariable String
usedName)) Maybe ModuleNature
_ Only
_ Maybe (AList Use ())
_ <-
                                ProgramUnit a -> [Statement ()]
forall from to. Biplate from to => from -> [to]
universeBi ProgramUnit a
pu :: [Statement ()] ]
        [String]
-> (String -> StateT ModGraph IO ()) -> StateT ModGraph IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
uses ((String -> StateT ModGraph IO ()) -> StateT ModGraph IO ())
-> (String -> StateT ModGraph IO ()) -> StateT ModGraph IO ()
forall a b. (a -> b) -> a -> b
$ \ String
usedName -> do
          Int
_ <- String -> Maybe ModOrigin -> ModGrapher Int
maybeAddModName String
usedName Maybe ModOrigin
forall a. Maybe a
Nothing
          String -> String -> StateT ModGraph IO ()
addModDep String
modName String
usedName
      perModule String
path ProgramUnit a
pu | Named String
puName <- ProgramUnit a -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
getName ProgramUnit a
pu = do
        Int
_ <- String -> Maybe ModOrigin -> ModGrapher Int
maybeAddModName String
puName (ModOrigin -> Maybe ModOrigin
forall a. a -> Maybe a
Just (ModOrigin -> Maybe ModOrigin) -> ModOrigin -> Maybe ModOrigin
forall a b. (a -> b) -> a -> b
$ String -> ModOrigin
MOFile String
path)
        let uses :: [String]
uses = [ String
usedName | StUse ()
_ SrcSpan
_ (ExpValue ()
_ SrcSpan
_ (ValVariable String
usedName)) Maybe ModuleNature
_ Only
_ Maybe (AList Use ())
_ <-
                                ProgramUnit a -> [Statement ()]
forall from to. Biplate from to => from -> [to]
universeBi ProgramUnit a
pu :: [Statement ()] ]
        [String]
-> (String -> StateT ModGraph IO ()) -> StateT ModGraph IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
uses ((String -> StateT ModGraph IO ()) -> StateT ModGraph IO ())
-> (String -> StateT ModGraph IO ()) -> StateT ModGraph IO ()
forall a b. (a -> b) -> a -> b
$ \ String
usedName -> do
          Int
_ <- String -> Maybe ModOrigin -> ModGrapher Int
maybeAddModName String
usedName Maybe ModOrigin
forall a. Maybe a
Nothing
          String -> String -> StateT ModGraph IO ()
addModDep String
puName String
usedName
      perModule String
_ ProgramUnit a
_ = () -> StateT ModGraph IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  let iter :: FilePath -> ModGrapher ()
      iter :: String -> StateT ModGraph IO ()
iter String
path = do
        ByteString
contents <- IO ByteString -> StateT ModGraph IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> StateT ModGraph IO ByteString)
-> IO ByteString -> StateT ModGraph IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
flexReadFile String
path
        let version :: FortranVersion
version = FortranVersion -> Maybe FortranVersion -> FortranVersion
forall a. a -> Maybe a -> a
fromMaybe (String -> FortranVersion
deduceFortranVersion String
path) Maybe FortranVersion
mversion
        let (Just ParserWithModFiles
parserF0) = FortranVersion
-> [(FortranVersion, ParserWithModFiles)]
-> Maybe ParserWithModFiles
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FortranVersion
version [(FortranVersion, ParserWithModFiles)]
parserWithModFilesVersions
        let parserF :: ModFiles -> ByteString -> String -> ProgramFile ()
parserF ModFiles
m ByteString
b String
s = Either ParseErrorSimple (ProgramFile ()) -> ProgramFile ()
forall a b. Show a => Either a b -> b
fromRight (ParserWithModFiles
parserF0 ModFiles
m ByteString
b String
s)
        [(String, ModFile)]
fileMods <- IO [(String, ModFile)] -> StateT ModGraph IO [(String, ModFile)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, ModFile)] -> StateT ModGraph IO [(String, ModFile)])
-> IO [(String, ModFile)] -> StateT ModGraph IO [(String, ModFile)]
forall a b. (a -> b) -> a -> b
$ [String] -> IO [(String, ModFile)]
decodeModFiles [String]
includeDirs
        let mods :: ModFiles
mods = ((String, ModFile) -> ModFile) -> [(String, ModFile)] -> ModFiles
forall a b. (a -> b) -> [a] -> [b]
map (String, ModFile) -> ModFile
forall a b. (a, b) -> b
snd [(String, ModFile)]
fileMods
        [(String, ModFile)]
-> ((String, ModFile) -> StateT ModGraph IO ())
-> StateT ModGraph IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, ModFile)]
fileMods (((String, ModFile) -> StateT ModGraph IO ())
 -> StateT ModGraph IO ())
-> ((String, ModFile) -> StateT ModGraph IO ())
-> StateT ModGraph IO ()
forall a b. (a -> b) -> a -> b
$ \ (String
fileName, ModFile
mod) -> do
          [String]
-> (String -> StateT ModGraph IO ()) -> StateT ModGraph IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ String
name | Named String
name <- Map ProgramUnitName ModEnv -> [ProgramUnitName]
forall k a. Map k a -> [k]
M.keys (ModFiles -> Map ProgramUnitName ModEnv
combinedModuleMap [ModFile
mod]) ] ((String -> StateT ModGraph IO ()) -> StateT ModGraph IO ())
-> (String -> StateT ModGraph IO ()) -> StateT ModGraph IO ()
forall a b. (a -> b) -> a -> b
$ \ String
name -> do
            Int
_ <- String -> Maybe ModOrigin -> ModGrapher Int
maybeAddModName String
name (Maybe ModOrigin -> ModGrapher Int)
-> (ModOrigin -> Maybe ModOrigin) -> ModOrigin -> ModGrapher Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModOrigin -> Maybe ModOrigin
forall a. a -> Maybe a
Just (ModOrigin -> ModGrapher Int) -> ModOrigin -> ModGrapher Int
forall a b. (a -> b) -> a -> b
$ String -> ModOrigin
MOFSMod String
fileName
            () -> StateT ModGraph IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        let pf :: ProgramFile ()
pf = ModFiles -> ByteString -> String -> ProgramFile ()
parserF ModFiles
mods ByteString
contents String
path
        (ProgramUnit () -> StateT ModGraph IO ())
-> [ProgramUnit ()] -> StateT ModGraph IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> ProgramUnit () -> StateT ModGraph IO ()
forall a.
Data a =>
String -> ProgramUnit a -> StateT ModGraph IO ()
perModule String
path) (ProgramFile () -> [ProgramUnit ()]
forall from to. Biplate from to => from -> [to]
childrenBi ProgramFile ()
pf :: [ProgramUnit ()])
        () -> StateT ModGraph IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  StateT ModGraph IO () -> ModGraph -> IO ModGraph
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ((String -> StateT ModGraph IO ())
-> [String] -> StateT ModGraph IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> StateT ModGraph IO ()
iter [String]
paths) ModGraph
modGraph0

modGraphToDOT :: ModGraph -> String
modGraphToDOT :: ModGraph -> String
modGraphToDOT ModGraph { mgGraph :: ModGraph -> Gr String ()
mgGraph = Gr String ()
gr } = [String] -> String
unlines [String]
dot
  where
    dot :: [String]
dot = [ String
"strict digraph {\n"
          , String
"node [shape=box,fontname=\"Courier New\"]\n" ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
          (LNode String -> [String]) -> [LNode String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ (Int
i, String
name) ->
                        [ String
"n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[label=\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"]\n"
                        , String
"n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> {" ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                        [ String
" n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j | Int
j <- Gr String () -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
suc Gr String ()
gr Int
i ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                        [String
"}\n"])
                    (Gr String () -> [LNode String]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes Gr String ()
gr) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
          [ String
"}\n" ]

takeNextMods :: ModGraph -> [(Node, Maybe ModOrigin)]
takeNextMods :: ModGraph -> [(Int, Maybe ModOrigin)]
takeNextMods ModGraph { mgModNodeMap :: ModGraph -> Map String (Int, Maybe ModOrigin)
mgModNodeMap = Map String (Int, Maybe ModOrigin)
mnmap, mgGraph :: ModGraph -> Gr String ()
mgGraph = Gr String ()
gr } = [(Int, Maybe ModOrigin)]
noDepFiles
  where
    noDeps :: [LNode String]
noDeps = [ (Int
i, String
modName) | (Int
i, String
modName) <- Gr String () -> [LNode String]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes Gr String ()
gr, [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Gr String () -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
suc Gr String ()
gr Int
i) ]
    noDepFiles :: [(Int, Maybe ModOrigin)]
noDepFiles = [ (Int
i, Maybe ModOrigin
mo) | (Int
i, String
modName) <- [LNode String]
noDeps
                           , (Int
_, Maybe ModOrigin
mo) <- Maybe (Int, Maybe ModOrigin) -> [(Int, Maybe ModOrigin)]
forall a. Maybe a -> [a]
maybeToList (String
-> Map String (Int, Maybe ModOrigin)
-> Maybe (Int, Maybe ModOrigin)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
modName Map String (Int, Maybe ModOrigin)
mnmap) ]

delModNodes :: [Node] -> ModGraph -> ModGraph
delModNodes :: [Int] -> ModGraph -> ModGraph
delModNodes [Int]
ns mg :: ModGraph
mg@ModGraph { mgGraph :: ModGraph -> Gr String ()
mgGraph = Gr String ()
gr } = ModGraph
mg'
  where
    mg' :: ModGraph
mg' = ModGraph
mg { mgGraph :: Gr String ()
mgGraph = [Int] -> Gr String () -> Gr String ()
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> gr a b
delNodes [Int]
ns Gr String ()
gr }

--------------------------------------------------

decodeModFiles :: [FilePath] -> IO [(FilePath, ModFile)]
decodeModFiles :: [String] -> IO [(String, ModFile)]
decodeModFiles = ([(String, ModFile)] -> String -> IO [(String, ModFile)])
-> [(String, ModFile)] -> [String] -> IO [(String, ModFile)]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ [(String, ModFile)]
modFiles String
d -> do
      -- Figure out the camfort mod files and parse them.
      [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]
getDirContents String
d
      [(String, ModFile)]
addedModFiles <- ([[(String, ModFile)]] -> [(String, ModFile)])
-> IO [[(String, ModFile)]] -> IO [(String, ModFile)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(String, ModFile)]] -> [(String, ModFile)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[(String, ModFile)]] -> IO [(String, ModFile)])
-> ((String -> IO [(String, ModFile)]) -> IO [[(String, ModFile)]])
-> (String -> IO [(String, ModFile)])
-> IO [(String, ModFile)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String]
-> (String -> IO [(String, ModFile)]) -> IO [[(String, ModFile)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
modFileNames ((String -> IO [(String, ModFile)]) -> IO [(String, ModFile)])
-> (String -> IO [(String, ModFile)]) -> IO [(String, ModFile)]
forall a b. (a -> b) -> a -> b
$ \ String
modFileName -> do
        ByteString
contents <- String -> IO ByteString
LB.readFile (String
d String -> ShowS
</> String
modFileName)
        case ByteString -> Either String ModFiles
decodeModFile ByteString
contents of
          Left String
msg -> do
            Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modFileName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": Error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
            [(String, ModFile)] -> IO [(String, ModFile)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String
modFileName, ModFile
emptyModFile)]
          Right ModFiles
mods -> do
            Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
modFileName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": successfully parsed precompiled file."
            [(String, ModFile)] -> IO [(String, ModFile)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, ModFile)] -> IO [(String, ModFile)])
-> [(String, ModFile)] -> IO [(String, ModFile)]
forall a b. (a -> b) -> a -> b
$ (ModFile -> (String, ModFile)) -> ModFiles -> [(String, ModFile)]
forall a b. (a -> b) -> [a] -> [b]
map (String
modFileName,) ModFiles
mods
      [(String, ModFile)] -> IO [(String, ModFile)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, ModFile)] -> IO [(String, ModFile)])
-> [(String, ModFile)] -> IO [(String, ModFile)]
forall a b. (a -> b) -> a -> b
$ [(String, ModFile)]
addedModFiles [(String, ModFile)] -> [(String, ModFile)] -> [(String, ModFile)]
forall a. [a] -> [a] -> [a]
++ [(String, ModFile)]
modFiles
    ) [] -- can't use emptyModFiles

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