{-# LANGUAGE ScopedTypeVariables #-}

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

import Language.Fortran.AST hiding (setName)
import qualified Language.Fortran.Parser as Parser
import Language.Fortran.Version
import Language.Fortran.Util.ModFile
import Language.Fortran.Util.Files

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 Data.Either.Combinators ( fromRight' )
import qualified Data.Map as M

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

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
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 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> ModOrigin -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ModOrigin -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ModOrigin -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ModOrigin -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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
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 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> ModGraph -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ModGraph -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ModGraph -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ModGraph -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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
        [(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 version :: FortranVersion
version = FortranVersion -> Maybe FortranVersion -> FortranVersion
forall a. a -> Maybe a -> a
fromMaybe (String -> FortranVersion
deduceFortranVersion String
path) Maybe FortranVersion
mversion
            mods :: [ModFile]
mods = ((String, ModFile) -> ModFile) -> [(String, ModFile)] -> [ModFile]
forall a b. (a -> b) -> [a] -> [b]
map (String, ModFile) -> ModFile
forall a b. (a, b) -> b
snd [(String, ModFile)]
fileMods
            parserF0 :: Parser (ProgramFile ())
parserF0 = [ModFile] -> FortranVersion -> Parser (ProgramFile ())
Parser.byVerWithMods [ModFile]
mods FortranVersion
version
            parserF :: String -> ByteString -> ProgramFile ()
parserF String
fn ByteString
bs = Either ParseErrorSimple (ProgramFile ()) -> ProgramFile ()
forall a b. Either a b -> b
fromRight' (Either ParseErrorSimple (ProgramFile ()) -> ProgramFile ())
-> Either ParseErrorSimple (ProgramFile ()) -> ProgramFile ()
forall a b. (a -> b) -> a -> b
$ Parser (ProgramFile ())
parserF0 String
fn ByteString
bs
        [(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 ([ModFile] -> 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 = String -> ByteString -> ProgramFile ()
parserF String
path ByteString
contents
        (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 }