{-# LANGUAGE CPP #-}
module CurryDeps
( Source (..), flatDeps, deps, flattenDeps, sourceDeps, moduleDeps ) where
#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif
import Control.Monad (foldM)
import Data.List (isSuffixOf, nub)
import qualified Data.Map as Map (Map, empty, insert, lookup, toList)
import Curry.Base.Ident
import Curry.Base.Monad
import Curry.Base.Pretty
import Curry.Files.Filenames
import Curry.Files.PathUtils
import Curry.Syntax
( Module (..), ModulePragma (..), ImportDecl (..), parseHeader, parsePragmas
, patchModuleId, hasLanguageExtension)
import Base.Messages
import Base.SCC (scc)
import CompilerOpts (Options (..), CppOpts (..), KnownExtension (..))
import CondCompile (condCompile)
data Source
= Source FilePath [ModulePragma] [ModuleIdent]
| Interface FilePath
| Unknown
deriving (Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq, Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Show)
type SourceEnv = Map.Map ModuleIdent Source
flatDeps :: Options -> FilePath -> CYIO [(ModuleIdent, Source)]
flatDeps :: Options -> String -> CYIO [(ModuleIdent, Source)]
flatDeps opts :: Options
opts fn :: String
fn = do
SourceEnv
sEnv <- Options -> SourceEnv -> String -> CYIO SourceEnv
deps Options
opts SourceEnv
forall k a. Map k a
Map.empty String
fn
case SourceEnv -> ([(ModuleIdent, Source)], [Message])
flattenDeps SourceEnv
sEnv of
(env :: [(ModuleIdent, Source)]
env, [] ) -> [(ModuleIdent, Source)] -> CYIO [(ModuleIdent, Source)]
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok [(ModuleIdent, Source)]
env
(_ , errs :: [Message]
errs) -> [Message] -> CYIO [(ModuleIdent, Source)]
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [Message]
errs
deps :: Options -> SourceEnv -> FilePath -> CYIO SourceEnv
deps :: Options -> SourceEnv -> String -> CYIO SourceEnv
deps opts :: Options
opts sEnv :: SourceEnv
sEnv fn :: String
fn
| String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
icurryExt = SourceEnv -> CYIO SourceEnv
forall (m :: * -> *) a. Monad m => a -> m a
return SourceEnv
sEnv
| String
ext String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
sourceExts = Options -> SourceEnv -> String -> CYIO SourceEnv
sourceDeps Options
opts SourceEnv
sEnv String
fn
| Bool
otherwise = Options -> SourceEnv -> String -> CYIO SourceEnv
targetDeps Options
opts SourceEnv
sEnv String
fn
where ext :: String
ext = ShowS
takeExtension String
fn
targetDeps :: Options -> SourceEnv -> FilePath -> CYIO SourceEnv
targetDeps :: Options -> SourceEnv -> String -> CYIO SourceEnv
targetDeps opts :: Options
opts sEnv :: SourceEnv
sEnv fn :: String
fn = do
Maybe String
mFile <- IO (Maybe String)
-> WriterT [Message] (ExceptT [Message] IO) (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String)
-> WriterT [Message] (ExceptT [Message] IO) (Maybe String))
-> IO (Maybe String)
-> WriterT [Message] (ExceptT [Message] IO) (Maybe String)
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> String -> IO (Maybe String)
lookupFile [""] [String]
sourceExts String
fn
case Maybe String
mFile of
Nothing -> SourceEnv -> CYIO SourceEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceEnv -> CYIO SourceEnv) -> SourceEnv -> CYIO SourceEnv
forall a b. (a -> b) -> a -> b
$ ModuleIdent -> Source -> SourceEnv -> SourceEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ([String] -> ModuleIdent
mkMIdent [String
fn]) Source
Unknown SourceEnv
sEnv
Just file :: String
file -> Options -> SourceEnv -> String -> CYIO SourceEnv
sourceDeps Options
opts SourceEnv
sEnv String
file
sourceDeps :: Options -> SourceEnv -> FilePath -> CYIO SourceEnv
sourceDeps :: Options -> SourceEnv -> String -> CYIO SourceEnv
sourceDeps opts :: Options
opts sEnv :: SourceEnv
sEnv fn :: String
fn = Options -> String -> CYIO (Module ())
readHeader Options
opts String
fn CYIO (Module ()) -> (Module () -> CYIO SourceEnv) -> CYIO SourceEnv
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Options -> SourceEnv -> String -> Module () -> CYIO SourceEnv
forall a.
Options -> SourceEnv -> String -> Module a -> CYIO SourceEnv
moduleDeps Options
opts SourceEnv
sEnv String
fn
moduleDeps :: Options -> SourceEnv -> FilePath -> Module a -> CYIO SourceEnv
moduleDeps :: Options -> SourceEnv -> String -> Module a -> CYIO SourceEnv
moduleDeps opts :: Options
opts sEnv :: SourceEnv
sEnv fn :: String
fn mdl :: Module a
mdl@(Module _ _ ps :: [ModulePragma]
ps m :: ModuleIdent
m _ _ _) = case ModuleIdent -> SourceEnv -> Maybe Source
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleIdent
m SourceEnv
sEnv of
Just _ -> SourceEnv -> CYIO SourceEnv
forall (m :: * -> *) a. Monad m => a -> m a
return SourceEnv
sEnv
Nothing -> do
let imps :: [ModuleIdent]
imps = Options -> Module a -> [ModuleIdent]
forall a. Options -> Module a -> [ModuleIdent]
imports Options
opts Module a
mdl
sEnv' :: SourceEnv
sEnv' = ModuleIdent -> Source -> SourceEnv -> SourceEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ModuleIdent
m (String -> [ModulePragma] -> [ModuleIdent] -> Source
Source String
fn [ModulePragma]
ps [ModuleIdent]
imps) SourceEnv
sEnv
(SourceEnv -> ModuleIdent -> CYIO SourceEnv)
-> SourceEnv -> [ModuleIdent] -> CYIO SourceEnv
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Options -> SourceEnv -> ModuleIdent -> CYIO SourceEnv
moduleIdentDeps Options
opts) SourceEnv
sEnv' [ModuleIdent]
imps
imports :: Options -> Module a -> [ModuleIdent]
imports :: Options -> Module a -> [ModuleIdent]
imports opts :: Options
opts mdl :: Module a
mdl@(Module _ _ _ m :: ModuleIdent
m _ is :: [ImportDecl]
is _) = [ModuleIdent] -> [ModuleIdent]
forall a. Eq a => [a] -> [a]
nub ([ModuleIdent] -> [ModuleIdent]) -> [ModuleIdent] -> [ModuleIdent]
forall a b. (a -> b) -> a -> b
$
[ModuleIdent
preludeMIdent | ModuleIdent
m ModuleIdent -> ModuleIdent -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleIdent
preludeMIdent Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
noImplicitPrelude]
[ModuleIdent] -> [ModuleIdent] -> [ModuleIdent]
forall a. [a] -> [a] -> [a]
++ [ModuleIdent
m' | ImportDecl _ m' :: ModuleIdent
m' _ _ _ <- [ImportDecl]
is]
where noImplicitPrelude :: Bool
noImplicitPrelude = KnownExtension
NoImplicitPrelude KnownExtension -> [KnownExtension] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Options -> [KnownExtension]
optExtensions Options
opts
Bool -> Bool -> Bool
|| Module a
mdl Module a -> KnownExtension -> Bool
forall a. Module a -> KnownExtension -> Bool
`hasLanguageExtension` KnownExtension
NoImplicitPrelude
moduleIdentDeps :: Options -> SourceEnv -> ModuleIdent -> CYIO SourceEnv
moduleIdentDeps :: Options -> SourceEnv -> ModuleIdent -> CYIO SourceEnv
moduleIdentDeps opts :: Options
opts sEnv :: SourceEnv
sEnv m :: ModuleIdent
m = case ModuleIdent -> SourceEnv -> Maybe Source
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleIdent
m SourceEnv
sEnv of
Just _ -> SourceEnv -> CYIO SourceEnv
forall (m :: * -> *) a. Monad m => a -> m a
return SourceEnv
sEnv
Nothing -> do
Maybe String
mFile <- IO (Maybe String)
-> WriterT [Message] (ExceptT [Message] IO) (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String)
-> WriterT [Message] (ExceptT [Message] IO) (Maybe String))
-> IO (Maybe String)
-> WriterT [Message] (ExceptT [Message] IO) (Maybe String)
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> ModuleIdent -> IO (Maybe String)
lookupCurryModule ("." String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Options -> [String]
optImportPaths Options
opts)
(Options -> [String]
optLibraryPaths Options
opts) ModuleIdent
m
case Maybe String
mFile of
Nothing -> SourceEnv -> CYIO SourceEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceEnv -> CYIO SourceEnv) -> SourceEnv -> CYIO SourceEnv
forall a b. (a -> b) -> a -> b
$ ModuleIdent -> Source -> SourceEnv -> SourceEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ModuleIdent
m Source
Unknown SourceEnv
sEnv
Just fn :: String
fn
| String
icurryExt String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
fn ->
SourceEnv -> CYIO SourceEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceEnv -> CYIO SourceEnv) -> SourceEnv -> CYIO SourceEnv
forall a b. (a -> b) -> a -> b
$ ModuleIdent -> Source -> SourceEnv -> SourceEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ModuleIdent
m (String -> Source
Interface String
fn) SourceEnv
sEnv
| Bool
otherwise -> do
hdr :: Module ()
hdr@(Module _ _ _ m' :: ModuleIdent
m' _ _ _) <- Options -> String -> CYIO (Module ())
readHeader Options
opts String
fn
if ModuleIdent
m ModuleIdent -> ModuleIdent -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleIdent
m' then Options -> SourceEnv -> String -> Module () -> CYIO SourceEnv
forall a.
Options -> SourceEnv -> String -> Module a -> CYIO SourceEnv
moduleDeps Options
opts SourceEnv
sEnv String
fn Module ()
hdr
else [Message] -> CYIO SourceEnv
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [ModuleIdent -> ModuleIdent -> Message
errWrongModule ModuleIdent
m ModuleIdent
m']
readHeader :: Options -> FilePath -> CYIO (Module ())
opts :: Options
opts fn :: String
fn = do
Maybe String
mbFile <- IO (Maybe String)
-> WriterT [Message] (ExceptT [Message] IO) (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String)
-> WriterT [Message] (ExceptT [Message] IO) (Maybe String))
-> IO (Maybe String)
-> WriterT [Message] (ExceptT [Message] IO) (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
readModule String
fn
case Maybe String
mbFile of
Nothing -> [Message] -> CYIO (Module ())
forall (m :: * -> *) a. Monad m => [Message] -> CYT m a
failMessages [String -> Message
errMissingFile String
fn]
Just src :: String
src -> do
Module ()
prgs <- CYM (Module ()) -> CYIO (Module ())
forall (m :: * -> *) a. Monad m => CYM a -> CYT m a
liftCYM (CYM (Module ()) -> CYIO (Module ()))
-> CYM (Module ()) -> CYIO (Module ())
forall a b. (a -> b) -> a -> b
$ String -> String -> CYM (Module ())
parsePragmas String
fn String
src
let cppOpts :: CppOpts
cppOpts = Options -> CppOpts
optCppOpts Options
opts
cppOpts' :: CppOpts
cppOpts' =
CppOpts
cppOpts { cppRun :: Bool
cppRun = CppOpts -> Bool
cppRun CppOpts
cppOpts Bool -> Bool -> Bool
|| Module () -> KnownExtension -> Bool
forall a. Module a -> KnownExtension -> Bool
hasLanguageExtension Module ()
prgs KnownExtension
CPP }
String
condC <- CppOpts -> String -> String -> CYIO String
condCompile CppOpts
cppOpts' String
fn String
src
Module ()
hdr <- CYM (Module ()) -> CYIO (Module ())
forall (m :: * -> *) a. Monad m => CYM a -> CYT m a
liftCYM (CYM (Module ()) -> CYIO (Module ()))
-> CYM (Module ()) -> CYIO (Module ())
forall a b. (a -> b) -> a -> b
$ String -> String -> CYM (Module ())
parseHeader String
fn String
condC
Module () -> CYIO (Module ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Module () -> CYIO (Module ())) -> Module () -> CYIO (Module ())
forall a b. (a -> b) -> a -> b
$ String -> Module () -> Module ()
forall a. String -> Module a -> Module a
patchModuleId String
fn Module ()
hdr
flattenDeps :: SourceEnv -> ([(ModuleIdent, Source)], [Message])
flattenDeps :: SourceEnv -> ([(ModuleIdent, Source)], [Message])
flattenDeps = [[(ModuleIdent, Source)]] -> ([(ModuleIdent, Source)], [Message])
fdeps ([[(ModuleIdent, Source)]] -> ([(ModuleIdent, Source)], [Message]))
-> (SourceEnv -> [[(ModuleIdent, Source)]])
-> SourceEnv
-> ([(ModuleIdent, Source)], [Message])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceEnv -> [[(ModuleIdent, Source)]]
sortDeps
where
sortDeps :: SourceEnv -> [[(ModuleIdent, Source)]]
sortDeps :: SourceEnv -> [[(ModuleIdent, Source)]]
sortDeps = ((ModuleIdent, Source) -> [ModuleIdent])
-> ((ModuleIdent, Source) -> [ModuleIdent])
-> [(ModuleIdent, Source)]
-> [[(ModuleIdent, Source)]]
forall b a. Eq b => (a -> [b]) -> (a -> [b]) -> [a] -> [[a]]
scc (ModuleIdent, Source) -> [ModuleIdent]
forall a b. (a, b) -> [a]
idents (ModuleIdent, Source) -> [ModuleIdent]
forall a. (a, Source) -> [ModuleIdent]
imported ([(ModuleIdent, Source)] -> [[(ModuleIdent, Source)]])
-> (SourceEnv -> [(ModuleIdent, Source)])
-> SourceEnv
-> [[(ModuleIdent, Source)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceEnv -> [(ModuleIdent, Source)]
forall k a. Map k a -> [(k, a)]
Map.toList
idents :: (a, b) -> [a]
idents (m :: a
m, _) = [a
m]
imported :: (a, Source) -> [ModuleIdent]
imported (_, Source _ _ ms :: [ModuleIdent]
ms) = [ModuleIdent]
ms
imported (_, _) = []
fdeps :: [[(ModuleIdent, Source)]] -> ([(ModuleIdent, Source)], [Message])
fdeps :: [[(ModuleIdent, Source)]] -> ([(ModuleIdent, Source)], [Message])
fdeps = ([(ModuleIdent, Source)]
-> ([(ModuleIdent, Source)], [Message])
-> ([(ModuleIdent, Source)], [Message]))
-> ([(ModuleIdent, Source)], [Message])
-> [[(ModuleIdent, Source)]]
-> ([(ModuleIdent, Source)], [Message])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [(ModuleIdent, Source)]
-> ([(ModuleIdent, Source)], [Message])
-> ([(ModuleIdent, Source)], [Message])
forall b.
[(ModuleIdent, b)]
-> ([(ModuleIdent, b)], [Message])
-> ([(ModuleIdent, b)], [Message])
checkdep ([], [])
checkdep :: [(ModuleIdent, b)]
-> ([(ModuleIdent, b)], [Message])
-> ([(ModuleIdent, b)], [Message])
checkdep [] (srcs :: [(ModuleIdent, b)]
srcs, errs :: [Message]
errs) = ([(ModuleIdent, b)]
srcs , [Message]
errs )
checkdep [src :: (ModuleIdent, b)
src] (srcs :: [(ModuleIdent, b)]
srcs, errs :: [Message]
errs) = ((ModuleIdent, b)
src (ModuleIdent, b) -> [(ModuleIdent, b)] -> [(ModuleIdent, b)]
forall a. a -> [a] -> [a]
: [(ModuleIdent, b)]
srcs, [Message]
errs )
checkdep dep :: [(ModuleIdent, b)]
dep (srcs :: [(ModuleIdent, b)]
srcs, errs :: [Message]
errs) = ([(ModuleIdent, b)]
srcs , Message
err Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: [Message]
errs)
where err :: Message
err = [ModuleIdent] -> Message
errCyclicImport ([ModuleIdent] -> Message) -> [ModuleIdent] -> Message
forall a b. (a -> b) -> a -> b
$ ((ModuleIdent, b) -> ModuleIdent)
-> [(ModuleIdent, b)] -> [ModuleIdent]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleIdent, b) -> ModuleIdent
forall a b. (a, b) -> a
fst [(ModuleIdent, b)]
dep
errMissingFile :: FilePath -> Message
errMissingFile :: String -> Message
errMissingFile fn :: String
fn = Doc -> Message
message (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [ "Missing file:", String
fn ]
errWrongModule :: ModuleIdent -> ModuleIdent -> Message
errWrongModule :: ModuleIdent -> ModuleIdent -> Message
errWrongModule m :: ModuleIdent
m m' :: ModuleIdent
m' = Doc -> Message
message (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
[ String -> Doc
text "Expected module for", String -> Doc
text (ModuleIdent -> String
moduleName ModuleIdent
m) Doc -> Doc -> Doc
<> Doc
comma
, String -> Doc
text "but found", String -> Doc
text (ModuleIdent -> String
moduleName ModuleIdent
m') ]
errCyclicImport :: [ModuleIdent] -> Message
errCyclicImport :: [ModuleIdent] -> Message
errCyclicImport [] = String -> Message
forall a. String -> a
internalError "CurryDeps.errCyclicImport: empty list"
errCyclicImport [m :: ModuleIdent
m] = Doc -> Message
message (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
[ "Recursive import for module", ModuleIdent -> String
moduleName ModuleIdent
m ]
errCyclicImport ms :: [ModuleIdent]
ms = Doc -> Message
message (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "Cyclic import dependency between modules" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
punctuate Doc
comma [Doc]
inits
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [String -> Doc
text "and", Doc
lastm]
where
(inits :: [Doc]
inits, lastm :: Doc
lastm) = [Doc] -> ([Doc], Doc)
forall a. [a] -> ([a], a)
splitLast ([Doc] -> ([Doc], Doc)) -> [Doc] -> ([Doc], Doc)
forall a b. (a -> b) -> a -> b
$ (ModuleIdent -> Doc) -> [ModuleIdent] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (ModuleIdent -> String) -> ModuleIdent -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> String
moduleName) [ModuleIdent]
ms
splitLast :: [a] -> ([a], a)
splitLast [] = String -> ([a], a)
forall a. String -> a
internalError "CurryDeps.splitLast: empty list"
splitLast (x :: a
x : []) = ([] , a
x)
splitLast (x :: a
x : xs :: [a]
xs) = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys, a
y) where (ys :: [a]
ys, y :: a
y) = [a] -> ([a], a)
splitLast [a]
xs