diff --git a/demos/equality.tri b/demos/equality.tri index 28f5383..e880ac9 100644 --- a/demos/equality.tri +++ b/demos/equality.tri @@ -1,5 +1,5 @@ -!import "../lib/base.tri" !Local -!import "../lib/list.tri" !Local +!import "../lib/Base.tri" !Local +!import "../lib/List.tri" !Local main = lambdaEqualsTC diff --git a/demos/levelOrderTraversal.tri b/demos/levelOrderTraversal.tri index a2cf4db..252d7d0 100644 --- a/demos/levelOrderTraversal.tri +++ b/demos/levelOrderTraversal.tri @@ -1,5 +1,5 @@ -!import "../lib/base.tri" Lib -!import "../lib/list.tri" !Local +!import "../lib/Base.tri" Lib +!import "../lib/List.tri" !Local main = exampleTwo -- Level Order Traversal of a labelled binary tree diff --git a/demos/patternMatching.tri b/demos/patternMatching.tri index 88f733d..e38656e 100644 --- a/demos/patternMatching.tri +++ b/demos/patternMatching.tri @@ -1,4 +1,4 @@ -!import "../lib/patterns.tri" !Local +!import "../lib/Patterns.tri" !Local -- We can do conditional pattern matching by providing a list of lists, where -- each sublist contains a boolean expression and a function to return if said diff --git a/demos/size.tri b/demos/size.tri index 9d2d176..5b43ce1 100644 --- a/demos/size.tri +++ b/demos/size.tri @@ -1,5 +1,5 @@ -!import "../lib/base.tri" !Local -!import "../lib/list.tri" !Local +!import "../lib/Base.tri" !Local +!import "../lib/List.tri" !Local main = size size diff --git a/demos/toSource.tri b/demos/toSource.tri index 8028ce3..e31d2c5 100644 --- a/demos/toSource.tri +++ b/demos/toSource.tri @@ -1,5 +1,5 @@ -!import "../lib/base.tri" !Local -!import "../lib/list.tri" !Local +!import "../lib/Base.tri" !Local +!import "../lib/List.tri" !Local main = toSource not? -- Thanks to intensionality, we can inspect the structure of a given value diff --git a/install-lib.sh b/install-lib.sh new file mode 100755 index 0000000..b59483e --- /dev/null +++ b/install-lib.sh @@ -0,0 +1,6 @@ +#!/bin/bash +set -xe + +mkdir -p $HOME/.local/share/tricu/lib + +cp -r lib/* $HOME/.local/share/tricu/lib/ diff --git a/lib/base.tri b/lib/Base.tri similarity index 100% rename from lib/base.tri rename to lib/Base.tri diff --git a/lib/list.tri b/lib/List.tri similarity index 98% rename from lib/list.tri rename to lib/List.tri index ccddfa1..0396ec5 100644 --- a/lib/list.tri +++ b/lib/List.tri @@ -1,4 +1,4 @@ -!import "base.tri" !Local +!import "Base.tri" !Local _ = t diff --git a/lib/patterns.tri b/lib/Patterns.tri similarity index 89% rename from lib/patterns.tri rename to lib/Patterns.tri index da55395..cc71711 100644 --- a/lib/patterns.tri +++ b/lib/Patterns.tri @@ -1,5 +1,5 @@ -!import "base.tri" !Local -!import "list.tri" List +!import "Base.tri" !Local +!import "List.tri" List match_ = y (self value patterns : triage diff --git a/src/FileEval.hs b/src/FileEval.hs index 50dd8b8..4ce61cd 100644 --- a/src/FileEval.hs +++ b/src/FileEval.hs @@ -5,11 +5,12 @@ import Lexer import Parser import Research -import Data.List (partition) -import Data.Maybe (mapMaybe) -import Control.Monad (foldM) +import Data.List (partition, isSuffixOf) +import Data.Maybe (mapMaybe) +import Control.Monad (foldM) import System.IO -import System.FilePath (takeDirectory, normalise, ()) +import System.Directory (doesFileExist, getCurrentDirectory, getXdgDirectory, XdgDirectory(..)) +import System.FilePath ((), takeDirectory, isAbsolute, normalise) import qualified Data.Map as Map import qualified Data.Set as Set @@ -31,7 +32,7 @@ processImports seen base currentPath asts = where isImp (SImport _ _) = True isImp _ = False - getImportInfo (SImport p n) = Just (p, n, makeRelativeTo currentPath p) + getImportInfo (SImport p n) = Just (p, n, p) getImportInfo _ = Nothing evaluateFileResult :: FilePath -> IO T @@ -81,11 +82,12 @@ preprocessFile' seen base currentPath = do Left err -> errorWithoutStackTrace err Right (nonImports, importPaths) -> do let seen' = Set.insert currentPath seen - imported <- concat <$> mapM (processImportPath seen' base) importPaths + imported <- concat <$> mapM (processImportPath seen' base currentPath) importPaths pure $ imported ++ nonImports where - processImportPath seen base (path, name, importPath) = do - ast <- preprocessFile' seen base importPath + processImportPath seen base currentFile (path, name, _) = do + resolvedPath <- resolveImportPath currentFile path + ast <- preprocessFile' seen base resolvedPath pure $ map (nsDefinition (if name == "!Local" then "" else name)) $ filter (not . isImp) ast isImp (SImport _ _) = True @@ -96,6 +98,40 @@ makeRelativeTo f i = let d = takeDirectory f in normalise $ d i +resolveImportPath :: FilePath -> FilePath -> IO FilePath +resolveImportPath currentFile importPath = do + let pathWithExt = if ".tri" `isSuffixOf` importPath + then importPath + else importPath ++ ".tri" + + let relativeToFile = makeRelativeTo currentFile pathWithExt + fileRelExists <- doesFileExist relativeToFile + if fileRelExists + then return relativeToFile + else if isAbsolute pathWithExt then do + exists <- doesFileExist pathWithExt + if exists + then return pathWithExt + else errorWithoutStackTrace $ "File not found: " ++ pathWithExt + else do + currentDir <- getCurrentDirectory + let currentPath = currentDir pathWithExt + + currentExists <- doesFileExist currentPath + if currentExists + then return currentPath + else do + dataDir <- getXdgDirectory XdgData "tricu" + let libPath = dataDir "lib" pathWithExt + + libExists <- doesFileExist libPath + if libExists + then return libPath + else errorWithoutStackTrace $ "File not found: " ++ pathWithExt ++ + "\nSearched in:\n- " ++ relativeToFile ++ + "\n- " ++ currentPath ++ + "\n- " ++ libPath + nsDefinitions :: String -> [TricuAST] -> [TricuAST] nsDefinitions moduleName = map (nsDefinition moduleName) diff --git a/src/REPL.hs b/src/REPL.hs index 3966cb5..3f26a1b 100644 --- a/src/REPL.hs +++ b/src/REPL.hs @@ -18,6 +18,8 @@ import Data.List (dropWhile, dropWhileEnd, isPrefixOf) import Data.Version (showVersion) import Paths_tricu (version) import System.Console.Haskeline +import System.Directory (doesFileExist, getCurrentDirectory, getXdgDirectory, XdgDirectory(..)) +import System.FilePath ((), takeDirectory, isAbsolute) import qualified Data.Map as Map import qualified Data.Text as T @@ -107,12 +109,16 @@ repl env = runInputT settings (withInterrupt (loop env Decode)) res <- runMaybeT $ do let fset = setComplete completeFilename defaultSettings path <- MaybeT $ runInputT fset $ - getInputLineWithInitial "File path to load < " ("", "") + getInputLineWithInitial "Module name or path to import < " ("", "") + + currentDir <- liftIO getCurrentDirectory + let currentFile = currentDir "dummy.tri" + resolvedPath <- liftIO $ resolveImportPath currentFile (strip path) text <- MaybeT $ liftIO $ handle (\e -> do putStrLn $ "Error reading file: " ++ displayException (e :: IOException) return Nothing - ) $ Just <$> readFile (strip path) + ) $ Just <$> readFile resolvedPath case parseProgram (lexTricu text) of Left err -> do @@ -127,7 +133,7 @@ repl env = runInputT settings (withInterrupt (loop env Decode)) lift $ outputStrLn "Namespace must start with an uppercase letter" MaybeT $ return Nothing else do - prog <- liftIO $ preprocessFile (strip path) + prog <- liftIO $ preprocessFile resolvedPath let code = case name of "!Local" -> prog _ -> nsDefinitions name prog diff --git a/test/Spec.hs b/test/Spec.hs index 4254501..a7f342b 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -366,98 +366,98 @@ lambdas = testGroup "Lambda Evaluation Tests" providedLibraries :: TestTree providedLibraries = testGroup "Library Tests" [ testCase "Triage test Leaf" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "test t" env = decodeResult $ result $ evalTricu library (parseTricu input) env @?= "\"Leaf\"" , testCase "Triage test (Stem Leaf)" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "test (t t)" env = decodeResult $ result $ evalTricu library (parseTricu input) env @?= "\"Stem\"" , testCase "Triage test (Fork Leaf Leaf)" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "test (t t t)" env = decodeResult $ result $ evalTricu library (parseTricu input) env @?= "\"Fork\"" , testCase "Boolean NOT: true" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "not? true" env = result $ evalTricu library (parseTricu input) env @?= Leaf , testCase "Boolean NOT: false" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "not? false" env = result $ evalTricu library (parseTricu input) env @?= Stem Leaf , testCase "Boolean AND TF" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "and? (t t) (t)" env = evalTricu library (parseTricu input) result env @?= Leaf , testCase "Boolean AND FT" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "and? (t) (t t)" env = evalTricu library (parseTricu input) result env @?= Leaf , testCase "Boolean AND FF" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "and? (t) (t)" env = evalTricu library (parseTricu input) result env @?= Leaf , testCase "Boolean AND TT" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "and? (t t) (t t)" env = evalTricu library (parseTricu input) result env @?= Stem Leaf , testCase "List head" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "head [(t) (t t) (t t t)]" env = evalTricu library (parseTricu input) result env @?= Leaf , testCase "List tail" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "head (tail (tail [(t) (t t) (t t t)]))" env = evalTricu library (parseTricu input) result env @?= Fork Leaf Leaf , testCase "List map" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "head (tail (map (a : (t t t)) [(t) (t) (t)]))" env = evalTricu library (parseTricu input) result env @?= Fork Leaf Leaf , testCase "Empty list check" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "emptyList? []" env = evalTricu library (parseTricu input) result env @?= Stem Leaf , testCase "Non-empty list check" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "not? (emptyList? [(1) (2) (3)])" env = evalTricu library (parseTricu input) result env @?= Stem Leaf , testCase "Concatenate strings" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "append \"Hello, \" \"world!\"" env = decodeResult $ result $ evalTricu library (parseTricu input) env @?= "\"Hello, world!\"" , testCase "Verifying Equality" $ do - library <- evaluateFile "./lib/list.tri" + library <- evaluateFile "./lib/List.tri" let input = "equal? (t t t) (t t t)" env = evalTricu library (parseTricu input) result env @?= Stem Leaf @@ -474,12 +474,12 @@ fileEval = testGroup "File evaluation tests" res @?= Fork (Stem Leaf) Leaf , testCase "Mapping and Equality" $ do - library <- liftIO $ evaluateFile "./lib/list.tri" + library <- liftIO $ evaluateFile "./lib/List.tri" fEnv <- liftIO $ evaluateFileWithContext library "./test/map.tri" (mainResult fEnv) @?= Stem Leaf , testCase "Eval and decoding string" $ do - library <- liftIO $ evaluateFile "./lib/list.tri" + library <- liftIO $ evaluateFile "./lib/List.tri" res <- liftIO $ evaluateFileWithContext library "./test/string.tri" decodeResult (result res) @?= "\"String test!\"" ] diff --git a/test/named-imports/1.tri b/test/named-imports/1.tri index 8fe9296..5599ef8 100644 --- a/test/named-imports/1.tri +++ b/test/named-imports/1.tri @@ -1,5 +1,4 @@ - -!import "lib/base.tri" +!import "lib/Base.tri" !import "test/named-imports/2.tri" !import "test/named-imports/3.tri" ThreeRenamed diff --git a/tricu.cabal b/tricu.cabal index 02a2e53..e2eca6c 100644 --- a/tricu.cabal +++ b/tricu.cabal @@ -26,6 +26,7 @@ executable tricu base >=4.7 , cmdargs , containers + , directory , exceptions , filepath , haskeline @@ -55,6 +56,7 @@ test-suite tricu-tests base , cmdargs , containers + , directory , exceptions , filepath , haskeline