0 | 0 |
module Language.Del.Imports where
|
1 | 1 |
|
|
2 |
import Control.Monad
|
|
3 |
import Data.List.Split
|
2 | 4 |
import qualified Data.Map.Strict as Map
|
3 | 5 |
import qualified Data.Text as T
|
4 | 6 |
import Language.Del.AST
|
5 | 7 |
import Language.Del.CompileDefs
|
6 | 8 |
import Language.Del.Load
|
7 | 9 |
import qualified Language.Del.Reader as R
|
|
10 |
import System.Directory
|
|
11 |
import System.Environment
|
|
12 |
import System.FilePath
|
|
13 |
|
|
14 |
data ImportEnv = ImportEnv [FilePath] deriving (Show, Eq)
|
|
15 |
|
|
16 |
defaultImportEnv :: IO ImportEnv
|
|
17 |
defaultImportEnv = do
|
|
18 |
cwd <- getCurrentDirectory
|
|
19 |
incvarm <- lookupEnv "DEL_INCLUDE"
|
|
20 |
let dirs = [cwd] ++ (case incvarm of
|
|
21 |
Nothing -> []
|
|
22 |
Just incvar -> splitOn ":" incvar)
|
|
23 |
return $ ImportEnv dirs
|
8 | 24 |
|
9 | 25 |
mergeBinds :: T.Text -> Map.Map T.Text Def -> Map.Map T.Text Def -> Artifact (Map.Map T.Text Def)
|
10 | 26 |
mergeBinds alias orig new =
|
|
16 | 32 |
then Failure $ ImportNameClash alias (Map.keys overlap)
|
17 | 33 |
else return $ Map.union orig aliased
|
18 | 34 |
|
19 | |
findSourceFile :: T.Text -> IO FilePath
|
20 | |
findSourceFile = undefined
|
|
35 |
fileInDir :: String -> FilePath -> IO (Maybe FilePath)
|
|
36 |
fileInDir base dir
|
|
37 |
= let path = dir </> base
|
|
38 |
in do
|
|
39 |
exists <- doesFileExist path
|
|
40 |
return $ if exists then Just path
|
|
41 |
else Nothing
|
21 | 42 |
|
22 | |
loadImport :: Source -> IO (Artifact AST)
|
23 | |
loadImport (Right _) = error "URL imports not yet supported"
|
24 | |
loadImport (Left name) = do
|
25 | |
path <- findSourceFile name
|
26 | |
contents <- readFile path >>= return . T.pack
|
27 | |
let forms = R.read contents
|
28 | |
case forms of
|
29 | |
Success f -> return $ Success (buildAST f)
|
30 | |
Failure e -> return $ Failure e
|
|
43 |
findSourceFile :: ImportEnv -> T.Text -> IO (Maybe FilePath)
|
|
44 |
findSourceFile (ImportEnv dirs) base = mapM (fileInDir $ T.unpack base) dirs >>= return . msum
|
31 | 45 |
|
32 | |
collectImports :: [Source] -> AST -> IO (Artifact AST)
|
33 | |
collectImports loaded (AST m ((Import src alias):xs)) =
|
|
46 |
loadImport :: ImportEnv -> Source -> IO (Artifact AST)
|
|
47 |
loadImport _ (Right _) = error "URL imports not yet supported"
|
|
48 |
loadImport env s@(Left name) =
|
|
49 |
findSourceFile env name >>= \path -> case path of
|
|
50 |
Nothing -> return $ Failure (BadImport s)
|
|
51 |
Just p -> do
|
|
52 |
contents <- readFile p >>= return . T.pack
|
|
53 |
let forms = R.read contents
|
|
54 |
case forms of
|
|
55 |
Success f -> return $ Success (buildAST f)
|
|
56 |
Failure e -> return $ Failure e
|
|
57 |
|
|
58 |
collectImports :: ImportEnv -> [Source] -> AST -> IO (Artifact AST)
|
|
59 |
collectImports env loaded (AST m ((Import src alias):xs)) =
|
34 | 60 |
if elem src loaded
|
35 | |
then collectImports loaded (AST m xs)
|
|
61 |
then collectImports env loaded (AST m xs)
|
36 | 62 |
else do
|
37 | |
iast <- loadImport src
|
|
63 |
iast <- loadImport env src
|
38 | 64 |
case iast of
|
39 | 65 |
Success (AST b imps) -> (return $ mergeBinds alias m b) >>=
|
40 | 66 |
(\merged -> case merged of
|
41 | |
Success mm -> collectImports (src:loaded) (AST mm (xs ++ imps))
|
|
67 |
Success mm -> collectImports env (src:loaded) (AST mm (xs ++ imps))
|
42 | 68 |
Failure e -> return $ Failure e)
|
43 | 69 |
Failure e -> return $ Failure e
|
44 | 70 |
|
45 | 71 |
-- No imports in the AST, or the previous pattern would have matched; done!
|
46 | |
collectImports _ a = return $ Success a
|
|
72 |
collectImports _ _ a = return $ Success a
|