Caller-relative imports; smart deduping in imports

src/FileEval.hs

@@ -8,6 +8,7 @@ import Research
 import Data.List       (partition)
 import Control.Monad   (foldM)
 import System.IO
+import System.FilePath (takeDirectory, normalise, (</>))
 
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -46,38 +47,45 @@ evaluateFileWithContext env filePath = do
       pure $ evalTricu env ast
 
 preprocessFile :: FilePath -> IO [TricuAST]
-preprocessFile = preprocessFile' Set.empty
+preprocessFile p = preprocessFile' Set.empty p p
 
-preprocessFile' :: Set.Set FilePath -> FilePath -> IO [TricuAST]
-preprocessFile' inProgress filePath
-  | filePath `Set.member` inProgress = 
-      errorWithoutStackTrace $ "Encountered cyclic import: " ++ filePath
+preprocessFile' :: Set.Set FilePath -> FilePath -> FilePath -> IO [TricuAST]
+preprocessFile' s b p
+  | p `Set.member` s =
+      errorWithoutStackTrace $ "Encountered cyclic import: " ++ p
   | otherwise = do
-      contents <- readFile filePath
-      let tokens = lexTricu contents
-      case parseProgram tokens of
-        Left err -> errorWithoutStackTrace (handleParseError err)
-        Right asts -> do
-          let (imports, nonImports) = partition isImport asts
-          let newInProgress = Set.insert filePath inProgress
-          importedASTs <- concat <$> 
-            mapM (processImport newInProgress "") imports
-          pure $ importedASTs ++ nonImports
+      c <- readFile p
+      let t = lexTricu c
+      case parseProgram t of
+        Left e -> errorWithoutStackTrace (handleParseError e)
+        Right a -> do
+          let (i, n) = partition isImp a
+          let s' = Set.insert p s
+          r <- concat <$>
+            mapM (procImp s' "" p) i
+          pure $ r ++ n
   where
-    isImport :: TricuAST -> Bool
-    isImport (SImport _ _) = True
-    isImport _             = False
+    isImp :: TricuAST -> Bool
+    isImp (SImport _ _) = True
+    isImp _             = False
 
-    processImport :: Set.Set FilePath -> String -> TricuAST -> IO [TricuAST]
-    processImport prog currentModule (SImport path "!Local") = do
-      ast <- preprocessFile' prog path
-      let defs = filter (not . isImport) ast
-      pure $ map (nsDefinition currentModule) defs
-    processImport prog _ (SImport path name) = do
-      ast <- preprocessFile' prog path
-      let defs = filter (not . isImport) ast
-      pure $ map (nsDefinition name) defs
-    processImport _ _ _ = error "Unexpected non-import in processImport"
+    procImp :: Set.Set FilePath -> String -> FilePath -> TricuAST -> IO [TricuAST]
+    procImp s m f (SImport p "!Local") = do
+      let ip = makeRelativeTo f p
+      a <- preprocessFile' s b ip
+      let d = filter (not . isImp) a
+      pure $ map (nsDefinition m) d
+    procImp s _ f (SImport p n) = do
+      let ip = makeRelativeTo f p
+      a <- preprocessFile' s b ip
+      let d = filter (not . isImp) a
+      pure $ map (nsDefinition n) d
+    procImp _ _ _ _ = error "Unexpected non-import in processImport"
+
+makeRelativeTo :: FilePath -> FilePath -> FilePath
+makeRelativeTo f i =
+    let d = takeDirectory f
+    in normalise $ d </> i
 
 nsDefinitions :: String -> [TricuAST] -> [TricuAST]
 nsDefinitions moduleName = map (nsDefinition moduleName)