diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -130,6 +130,44 @@ `OverloadedStrings` is enabled in every scripths repl by default, so string literals work directly as `Text` / `ByteString`; add any further extensions with `default-extensions`. +## The `-- compile` directive + +A notebook cell (or script) can be marked **compiled**: + +``` +-- compile +``` + +or, naming the generated module explicitly: + +``` +-- compile: Training.Core +``` + +The directive declares that the cell's contents are *module-level +declarations* destined for a generated Haskell module rather than the GHCi +prompt — a host environment (such as [Sabela](https://github.com/mchav/sabela)) +writes those declarations into a module, loads it with `:load` under +`-fobject-code -O2`, and gets native compiled code instead of interpreted +bytecode. Cells sharing a module name merge into one module; bare +`-- compile` cells share a default module. + +What scripths provides: + +- `ScriptHs.Parser` recognises the directive (`scriptCompile` on + `ScriptFile`) and offers `parseScriptNumbered`, a line-number-preserving + parse. +- `ScriptHs.Compiled` validates that a cell is declarations-only + (`checkCompilable`) and renders the generated module + (`renderCompiledModule`), preceding every unit with a + `{-# LINE n "sabela-cell-" #-}` pragma so GHC diagnostics map back to + the originating cell and line (`linePragmaTag` / `parseLinePragmaTag`). + +Under the **scripths CLI** the directive is currently a graceful no-op: it +parses as an ordinary comment and the cell runs interpreted, producing the +same results (just slower). Standalone compiled execution in the CLI may +come later. + ## Local packages By default `build-depends` resolve from Hackage. To build a script or notebook diff --git a/scripths.cabal b/scripths.cabal --- a/scripths.cabal +++ b/scripths.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: scripths -version: 0.5.0.0 +version: 0.5.1.0 synopsis: GHCi scripts for standalone execution and Markdown documentation. description: GHCi scripts for standalone execution (with dependency resolution) and Markdown documentation (produces inline output). homepage: https://www.datahaskell.org/ diff --git a/src/ScriptHs/Compiled.hs b/src/ScriptHs/Compiled.hs --- a/src/ScriptHs/Compiled.hs +++ b/src/ScriptHs/Compiled.hs @@ -25,7 +25,13 @@ import qualified Data.Text.Read as TR import ScriptHs.Parser (Line (..)) -import ScriptHs.Render (Kind (..), Piece (..), lineText, toPieces, unRewriteSplice) +import ScriptHs.Render ( + Kind (..), + Piece (..), + lineText, + toPieces, + unRewriteSplice, + ) -- | One cell's contribution to a generated module. data CellChunk = CellChunk diff --git a/src/ScriptHs/Notebook.hs b/src/ScriptHs/Notebook.hs --- a/src/ScriptHs/Notebook.hs +++ b/src/ScriptHs/Notebook.hs @@ -68,7 +68,8 @@ let ghciScript0 = generatedMarkedScript "" codeBlocks nonce <- makeNonce ghciScript0 let ghciScript = generatedMarkedScript nonce codeBlocks - sf = ScriptFile{scriptMeta = meta, scriptCompile = Nothing, scriptLines = ghciScript} + sf = + ScriptFile{scriptMeta = meta, scriptCompile = Nothing, scriptLines = ghciScript} rawOutput <- runScriptCapture opts notebookPath sf let indices = map fst codeBlocks outputs = diff --git a/src/ScriptHs/Parser.hs b/src/ScriptHs/Parser.hs --- a/src/ScriptHs/Parser.hs +++ b/src/ScriptHs/Parser.hs @@ -72,6 +72,10 @@ -- ^ Extensions from @default-extensions@ directives. , metaGhcOptions :: [Text] -- ^ Flags from @ghc-options@ directives. + , metaExtraLibDirs :: [Text] + -- ^ Native library search paths from @extra-lib-dirs@ directives. + , metaExtraIncludeDirs :: [Text] + -- ^ C header search paths from @extra-include-dirs@ directives. , metaPackages :: [Text] {- ^ Extra local package dirs from @packages@ directives, resolved relative to the script file (lets a notebook depend on a second, non-enclosing local @@ -125,10 +129,10 @@ Example: >>> parseScript "-- cabal: build-depends: text\nimport Data.Text (Text)\n" -ScriptFile {scriptMeta = CabalMeta {metaDeps = ["text"], metaExts = [], metaGhcOptions = [], metaPackages = [], metaSourceRepos = [], metaUnknownKeys = []}, scriptLines = [Import "import Data.Text (Text)"]} +ScriptFile {scriptMeta = CabalMeta {metaDeps = ["text"], metaExts = [], metaGhcOptions = [], metaExtraLibDirs = [], metaExtraIncludeDirs = [], metaPackages = [], metaSourceRepos = [], metaUnknownKeys = []}, scriptLines = [Import "import Data.Text (Text)"]} >>> parseScript "" -ScriptFile {scriptMeta = CabalMeta {metaDeps = [], metaExts = [], metaGhcOptions = [], metaPackages = [], metaSourceRepos = [], metaUnknownKeys = []}, scriptLines = []} +ScriptFile {scriptMeta = CabalMeta {metaDeps = [], metaExts = [], metaGhcOptions = [], metaExtraLibDirs = [], metaExtraIncludeDirs = [], metaPackages = [], metaSourceRepos = [], metaUnknownKeys = []}, scriptLines = []} -} parseScript :: Text -> ScriptFile parseScript = fst . parseScriptNumbered @@ -180,6 +184,8 @@ { metaDeps = concatMap metaDeps ms , metaExts = concatMap metaExts ms , metaGhcOptions = concatMap metaGhcOptions ms + , metaExtraLibDirs = concatMap metaExtraLibDirs ms + , metaExtraIncludeDirs = concatMap metaExtraIncludeDirs ms , metaPackages = concatMap metaPackages ms , metaSourceRepos = concatMap metaSourceRepos ms , metaUnknownKeys = concatMap metaUnknownKeys ms @@ -216,6 +222,8 @@ "build-depends" -> emptyCabal{metaDeps = items} "default-extensions" -> emptyCabal{metaExts = items} "ghc-options" -> emptyCabal{metaGhcOptions = items} + "extra-lib-dirs" -> emptyCabal{metaExtraLibDirs = items} + "extra-include-dirs" -> emptyCabal{metaExtraIncludeDirs = items} "packages" -> emptyCabal{metaPackages = items} "source-repository-package" -> emptyCabal{metaSourceRepos = maybeToList (parseSourceRepo value)} @@ -227,6 +235,8 @@ { metaDeps = [] , metaExts = [] , metaGhcOptions = [] + , metaExtraLibDirs = [] + , metaExtraIncludeDirs = [] , metaPackages = [] , metaSourceRepos = [] , metaUnknownKeys = [] diff --git a/src/ScriptHs/Render.hs b/src/ScriptHs/Render.hs --- a/src/ScriptHs/Render.hs +++ b/src/ScriptHs/Render.hs @@ -496,11 +496,15 @@ ["{- cabal:", "build-depends: " <> commaList (dedup ("base" : metaDeps meta))] ++ ["default-extensions: " <> commaList exts' | not (null exts')] ++ ["ghc-options: " <> T.unwords opts'] + ++ ["extra-lib-dirs: " <> commaList libDirs | not (null libDirs)] + ++ ["extra-include-dirs: " <> commaList incDirs | not (null incDirs)] ++ map renderRepo (metaSourceRepos meta) ++ ["-}"] where exts' = dedup (metaExts meta) opts' = dedup (metaGhcOptions meta ++ ["-Wno-unused-imports"]) + libDirs = dedup (metaExtraLibDirs meta) + incDirs = dedup (metaExtraIncludeDirs meta) commaList = T.intercalate ", " renderRepo r = T.unwords $ diff --git a/src/ScriptHs/Run.hs b/src/ScriptHs/Run.hs --- a/src/ScriptHs/Run.hs +++ b/src/ScriptHs/Run.hs @@ -176,7 +176,12 @@ let localPkgs = nub (roPackages opts ++ metaPkgDirs ++ enclosing) writeManagedCabalProject (projectDir "cabal.project") - (renderCabalProject localPkgs (metaSourceRepos meta)) + ( renderCabalProject + localPkgs + (metaSourceRepos meta) + (metaExtraLibDirs meta) + (metaExtraIncludeDirs meta) + ) -- A local package only imports if its name is also a build-depend; collect -- the names so renderCabalFile can add them (and warn on dirs without one). localNames <- localPackageNames localPkgs @@ -227,13 +232,29 @@ {- | Render a @cabal.project@ from local package dirs + git source-repo pins. Always includes @.@ (the synthetic script package). -} -renderCabalProject :: [FilePath] -> [SourceRepoPin] -> T.Text -renderCabalProject localPkgs repos = + +{- | The @cabal.project@. @extra-lib-dirs@\/@extra-include-dirs@ from cell +metadata go into a @package *@ stanza (not the executable's build-info), because +build-info dirs are not applied when cabal configures a /dependency/ — a native +library like OpenCASCADE is found only when its own package gets the search path. +-} +renderCabalProject :: + [FilePath] -> [SourceRepoPin] -> [T.Text] -> [T.Text] -> T.Text +renderCabalProject localPkgs repos libDirs incDirs = T.unlines $ [managedSentinel, "packages: ."] ++ map (\p -> " " <> T.pack p) localPkgs ++ concatMap renderRepo repos + ++ packageStar where + packageStar + | null libDirs && null incDirs = [] + | otherwise = + ["package *"] + ++ [" extra-lib-dirs: " <> T.intercalate ", " libDirs | not (null libDirs)] + ++ [ " extra-include-dirs: " <> T.intercalate ", " incDirs + | not (null incDirs) + ] renderRepo r = [ "source-repository-package" , " type: git" diff --git a/test/Test/Compiled.hs b/test/Test/Compiled.hs --- a/test/Test/Compiled.hs +++ b/test/Test/Compiled.hs @@ -16,8 +16,8 @@ ) import ScriptHs.Parser ( CompileDirective (..), - ScriptFile (scriptCompile, scriptLines), Line (..), + ScriptFile (scriptCompile, scriptLines), parseScript, parseScriptNumbered, ) @@ -132,7 +132,8 @@ testGroup "renderCompiledModule" [ testCase "module header and decl with LINE pragma" $ do - let src = renderCompiledModule "Training" [] [] [chunk 7 "f :: Int -> Int\nf x = x + 1\n"] + let src = + renderCompiledModule "Training" [] [] [chunk 7 "f :: Int -> Int\nf x = x + 1\n"] assertContains src "module Training where" assertContains src ("{-# LINE 1 \"" <> linePragmaTag 7 <> "\" #-}") assertContains src "f x = x + 1" diff --git a/test/Test/Parser.hs b/test/Test/Parser.hs --- a/test/Test/Parser.hs +++ b/test/Test/Parser.hs @@ -12,6 +12,8 @@ import ScriptHs.Parser ( CabalMeta ( metaDeps, + metaExtraIncludeDirs, + metaExtraLibDirs, metaExts, metaGhcOptions, metaPackages, @@ -114,6 +116,12 @@ , testCase "packages directive lists extra local package dirs" $ do let sf = parseScript "-- cabal: packages: ../th, ../persistent\n" (metaPackages . scriptMeta) sf @?= ["../th", "../persistent"] + , testCase "extra-lib-dirs directive lists native library search paths" $ do + let sf = parseScript "-- cabal: extra-lib-dirs: /opt/homebrew/lib, /usr/local/lib\n" + (metaExtraLibDirs . scriptMeta) sf @?= ["/opt/homebrew/lib", "/usr/local/lib"] + , testCase "extra-include-dirs directive lists C header search paths" $ do + let sf = parseScript "-- cabal: extra-include-dirs: /opt/homebrew/include\n" + (metaExtraIncludeDirs . scriptMeta) sf @?= ["/opt/homebrew/include"] , testCase "metadata stripped from lines" $ do let input = T.unlines diff --git a/test/Test/Render.hs b/test/Test/Render.hs --- a/test/Test/Render.hs +++ b/test/Test/Render.hs @@ -407,7 +407,8 @@ assertBool "has main = do" (T.isInfixOf "main = do" txt) assertBool "indents print 1" (T.isInfixOf " print 1" txt) , testCase "cabal-script header includes base + Wno-unused-imports" $ do - let hdr = renderCabalScriptHeader (CabalMeta ["dataframe", "text"] [] [] [] [] []) + let hdr = + renderCabalScriptHeader (CabalMeta ["dataframe", "text"] [] [] [] [] [] [] []) assertBool "opens block" (T.isInfixOf "{- cabal:" hdr) assertBool "base + deps" diff --git a/test/Test/Run.hs b/test/Test/Run.hs --- a/test/Test/Run.hs +++ b/test/Test/Run.hs @@ -1,5 +1,6 @@ module Test.Run (runTests) where +import Data.Char (isAsciiLower, isDigit) import Data.List (isInfixOf, isPrefixOf) import qualified Data.Text as T import Test.Tasty (TestTree, testGroup) @@ -15,7 +16,7 @@ ) emptyMeta :: CabalMeta -emptyMeta = CabalMeta [] [] [] [] [] [] +emptyMeta = CabalMeta [] [] [] [] [] [] [] [] runTests :: TestTree runTests = @@ -36,7 +37,7 @@ $ do let args = cabalArgs "/proj" "/proj/script.ghci" eTerm = last (filter ("--repl-option=" `isPrefixOf`) args) - assertBool "no space in terminator" (not (' ' `elem` eTerm)) + assertBool "no space in terminator" (' ' `notElem` eTerm) , testCase "includes --project-dir" $ do let args = cabalArgs "/proj" "/proj/script.ghci" assertBool "--project-dir present" $ @@ -45,20 +46,40 @@ , testGroup "renderCabalProject" [ testCase "base case has the managed sentinel and packages: ." $ do - let txt = renderCabalProject [] [] + let txt = renderCabalProject [] [] [] [] assertBool "sentinel" (T.isInfixOf "managed by scripths" txt) assertBool "packages ." (T.isInfixOf "packages: ." txt) , testCase "local package dirs appear as packages entries" $ do - let txt = renderCabalProject ["/abs/granite"] [] + let txt = renderCabalProject ["/abs/granite"] [] [] [] assertBool "abs path" (T.isInfixOf "/abs/granite" txt) , testCase "git pin renders a source-repository-package stanza" $ do let pin = SourceRepoPin "https://x/repo" "abc123" (Just "sub") - txt = renderCabalProject [] [pin] + txt = renderCabalProject [] [pin] [] [] assertBool "stanza" (T.isInfixOf "source-repository-package" txt) assertBool "type" (T.isInfixOf "type: git" txt) assertBool "location" (T.isInfixOf "location: https://x/repo" txt) assertBool "tag" (T.isInfixOf "tag: abc123" txt) assertBool "subdir" (T.isInfixOf "subdir: sub" txt) + , testCase "no package * stanza when no extra dirs are declared" $ do + let txt = renderCabalProject [] [] [] [] + assertBool "no package *" (not (T.isInfixOf "package *" txt)) + , testCase "extra dirs render a package * stanza (applies to deps)" $ do + let txt = + renderCabalProject + [] + [] + ["/opt/homebrew/opt/opencascade/lib"] + ["/opt/homebrew/opt/opencascade/include/opencascade"] + assertBool "package * header" (T.isInfixOf "package *" txt) + assertBool + "lib dir" + (T.isInfixOf " extra-lib-dirs: /opt/homebrew/opt/opencascade/lib" txt) + assertBool + "inc dir" + ( T.isInfixOf + " extra-include-dirs: /opt/homebrew/opt/opencascade/include/opencascade" + txt + ) ] , testGroup "deriveProjectName" @@ -80,7 +101,7 @@ let n = deriveProjectName "/проект/данные.md" assertBool "ASCII only" - (all (\c -> c == '-' || (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9')) n) + (all (\c -> c == '-' || isAsciiLower c || isDigit c) n) , testCase "an all-symbol path still yields a valid name" $ assertBool "fallback stem" diff --git a/test/Test/Version.hs b/test/Test/Version.hs --- a/test/Test/Version.hs +++ b/test/Test/Version.hs @@ -1,5 +1,6 @@ module Test.Version (versionTests) where +import Data.Maybe (isJust) import qualified Data.Text as T import Data.Version (makeVersion) import Test.Tasty (TestTree, testGroup) @@ -83,7 +84,7 @@ parseTagLine NotebookTag "# Title" @?= Nothing , testCase "an over-long component clamps instead of silently overflowing Int" $ do let huge = parseTagLine NotebookTag "" - assertBool "still parses" (huge /= Nothing) + assertBool "still parses" (isJust huge) assertBool "stays larger than a normal version (no wrap)" $ maybe False (> makeVersion [1, 0]) huge , testCase "leading zeros in a component are tolerated" $ @@ -185,7 +186,7 @@ assertBool "body intact" ("# Body" `T.isInfixOf` out) assertBool "single tag" (T.count "