mirror of
https://github.com/anoma/juvix.git
synced 2024-12-03 09:41:10 +03:00
Add main
field to juvix.yaml
(#2120)
- Closes #2067 This pr adds the field `main` to `juvix.yaml`. This field is optional and should contain a path to a juvix file that is meant to be used for the `compile` (and `dev compile`) command when no file is given as an argument in the CLI. This makes it possible to simply run `juvix compile` if the `main` is specified in the `jvuix.yaml`. I have updated the `juvix.yaml` of the milestone examples. --------- Co-authored-by: Paul Cadman <git@paulcadman.dev> Co-authored-by: Jonathan Cubides <jonathan.cubides@uib.no>
This commit is contained in:
parent
68ed1461ab
commit
4fcb881ebc
23
app/App.hs
23
app/App.hs
@ -6,6 +6,7 @@ import GlobalOptions
|
||||
import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.PathResolver
|
||||
import Juvix.Compiler.Pipeline
|
||||
import Juvix.Data.Error qualified as Error
|
||||
import Juvix.Extra.Paths.Base
|
||||
import Juvix.Prelude.Pretty hiding
|
||||
( Doc,
|
||||
)
|
||||
@ -23,6 +24,7 @@ data App m a where
|
||||
AskPackageGlobal :: App m Bool
|
||||
AskGlobalOptions :: App m GlobalOptions
|
||||
FromAppPathFile :: AppPath File -> App m (Path Abs File)
|
||||
GetMainFile :: Maybe (AppPath File) -> App m (Path Abs File)
|
||||
FromAppPathDir :: AppPath Dir -> App m (Path Abs Dir)
|
||||
RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m ()
|
||||
RunPipelineEither :: AppPath File -> Sem PipelineEff a -> App m (Either JuvixError (ResolverState, a))
|
||||
@ -48,6 +50,7 @@ runAppIO args@RunAppIOArgs {..} =
|
||||
interpret $ \case
|
||||
AskPackageGlobal -> return (_runAppIOArgsRoots ^. rootsPackageGlobal)
|
||||
FromAppPathFile p -> embed (prepathToAbsFile invDir (p ^. pathPath))
|
||||
GetMainFile m -> getMainFile' m
|
||||
FromAppPathDir p -> embed (prepathToAbsDir invDir (p ^. pathPath))
|
||||
RenderStdOut t
|
||||
| _runAppIOArgsGlobalOptions ^. globalOnlyErrors -> return ()
|
||||
@ -77,10 +80,28 @@ runAppIO args@RunAppIOArgs {..} =
|
||||
ExitJuvixError e -> do
|
||||
printErr e
|
||||
embed exitFailure
|
||||
ExitMsg exitCode t -> embed (putStrLn t >> hFlush stdout >> exitWith exitCode)
|
||||
ExitMsg exitCode t -> exitMsg' exitCode t
|
||||
SayRaw b -> embed (ByteString.putStr b)
|
||||
where
|
||||
exitMsg' :: ExitCode -> Text -> Sem r x
|
||||
exitMsg' exitCode t = embed (putStrLn t >> hFlush stdout >> exitWith exitCode)
|
||||
getMainFile' :: Maybe (AppPath File) -> Sem r (Path Abs File)
|
||||
getMainFile' = \case
|
||||
Just p -> embed (prepathToAbsFile invDir (p ^. pathPath))
|
||||
Nothing -> case pkg ^. packageMain of
|
||||
Just p -> embed (prepathToAbsFile invDir p)
|
||||
Nothing -> missingMainErr
|
||||
missingMainErr :: Sem r x
|
||||
missingMainErr =
|
||||
exitMsg'
|
||||
(ExitFailure 1)
|
||||
( "A path to the main file must be given in the CLI or specified in the `main` field of the "
|
||||
<> pack (toFilePath juvixYamlFile)
|
||||
<> " file"
|
||||
)
|
||||
invDir = _runAppIOArgsRoots ^. rootsInvokeDir
|
||||
pkg :: Package
|
||||
pkg = _runAppIOArgsRoots ^. rootsPackage
|
||||
g :: GlobalOptions
|
||||
g = _runAppIOArgsGlobalOptions
|
||||
printErr e =
|
||||
|
@ -11,8 +11,8 @@ import Juvix.Compiler.Core.Transformation.DisambiguateNames qualified as Core
|
||||
|
||||
runCommand :: (Members '[Embed IO, App] r) => CompileOptions -> Sem r ()
|
||||
runCommand opts@CompileOptions {..} = do
|
||||
inputFile <- fromAppPathFile _compileInputFile
|
||||
Core.CoreResult {..} <- runPipeline _compileInputFile upToCore
|
||||
inputFile <- getMainFile _compileInputFile
|
||||
Core.CoreResult {..} <- runPipeline (AppPath (preFileFromAbs inputFile) True) upToCore
|
||||
let arg =
|
||||
Compile.PipelineArg
|
||||
{ _pipelineArgFile = inputFile,
|
||||
|
@ -30,10 +30,10 @@ runCommand opts = do
|
||||
ensureDir buildDir
|
||||
cFile <- inputCFile file
|
||||
embed $ TIO.writeFile (toFilePath cFile) _resultCCode
|
||||
Compile.runCommand opts {_compileInputFile = AppPath (preFileFromAbs cFile) False}
|
||||
Compile.runCommand opts {_compileInputFile = Just (AppPath (preFileFromAbs cFile) False)}
|
||||
where
|
||||
getFile :: Sem r (Path Abs File)
|
||||
getFile = fromAppPathFile (opts ^. compileInputFile)
|
||||
getFile = getMainFile (opts ^. compileInputFile)
|
||||
|
||||
getTarget :: CompileTarget -> Sem r Backend.Target
|
||||
getTarget = \case
|
||||
|
@ -21,4 +21,4 @@ runCommand opts = do
|
||||
TargetAsm -> runAsmPipeline arg
|
||||
where
|
||||
getFile :: Sem r (Path Abs File)
|
||||
getFile = fromAppPathFile (opts ^. compileInputFile)
|
||||
getFile = getMainFile (opts ^. compileInputFile)
|
||||
|
@ -56,7 +56,7 @@ runCPipeline pa@PipelineArg {..} = do
|
||||
outfile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile
|
||||
Compile.runCommand
|
||||
_pipelineArgOptions
|
||||
{ _compileInputFile = AppPath (preFileFromAbs cFile) False,
|
||||
{ _compileInputFile = Just (AppPath (preFileFromAbs cFile) False),
|
||||
_compileOutputFile = Just (AppPath (preFileFromAbs outfile) False)
|
||||
}
|
||||
where
|
||||
|
@ -10,7 +10,7 @@ import System.Process qualified as P
|
||||
|
||||
runCommand :: forall r. (Members '[Embed IO, App] r) => CompileOptions -> Sem r ()
|
||||
runCommand opts = do
|
||||
inputFile <- fromAppPathFile (opts ^. compileInputFile)
|
||||
inputFile <- getMainFile (opts ^. compileInputFile)
|
||||
result <- runCompile inputFile opts
|
||||
case result of
|
||||
Left err -> printFailureExit err
|
||||
|
@ -30,7 +30,7 @@ data CompileOptions = CompileOptions
|
||||
_compileTerm :: Bool,
|
||||
_compileOutputFile :: Maybe (AppPath File),
|
||||
_compileTarget :: CompileTarget,
|
||||
_compileInputFile :: AppPath File,
|
||||
_compileInputFile :: Maybe (AppPath File),
|
||||
_compileOptimizationLevel :: Maybe Int,
|
||||
_compileInliningDepth :: Int
|
||||
}
|
||||
@ -100,7 +100,7 @@ parseCompileOptions supportedTargets parseInputFile = do
|
||||
)
|
||||
_compileTarget <- optCompileTarget supportedTargets
|
||||
_compileOutputFile <- optional parseGenericOutputFile
|
||||
_compileInputFile <- parseInputFile
|
||||
_compileInputFile <- optional parseInputFile
|
||||
pure CompileOptions {..}
|
||||
|
||||
optCompileTarget :: SupportedTargets -> Parser CompileTarget
|
||||
|
@ -49,6 +49,7 @@ getPackage = do
|
||||
{ _packageName = tproj,
|
||||
_packageVersion = tversion,
|
||||
_packageBuildDir = Nothing,
|
||||
_packageMain = Nothing,
|
||||
_packageDependencies = [defaultStdlibDep]
|
||||
}
|
||||
|
||||
|
@ -1,2 +1,3 @@
|
||||
name: Collatz
|
||||
main: Collatz.juvix
|
||||
version: 0.1.0
|
||||
|
@ -1,2 +1,3 @@
|
||||
name: Fibonacci
|
||||
main: Fibonacci.juvix
|
||||
version: 0.1.0
|
||||
|
@ -1,2 +1,3 @@
|
||||
name: Hanoi
|
||||
main: Hanoi.juvix
|
||||
version: 0.1.0
|
||||
|
@ -1,2 +1,3 @@
|
||||
name: HelloWorld
|
||||
main: HelloWorld.juvix
|
||||
version: 0.1.0
|
||||
|
@ -1,2 +1,3 @@
|
||||
name: PascalsTriangle
|
||||
main: PascalsTriangle.juvix
|
||||
version: 0.1.0
|
||||
|
@ -1,2 +1,3 @@
|
||||
name: TicTacToe
|
||||
main: CLI/TicTacToe.juvix
|
||||
version: 0.1.0
|
||||
|
@ -8,6 +8,7 @@ module Juvix.Compiler.Pipeline.Package
|
||||
packageBuildDir,
|
||||
packageVersion,
|
||||
packageDependencies,
|
||||
packageMain,
|
||||
rawPackage,
|
||||
readPackage,
|
||||
readPackageIO,
|
||||
@ -49,7 +50,8 @@ data Package' (s :: IsProcessed) = Package
|
||||
{ _packageName :: NameType s,
|
||||
_packageVersion :: VersionType s,
|
||||
_packageDependencies :: DependenciesType s,
|
||||
_packageBuildDir :: Maybe (SomeBase Dir)
|
||||
_packageBuildDir :: Maybe (SomeBase Dir),
|
||||
_packageMain :: Maybe (Prepath File)
|
||||
}
|
||||
deriving stock (Generic)
|
||||
|
||||
@ -88,6 +90,7 @@ instance FromJSON RawPackage where
|
||||
_packageVersion <- keyMay "version" asText
|
||||
_packageDependencies <- keyMay "dependencies" fromAesonParser
|
||||
_packageBuildDir <- keyMay "build-dir" fromAesonParser
|
||||
_packageMain <- keyMay "main" fromAesonParser
|
||||
return Package {..}
|
||||
err :: a
|
||||
err = error "Failed to parse juvix.yaml"
|
||||
@ -99,6 +102,7 @@ emptyPackage =
|
||||
{ _packageName = defaultPackageName,
|
||||
_packageVersion = defaultVersion,
|
||||
_packageDependencies = [defaultStdlibDep],
|
||||
_packageMain = Nothing,
|
||||
_packageBuildDir = Nothing
|
||||
}
|
||||
|
||||
@ -108,7 +112,8 @@ rawPackage pkg =
|
||||
{ _packageName = Just (pkg ^. packageName),
|
||||
_packageVersion = Just (prettySemVer (pkg ^. packageVersion)),
|
||||
_packageDependencies = Just (pkg ^. packageDependencies),
|
||||
_packageBuildDir = pkg ^. packageBuildDir
|
||||
_packageBuildDir = pkg ^. packageBuildDir,
|
||||
_packageMain = pkg ^. packageMain
|
||||
}
|
||||
|
||||
processPackage :: forall r. (Members '[Error Text] r) => Maybe (SomeBase Dir) -> RawPackage -> Sem r Package
|
||||
@ -117,9 +122,13 @@ processPackage buildDir pkg = do
|
||||
base :: SomeBase Dir = fromMaybe (Rel relBuildDir) buildDir <///> relStdlibDir
|
||||
stdlib = Dependency (mkPrepath (fromSomeDir base))
|
||||
_packageDependencies = fromMaybe [stdlib] (pkg ^. packageDependencies)
|
||||
_packageBuildDir = pkg ^. packageBuildDir
|
||||
_packageVersion <- getVersion
|
||||
return Package {..}
|
||||
return
|
||||
Package
|
||||
{ _packageBuildDir = pkg ^. packageBuildDir,
|
||||
_packageMain = pkg ^. packageMain,
|
||||
..
|
||||
}
|
||||
where
|
||||
getVersion :: Sem r SemVer
|
||||
getVersion = case pkg ^. packageVersion of
|
||||
@ -143,6 +152,7 @@ globalPackage =
|
||||
{ _packageDependencies = [defaultStdlibDep],
|
||||
_packageName = "global-juvix-package",
|
||||
_packageVersion = defaultVersion,
|
||||
_packageMain = Nothing,
|
||||
_packageBuildDir = Nothing
|
||||
}
|
||||
|
||||
|
@ -20,7 +20,9 @@ import System.Directory qualified as System
|
||||
import System.Environment
|
||||
|
||||
-- | A file/directory path that may contain environmental variables
|
||||
newtype Prepath d = Prepath {_prepath :: String}
|
||||
newtype Prepath d = Prepath
|
||||
{ _prepath :: String
|
||||
}
|
||||
deriving stock (Show, Eq, Data, Generic)
|
||||
|
||||
makeLenses ''Prepath
|
||||
|
@ -11,6 +11,34 @@ tests:
|
||||
JUVIX_FILE
|
||||
exit-status: 0
|
||||
|
||||
- name: hello-world-no-arg
|
||||
command:
|
||||
shell:
|
||||
- bash
|
||||
script: |
|
||||
cd ./examples/milestone/HelloWorld
|
||||
juvix compile
|
||||
./HelloWorld
|
||||
exit-status: 0
|
||||
stdout: |
|
||||
hello world!
|
||||
|
||||
- name: hello-world-no-arg-error
|
||||
command:
|
||||
shell:
|
||||
- bash
|
||||
script: |
|
||||
temp=$(mktemp -d)
|
||||
trap 'rm -rf -- "$temp"' EXIT
|
||||
cd ./examples/milestone/
|
||||
cp -r HelloWorld "$temp"
|
||||
cd "$temp/HelloWorld"
|
||||
sed -i '/^main:/d' juvix.yaml
|
||||
juvix compile
|
||||
exit-status: 1
|
||||
stdout: |
|
||||
A path to the main file must be given in the CLI or specified in the `main` field of the juvix.yaml file
|
||||
|
||||
- name: hello-world
|
||||
command:
|
||||
shell:
|
||||
|
Loading…
Reference in New Issue
Block a user