1
1
mirror of https://github.com/anoma/juvix.git synced 2024-09-19 20:48:55 +03:00
juvix/app/App.hs

240 lines
8.7 KiB
Haskell
Raw Normal View History

module App where
2022-09-14 17:16:15 +03:00
import CommonOptions
import Data.ByteString qualified as ByteString
import GlobalOptions
import Juvix.Compiler.Internal.Translation (InternalTypedResult)
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination.Checker
import Juvix.Compiler.Pipeline.Loader.PathResolver
import Juvix.Compiler.Pipeline.Root
import Juvix.Compiler.Pipeline.Run
import Juvix.Data.Error qualified as Error
import Juvix.Extra.Paths.Base hiding (rootBuildDir)
import Juvix.Prelude.Pretty hiding
( Doc,
)
import System.Console.ANSI qualified as Ansi
data App m a where
ExitMsg :: ExitCode -> Text -> App m a
ExitFailMsg :: Text -> App m a
ExitJuvixError :: JuvixError -> App m a
PrintJuvixError :: JuvixError -> App m ()
AskRoot :: App m Root
AskArgs :: App m RunAppIOArgs
2022-12-20 15:05:40 +03:00
AskInvokeDir :: App m (Path Abs Dir)
AskPkgDir :: App m (Path Abs Dir)
AskBuildDir :: App m (Path Abs Dir)
2022-09-14 17:16:15 +03:00
AskPackage :: App m Package
AskPackageGlobal :: App m Bool
2022-09-14 17:16:15 +03:00
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 ()
Say :: Text -> App m ()
2022-12-20 15:05:40 +03:00
SayRaw :: ByteString -> App m ()
data RunAppIOArgs = RunAppIOArgs
{ _runAppIOArgsGlobalOptions :: GlobalOptions,
_runAppIOArgsRoot :: Root
}
makeSem ''App
makeLenses ''RunAppIOArgs
runAppIO ::
forall r a.
(Members '[Embed IO, TaggedLock] r) =>
RunAppIOArgs ->
Sem (App ': r) a ->
Sem r a
runAppIO args = evalSingletonCache (readPackageRootIO root) . reAppIO args
where
root = args ^. runAppIOArgsRoot
reAppIO ::
forall r a.
(Members '[Embed IO, TaggedLock] r) =>
RunAppIOArgs ->
Sem (App ': r) a ->
Sem (SCache Package ': r) a
reAppIO args@RunAppIOArgs {..} =
reinterpret $ \case
Extract builtin definitions for loading a Package into bundled package-base package (#2535) This PR creates a new package that's bundled with the compiler in a similar way to the stdlib and the package description package. ## The `package-base` Package This package is called [package-base](https://github.com/anoma/juvix/tree/ab4376cf9e2e1330ff3feb98c5ba940a622d8964/include/package-base) and contains the minimal set of definitions required to load a Package file. The [`Juvix.Builtin`](https://github.com/anoma/juvix/blob/ab4376cf9e2e1330ff3feb98c5ba940a622d8964/include/package-base/Juvix/Builtin/V1.juvix) module contains: ``` module Juvix.Builtin.V1; import Juvix.Builtin.V1.Nat open public; import Juvix.Builtin.V1.Trait.Natural open public; import Juvix.Builtin.V1.String open public; import Juvix.Builtin.V1.Bool open public; import Juvix.Builtin.V1.Maybe open public; import Juvix.Builtin.V1.List open public; import Juvix.Builtin.V1.Fixity open public; ``` `Juvix.Builtin.V1.Bool` is required to support backend primitive integers `Juvix.Builtin.V1.Trait.Natural` is required to support numeric literals. ## The `PackageDescription.V2` module This PR also adds a new [`PackageDescription.V2`](https://github.com/anoma/juvix/blob/ab4376cf9e2e1330ff3feb98c5ba940a622d8964/include/package/PackageDescription/V2.juvix) type that uses the `package-base`. This is to avoid breaking existing Package files. The Packages files in the repo (except those that test `PackageDescription.V1`) have also been updated. ## Updating the stdlib The standard library will be updated to use `Juvix.Builtin.*` modules in a subsequent PR. * Part of https://github.com/anoma/juvix/issues/2511
2023-11-30 19:22:18 +03:00
AskPackageGlobal -> return (_runAppIOArgsRoot ^. rootPackageType `elem` [GlobalStdlib, GlobalPackageDescription, GlobalPackageBase])
FromAppPathFile p -> embed (prepathToAbsFile invDir (p ^. pathPath))
GetMainFile m -> getMainFile' m
FromAppPathDir p -> liftIO (prepathToAbsDir invDir (p ^. pathPath))
RenderStdOut t
| _runAppIOArgsGlobalOptions ^. globalOnlyErrors -> return ()
| otherwise -> embed $ do
sup <- Ansi.hSupportsANSIColor stdout
renderIO (not (_runAppIOArgsGlobalOptions ^. globalNoColors) && sup) t
AskGlobalOptions -> return _runAppIOArgsGlobalOptions
AskPackage -> getPkg
AskArgs -> return args
AskRoot -> return _runAppIOArgsRoot
AskInvokeDir -> return invDir
AskPkgDir -> return (_runAppIOArgsRoot ^. rootRootDir)
AskBuildDir -> return (resolveAbsBuildDir (_runAppIOArgsRoot ^. rootRootDir) (_runAppIOArgsRoot ^. rootBuildDir))
Say t
| g ^. globalOnlyErrors -> return ()
| otherwise -> putStrLn t
PrintJuvixError e -> do
printErr e
ExitJuvixError e -> do
printErr e
embed exitFailure
ExitMsg exitCode t -> exitMsg' (exitWith exitCode) t
ExitFailMsg t -> exitMsg' exitFailure t
SayRaw b -> embed (ByteString.putStr b)
where
getPkg :: (Members '[SCache Package] r') => Sem r' Package
getPkg = cacheSingletonGet
exitMsg' :: (Members '[Embed IO] r') => IO x -> Text -> Sem r' x
exitMsg' onExit t = liftIO (putStrLn t >> hFlush stdout >> onExit)
getMainFile' :: (Members '[SCache Package, Embed IO] r') => Maybe (AppPath File) -> Sem r' (Path Abs File)
getMainFile' = \case
Just p -> embed (prepathToAbsFile invDir (p ^. pathPath))
Nothing -> do
pkg <- getPkg
case pkg ^. packageMain of
Just p -> embed (prepathToAbsFile invDir p)
Nothing -> missingMainErr
missingMainErr :: (Members '[Embed IO] r') => Sem r' x
missingMainErr =
exitMsg'
exitFailure
( "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 = _runAppIOArgsRoot ^. rootInvokeDir
g :: GlobalOptions
g = _runAppIOArgsGlobalOptions
printErr e =
embed $ hPutStrLn stderr $ run $ runReader (project' @GenericOptions g) $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalOnlyErrors) e
getEntryPoint' :: (Members '[Embed IO, TaggedLock] r) => RunAppIOArgs -> AppPath File -> Sem r EntryPoint
getEntryPoint' RunAppIOArgs {..} inputFile = do
let opts = _runAppIOArgsGlobalOptions
root = _runAppIOArgsRoot
2022-09-14 17:16:15 +03:00
estdin <-
if
| opts ^. globalStdin -> Just <$> liftIO getContents
2022-09-14 17:16:15 +03:00
| otherwise -> return Nothing
set entryPointStdin estdin <$> entryPointFromGlobalOptionsPre root (inputFile ^. pathPath) opts
2022-09-14 17:16:15 +03:00
runPipelineEither :: (Members '[Embed IO, TaggedLock, App] r) => AppPath File -> Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, PipelineResult a))
runPipelineEither input_ p = do
args <- askArgs
entry <- getEntryPoint' args input_
runIOEither entry p
runPipelineSetupEither :: (Members '[Embed IO, TaggedLock, App] r) => Sem (PipelineEff' r) a -> Sem r (Either JuvixError (ResolverState, a))
runPipelineSetupEither p = do
args <- askArgs
entry <- getEntryPointStdin' args
runIOEitherPipeline entry p
getEntryPointStdin' :: (Members '[Embed IO, TaggedLock] r) => RunAppIOArgs -> Sem r EntryPoint
getEntryPointStdin' RunAppIOArgs {..} = do
let opts = _runAppIOArgsGlobalOptions
root = _runAppIOArgsRoot
estdin <-
if
| opts ^. globalStdin -> Just <$> liftIO getContents
| otherwise -> return Nothing
set entryPointStdin estdin <$> entryPointFromGlobalOptionsNoFile root opts
someBaseToAbs' :: (Members '[App] r) => SomeBase a -> Sem r (Path Abs a)
2022-12-20 15:05:40 +03:00
someBaseToAbs' f = do
r <- askInvokeDir
return (someBaseToAbs r f)
filePathToAbs :: (Members '[Embed IO, App] r) => Prepath FileOrDir -> Sem r (Either (Path Abs File) (Path Abs Dir))
Add `juvix format` command (#1886) This PR adds `juvix format` that can be used to format either a single Juvix file or all files in a Juvix project. ## Usage ``` $ juvix format --help Usage: juvix format JUVIX_FILE_OR_PROJECT [--check] [--in-place] Format a Juvix file or Juvix project When the command is run with an unformatted file it prints the reformatted source to standard output. When the command is run with a project directory it prints a list of unformatted files in the project. Available options: JUVIX_FILE_OR_PROJECT Path to a .juvix file or to a directory containing a Juvix project. --check Do not print reformatted sources or unformatted file paths to standard output. --in-place Do not print reformatted sources to standard output. Overwrite the target's contents with the formatted version if the formatted version differs from the original content. -h,--help Show this help text ``` ## Location of main implementation The implementation is split into two components: * The src API: `format` and `formatProject` https://github.com/anoma/juvix/blob/73952ba15c90f33919c75426cf62ae7e83fd3225/src/Juvix/Formatter.hs * The CLI interface: https://github.com/anoma/juvix/blob/73952ba15c90f33919c75426cf62ae7e83fd3225/app/Commands/Format.hs ## in-place uses polysemy Resource effect The `--in-place` option makes a backup of the target file and restores it if there's an error during processing to avoid data loss. The implementation of this uses the polysemy [Resource effect](https://hackage.haskell.org/package/polysemy-1.9.0.0/docs/Polysemy-Resource.html). The recommended way to interpret the resource effect is to use `resourceToIOFinal` which makes it necessary to change the effects interpretation in main to use `Final IO`: https://github.com/anoma/juvix/blob/73952ba15c90f33919c75426cf62ae7e83fd3225/app/Main.hs#L15 ## Format input is `FilePath` The format options uses `FilePath` instead of `AppFile f` for the input file/directory used by other commands. This is because we cannot determine if the input string is a file or directory in the CLI parser (we require IO). I discussed some ideas with @janmasrovira on how to improve this in a way that would also solve other issues with CLI input file/parsing but I want to defer this to a separate PR as this one is already quite large. One consequence of Format using `FilePath` as the input option is that the code that changes the working directory to the root of the project containing the CLI input file is changed to work with `FilePath`: https://github.com/anoma/juvix/blob/f715ef6a531f63c40ac3f629dd9cfea7e867507a/app/TopCommand/Options.hs#L33 ## New dependencies This PR adds new dependencies on `temporary` and `polysemy-zoo`. `temporary` is used for `emptySystemTempFile` in the implementation of the TempFile interpreter for IO: https://github.com/anoma/juvix/blob/73952ba15c90f33919c75426cf62ae7e83fd3225/src/Juvix/Data/Effect/Files/IO.hs#L49 `polysemy-zoo` is used for the `Fresh` effect and `absorbMonadThrow` in the implementation of the pure TempFile interpreter: https://github.com/anoma/juvix/blob/73952ba15c90f33919c75426cf62ae7e83fd3225/src/Juvix/Data/Effect/Files/Pure.hs#L91 NB: The pure TempFile interpreter is not used, but it seemed a good idea to include it while it's fresh in my mind. * Closes https://github.com/anoma/juvix/issues/1777 --------- Co-authored-by: Jonathan Cubides <jonathan.cubides@uib.no>
2023-03-29 16:51:04 +03:00
filePathToAbs fp = do
invokeDir <- askInvokeDir
embed (fromPreFileOrDir invokeDir fp)
Add `juvix format` command (#1886) This PR adds `juvix format` that can be used to format either a single Juvix file or all files in a Juvix project. ## Usage ``` $ juvix format --help Usage: juvix format JUVIX_FILE_OR_PROJECT [--check] [--in-place] Format a Juvix file or Juvix project When the command is run with an unformatted file it prints the reformatted source to standard output. When the command is run with a project directory it prints a list of unformatted files in the project. Available options: JUVIX_FILE_OR_PROJECT Path to a .juvix file or to a directory containing a Juvix project. --check Do not print reformatted sources or unformatted file paths to standard output. --in-place Do not print reformatted sources to standard output. Overwrite the target's contents with the formatted version if the formatted version differs from the original content. -h,--help Show this help text ``` ## Location of main implementation The implementation is split into two components: * The src API: `format` and `formatProject` https://github.com/anoma/juvix/blob/73952ba15c90f33919c75426cf62ae7e83fd3225/src/Juvix/Formatter.hs * The CLI interface: https://github.com/anoma/juvix/blob/73952ba15c90f33919c75426cf62ae7e83fd3225/app/Commands/Format.hs ## in-place uses polysemy Resource effect The `--in-place` option makes a backup of the target file and restores it if there's an error during processing to avoid data loss. The implementation of this uses the polysemy [Resource effect](https://hackage.haskell.org/package/polysemy-1.9.0.0/docs/Polysemy-Resource.html). The recommended way to interpret the resource effect is to use `resourceToIOFinal` which makes it necessary to change the effects interpretation in main to use `Final IO`: https://github.com/anoma/juvix/blob/73952ba15c90f33919c75426cf62ae7e83fd3225/app/Main.hs#L15 ## Format input is `FilePath` The format options uses `FilePath` instead of `AppFile f` for the input file/directory used by other commands. This is because we cannot determine if the input string is a file or directory in the CLI parser (we require IO). I discussed some ideas with @janmasrovira on how to improve this in a way that would also solve other issues with CLI input file/parsing but I want to defer this to a separate PR as this one is already quite large. One consequence of Format using `FilePath` as the input option is that the code that changes the working directory to the root of the project containing the CLI input file is changed to work with `FilePath`: https://github.com/anoma/juvix/blob/f715ef6a531f63c40ac3f629dd9cfea7e867507a/app/TopCommand/Options.hs#L33 ## New dependencies This PR adds new dependencies on `temporary` and `polysemy-zoo`. `temporary` is used for `emptySystemTempFile` in the implementation of the TempFile interpreter for IO: https://github.com/anoma/juvix/blob/73952ba15c90f33919c75426cf62ae7e83fd3225/src/Juvix/Data/Effect/Files/IO.hs#L49 `polysemy-zoo` is used for the `Fresh` effect and `absorbMonadThrow` in the implementation of the pure TempFile interpreter: https://github.com/anoma/juvix/blob/73952ba15c90f33919c75426cf62ae7e83fd3225/src/Juvix/Data/Effect/Files/Pure.hs#L91 NB: The pure TempFile interpreter is not used, but it seemed a good idea to include it while it's fresh in my mind. * Closes https://github.com/anoma/juvix/issues/1777 --------- Co-authored-by: Jonathan Cubides <jonathan.cubides@uib.no>
2023-03-29 16:51:04 +03:00
askGenericOptions :: (Members '[App] r) => Sem r GenericOptions
2022-09-14 17:16:15 +03:00
askGenericOptions = project <$> askGlobalOptions
getEntryPoint :: (Members '[Embed IO, App, TaggedLock] r) => AppPath File -> Sem r EntryPoint
2022-09-14 17:16:15 +03:00
getEntryPoint inputFile = do
_runAppIOArgsGlobalOptions <- askGlobalOptions
_runAppIOArgsRoot <- askRoot
getEntryPoint' (RunAppIOArgs {..}) inputFile
2022-09-14 17:16:15 +03:00
getEntryPointStdin :: (Members '[Embed IO, App, TaggedLock] r) => Sem r EntryPoint
getEntryPointStdin = do
_runAppIOArgsGlobalOptions <- askGlobalOptions
_runAppIOArgsRoot <- askRoot
getEntryPointStdin' (RunAppIOArgs {..})
runPipelineTermination :: (Members '[Embed IO, App, TaggedLock] r) => AppPath File -> Sem (Termination ': PipelineEff r) a -> Sem r (PipelineResult a)
runPipelineTermination input_ p = do
r <- runPipelineEither input_ (evalTermination iniTerminationState p)
case r of
Left err -> exitJuvixError err
Right res -> return (snd res)
runPipeline :: (Members '[App, Embed IO, TaggedLock] r) => AppPath File -> Sem (PipelineEff r) a -> Sem r a
runPipeline input_ p = do
r <- runPipelineEither input_ p
case r of
Left err -> exitJuvixError err
Right res -> return (snd res ^. pipelineResult)
runPipelineHtml :: (Members '[App, Embed IO, TaggedLock] r) => Bool -> AppPath File -> Sem r (InternalTypedResult, [InternalTypedResult])
runPipelineHtml bNonRecursive input_ =
if
| bNonRecursive -> do
r <- runPipeline input_ upToInternalTyped
return (r, [])
| otherwise -> do
args <- askArgs
entry <- getEntryPoint' args input_
r <- runPipelineHtmlEither entry
case r of
Left err -> exitJuvixError err
Right res -> return res
runPipelineEntry :: (Members '[App, Embed IO, TaggedLock] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r a
runPipelineEntry entry p = do
r <- runIOEither entry p
case r of
Left err -> exitJuvixError err
Right res -> return (snd res ^. pipelineResult)
runPipelineSetup :: (Members '[App, Embed IO, TaggedLock] r) => Sem (PipelineEff' r) a -> Sem r a
runPipelineSetup p = do
r <- runPipelineSetupEither p
case r of
Left err -> exitJuvixError err
Right res -> return (snd res)
newline :: (Member App r) => Sem r ()
newline = say ""
printSuccessExit :: (Member App r) => Text -> Sem r a
printSuccessExit = exitMsg ExitSuccess
printFailureExit :: (Member App r) => Text -> Sem r a
printFailureExit = exitMsg (ExitFailure 1)
getRight :: (Members '[App] r, AppError e) => Either e a -> Sem r a
getRight = either appError return
instance AppError Text where
appError = printFailureExit
instance AppError JuvixError where
appError = exitJuvixError
class AppError e where
appError :: (Members '[App] r) => e -> Sem r a