{-# LANGUAGE TupleSections #-}
module Language.Fortran.Extras where
import Control.Exception ( try
, SomeException
)
import Data.Data ( Data )
import Data.List ( find
)
import Data.Maybe ( fromMaybe
, mapMaybe
)
import Data.Generics.Uniplate.Data ( universeBi )
import Language.Fortran.AST ( A0
, Block
, ProgramFile
, Statement
, ProgramUnit(..)
, ProgramUnitName(..)
)
import Language.Fortran.Analysis ( Analysis
, puSrcName
)
import Language.Fortran.Version ( FortranVersion(..) )
import System.FilePath ( takeExtension )
import System.Exit ( ExitCode(..)
, exitWith
)
import System.IO ( hPutStr
, hPutStrLn
, stderr
)
import Options.Applicative
import qualified Language.Fortran.Parser as Parser
import qualified Language.Fortran.Extras.ProgramFile
as P
import qualified Language.Fortran.Extras.Analysis
as A
import Language.Fortran.Util.ModFile ( decodeModFiles' )
import Language.Fortran.Extras.RunOptions
( unwrapFortranSrcOptions
, getFortranSrcRunOptions
, getRunOptions
, FortranSrcRunOptions(..)
, RunOptions(..)
)
allB :: Data a => ProgramFile a -> [Block a]
allB :: forall a. Data a => ProgramFile a -> [Block a]
allB = forall from to. Biplate from to => from -> [to]
universeBi
allS :: Data a => ProgramFile a -> [Statement a]
allS :: forall a. Data a => ProgramFile a -> [Statement a]
allS = forall from to. Biplate from to => from -> [to]
universeBi
allPU :: Data a => ProgramFile a -> [ProgramUnit a]
allPU :: forall a. Data a => ProgramFile a -> [ProgramUnit a]
allPU = forall from to. Biplate from to => from -> [to]
universeBi
allPUB :: Data a => ProgramUnit a -> [Block a]
allPUB :: forall a. Data a => ProgramUnit a -> [Block a]
allPUB = forall from to. Biplate from to => from -> [to]
universeBi
allPUS :: Data a => ProgramUnit a -> [Statement a]
allPUS :: forall a. Data a => ProgramUnit a -> [Statement a]
allPUS = forall from to. Biplate from to => from -> [to]
universeBi
findPU'
:: Data a
=> ProgramUnitName
-> ProgramFile (Analysis a)
-> Maybe (ProgramUnit (Analysis a))
findPU' :: forall a.
Data a =>
ProgramUnitName
-> ProgramFile (Analysis a) -> Maybe (ProgramUnit (Analysis a))
findPU' ProgramUnitName
n = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ProgramUnit (Analysis a)
pu -> forall a. ProgramUnit (Analysis a) -> ProgramUnitName
puSrcName ProgramUnit (Analysis a)
pu forall a. Eq a => a -> a -> Bool
== ProgramUnitName
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => ProgramFile a -> [ProgramUnit a]
allPU
findPU
:: Data a
=> String
-> ProgramFile (Analysis a)
-> Maybe (ProgramUnit (Analysis a))
findPU :: forall a.
Data a =>
String
-> ProgramFile (Analysis a) -> Maybe (ProgramUnit (Analysis a))
findPU String
n = forall a.
Data a =>
ProgramUnitName
-> ProgramFile (Analysis a) -> Maybe (ProgramUnit (Analysis a))
findPU' forall a b. (a -> b) -> a -> b
$ String -> ProgramUnitName
Named String
n
programFile :: FortranSrcRunOptions -> IO (ProgramFile A0)
programFile :: FortranSrcRunOptions -> IO (ProgramFile A0)
programFile FortranSrcRunOptions
options = do
(String
pfPath, ByteString
pfContents, [String]
pfIncludes, FortranVersion
fVersion) <- FortranSrcRunOptions
-> IO (String, ByteString, [String], FortranVersion)
unwrapFortranSrcOptions FortranSrcRunOptions
options
case FortranVersion
fVersion of
FortranVersion
Fortran77Legacy ->
FortranVersion
-> [String] -> String -> ByteString -> IO (ProgramFile A0)
P.versionedExpandedProgramFile FortranVersion
fVersion [String]
pfIncludes String
pfPath ByteString
pfContents
FortranVersion
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FortranVersion -> String -> ByteString -> ProgramFile A0
P.versionedProgramFile FortranVersion
fVersion String
pfPath ByteString
pfContents
incFile :: FortranSrcRunOptions -> IO [Block A0]
incFile :: FortranSrcRunOptions -> IO [Block A0]
incFile FortranSrcRunOptions
options = do
(String
pfPath, ByteString
pfContents, [String]
_pfIncludes, FortranVersion
_fVersion) <- FortranSrcRunOptions
-> IO (String, ByteString, [String], FortranVersion)
unwrapFortranSrcOptions FortranSrcRunOptions
options
forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
Either e a -> m a
Parser.throwIOLeft forall a b. (a -> b) -> a -> b
$ Parser [Block A0]
Parser.f77lIncludesNoTransform String
pfPath ByteString
pfContents
programAnalysis :: FortranSrcRunOptions -> IO (ProgramFile (Analysis A0))
programAnalysis :: FortranSrcRunOptions -> IO (ProgramFile (Analysis A0))
programAnalysis FortranSrcRunOptions
options = do
(String
pfPath, ByteString
pfContents, [String]
pfIncludes, FortranVersion
fVersion) <- FortranSrcRunOptions
-> IO (String, ByteString, [String], FortranVersion)
unwrapFortranSrcOptions FortranSrcRunOptions
options
case FortranVersion
fVersion of
FortranVersion
Fortran77Legacy ->
FortranVersion
-> [String]
-> String
-> ByteString
-> IO (ProgramFile (Analysis A0))
A.versionedExpandedProgramAnalysis FortranVersion
fVersion [String]
pfIncludes String
pfPath ByteString
pfContents
FortranVersion
_ -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
pfIncludes
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FortranVersion -> String -> ByteString -> ProgramFile (Analysis A0)
A.versionedProgramAnalysis FortranVersion
fVersion String
pfPath ByteString
pfContents
else do
ModFiles
pfMods <- [String] -> IO ModFiles
decodeModFiles' [String]
pfIncludes
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FortranVersion
-> ModFiles -> String -> ByteString -> ProgramFile (Analysis A0)
A.versionedProgramAnalysisWithMods FortranVersion
fVersion
ModFiles
pfMods
String
pfPath
ByteString
pfContents
getProgramFile :: String -> String -> IO (ProgramFile A0)
getProgramFile :: String -> String -> IO (ProgramFile A0)
getProgramFile String
programDescription String
programHeader = do
FortranSrcRunOptions
options <- String -> String -> IO FortranSrcRunOptions
getFortranSrcRunOptions String
programDescription String
programHeader
FortranSrcRunOptions -> IO (ProgramFile A0)
programFile FortranSrcRunOptions
options
getProgramAnalysis :: String -> String -> IO (ProgramFile (Analysis A0))
getProgramAnalysis :: String -> String -> IO (ProgramFile (Analysis A0))
getProgramAnalysis String
programDescription String
programHeader = do
FortranSrcRunOptions
options <- String -> String -> IO FortranSrcRunOptions
getFortranSrcRunOptions String
programDescription String
programHeader
FortranSrcRunOptions -> IO (ProgramFile (Analysis A0))
programAnalysis FortranSrcRunOptions
options
errorHandler :: String -> Either SomeException () -> IO ()
errorHandler :: String -> Either SomeException A0 -> IO A0
errorHandler String
filename (Left SomeException
e) = do
Handle -> String -> IO A0
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Caught exception in file: " forall a. [a] -> [a] -> [a]
++ String
filename
Handle -> String -> IO A0
hPutStr Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String
" " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show SomeException
e
forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2
errorHandler String
_ (Right A0
_) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
withProgramFile :: String -> String -> (ProgramFile A0 -> IO ()) -> IO ()
withProgramFile :: String -> String -> (ProgramFile A0 -> IO A0) -> IO A0
withProgramFile String
programDescription String
programHeader ProgramFile A0 -> IO A0
handler = do
FortranSrcRunOptions
options <- String -> String -> IO FortranSrcRunOptions
getFortranSrcRunOptions String
programDescription String
programHeader
Either SomeException A0
results <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ FortranSrcRunOptions -> IO (ProgramFile A0)
programFile FortranSrcRunOptions
options forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProgramFile A0 -> IO A0
handler
String -> Either SomeException A0 -> IO A0
errorHandler (FortranSrcRunOptions -> String
path FortranSrcRunOptions
options) Either SomeException A0
results
withProgramAnalysis
:: String -> String -> (ProgramFile (Analysis A0) -> IO ()) -> IO ()
withProgramAnalysis :: String -> String -> (ProgramFile (Analysis A0) -> IO A0) -> IO A0
withProgramAnalysis String
programDescription String
programHeader ProgramFile (Analysis A0) -> IO A0
handler = do
FortranSrcRunOptions
options <- String -> String -> IO FortranSrcRunOptions
getFortranSrcRunOptions String
programDescription String
programHeader
Either SomeException A0
results <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ FortranSrcRunOptions -> IO (ProgramFile (Analysis A0))
programAnalysis FortranSrcRunOptions
options forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProgramFile (Analysis A0) -> IO A0
handler
String -> Either SomeException A0 -> IO A0
errorHandler (FortranSrcRunOptions -> String
path FortranSrcRunOptions
options) Either SomeException A0
results
withToolOptionsAndProgramAnalysis
:: String
-> String
-> Parser a
-> (a -> ProgramFile (Analysis A0) -> IO ())
-> IO ()
withToolOptionsAndProgramAnalysis :: forall a.
String
-> String
-> Parser a
-> (a -> ProgramFile (Analysis A0) -> IO A0)
-> IO A0
withToolOptionsAndProgramAnalysis String
programDescription String
programHeader Parser a
toolOptsParser a -> ProgramFile (Analysis A0) -> IO A0
handler
= do
RunOptions a
options <- forall a. String -> String -> Parser a -> IO (RunOptions a)
getRunOptions String
programDescription String
programHeader Parser a
toolOptsParser
let (FortranSrcRunOptions
fortranSrcOptions, a
toolOptions) =
(forall a. RunOptions a -> FortranSrcRunOptions
fortranSrcOpts RunOptions a
options, forall a. RunOptions a -> a
toolOpts RunOptions a
options)
Either SomeException A0
results <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ FortranSrcRunOptions -> IO (ProgramFile (Analysis A0))
programAnalysis FortranSrcRunOptions
fortranSrcOptions forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ProgramFile (Analysis A0) -> IO A0
handler a
toolOptions
String -> Either SomeException A0 -> IO A0
errorHandler (FortranSrcRunOptions -> String
path FortranSrcRunOptions
fortranSrcOptions) Either SomeException A0
results
withToolOptionsAndProgramOrBlock
:: String
-> String
-> Parser a
-> (a -> Either (FilePath, [Block A0]) (ProgramFile A0) -> IO ())
-> IO ()
withToolOptionsAndProgramOrBlock :: forall a.
String
-> String
-> Parser a
-> (a -> Either (String, [Block A0]) (ProgramFile A0) -> IO A0)
-> IO A0
withToolOptionsAndProgramOrBlock String
programDescription String
programHeader Parser a
optsParser a -> Either (String, [Block A0]) (ProgramFile A0) -> IO A0
handler = do
RunOptions FortranSrcRunOptions
srcOptions a
toolOptions <-
forall a. String -> String -> Parser a -> IO (RunOptions a)
getRunOptions String
programDescription String
programHeader Parser a
optsParser
Either (String, [Block A0]) (ProgramFile A0)
ast <- if String -> String
takeExtension (FortranSrcRunOptions -> String
path FortranSrcRunOptions
srcOptions) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".inc", String
".ins"]
then forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FortranSrcRunOptions -> String
path FortranSrcRunOptions
srcOptions, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FortranSrcRunOptions -> IO [Block A0]
incFile FortranSrcRunOptions
srcOptions
else forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FortranSrcRunOptions -> IO (ProgramFile A0)
programFile FortranSrcRunOptions
srcOptions
a -> Either (String, [Block A0]) (ProgramFile A0) -> IO A0
handler a
toolOptions Either (String, [Block A0]) (ProgramFile A0)
ast
namedProgramUnit :: Data a => ProgramUnit a -> Maybe (String, ProgramUnit a)
namedProgramUnit :: forall a. Data a => ProgramUnit a -> Maybe (String, ProgramUnit a)
namedProgramUnit pu :: ProgramUnit a
pu@(PUMain a
_ SrcSpan
_ Maybe String
mn [Block a]
_ Maybe [ProgramUnit a]
_) = forall a. a -> Maybe a
Just (forall a. a -> Maybe a -> a
fromMaybe String
"MAIN" Maybe String
mn, ProgramUnit a
pu)
namedProgramUnit pu :: ProgramUnit a
pu@(PUSubroutine a
_ SrcSpan
_ PrefixSuffix a
_ String
n Maybe (AList Expression a)
_ [Block a]
_ Maybe [ProgramUnit a]
_) = forall a. a -> Maybe a
Just (String
n, ProgramUnit a
pu)
namedProgramUnit pu :: ProgramUnit a
pu@(PUFunction a
_ SrcSpan
_ Maybe (TypeSpec a)
_ PrefixSuffix a
_ String
n Maybe (AList Expression a)
_ Maybe (Expression a)
_ [Block a]
_ Maybe [ProgramUnit a]
_) = forall a. a -> Maybe a
Just (String
n, ProgramUnit a
pu)
namedProgramUnit ProgramUnit a
_ = forall a. Maybe a
Nothing
namedProgramUnits :: Data a => ProgramFile a -> [(String, ProgramUnit a)]
namedProgramUnits :: forall a. Data a => ProgramFile a -> [(String, ProgramUnit a)]
namedProgramUnits = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. Data a => ProgramUnit a -> Maybe (String, ProgramUnit a)
namedProgramUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => ProgramFile a -> [ProgramUnit a]
allPU