diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,16 @@ Changelog ========= +Version 0.2.0.0 +--------------- + +*April 30, 2022* + + + +* Add `--directory-tree` to support `dhall to-directory-tree` behavior as + well. + Version 0.1.0.0 --------------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,10 @@ dhall-text-shell ================ -`dhall-text-shell` requires the expression to be `Text`. But what if it was able to -also render expressions of type `(Text -> Text) -> Text`, and be given a shell -argument as the `Text -> Text` ? +`dhall text` and `dhall to-directory-tree` require the expression (or file +leaves) to be `Text`. But what if it was able to also render expressions of +type `(Text -> Text) -> Text` (or `(Text -> Text) -> directory tree`), and be +given a shell argument as the `Text -> Text` ? ```dhall -- testfile.dhall @@ -60,3 +61,7 @@ Note that for this to work meaningfully, your shell command must be "pure": it must return the same stdout for any stdin, and shouldn't observably affect the world every time it is run. + +This also supports `dhall to-directory-tree` as well with a `--directory-tree` +flag, and in a similar fashion it takes a function `(Text -> Text) -> +(directory tree record)`, to be supplied the shell function. diff --git a/dhall-text-shell.cabal b/dhall-text-shell.cabal --- a/dhall-text-shell.cabal +++ b/dhall-text-shell.cabal @@ -1,11 +1,12 @@ cabal-version: 2.4 name: dhall-text-shell -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Render dhall text with shell commands as function arguments description: - `dhall-text-shell` requires the expression to be `Text`. But what if it was able to - also render expressions of type `(Text -> Text) -> Text`, and be given a shell - argument as the `Text -> Text` ? + `dhall text` and `dhall to-directory-tree` require the expression (or file + leaves) to be `Text`. But what if it was able to also render expressions + of type `(Text -> Text) -> Text` (or `(Text -> Text) -> directory tree`), + and be given a shell argument as the `Text -> Text` ? . This is essentially a very minimal "FFI" for dhall, since it doesn't require extending anything in the language. It just requires you to parameterize your diff --git a/src/Dhall/TextShell.hs b/src/Dhall/TextShell.hs --- a/src/Dhall/TextShell.hs +++ b/src/Dhall/TextShell.hs @@ -5,9 +5,9 @@ module Dhall.TextShell (main) where -import Control.Exception (Handler (..), SomeException) -import Control.Monad (foldM) import Control.Applicative (optional) +import Control.Exception (Handler (..), SomeException) +import Control.Monad (foldM, unless, void) import Data.Text (Text) import Data.Void (Void) import Dhall.Core (Expr(Annot)) @@ -23,6 +23,7 @@ import qualified Data.Text.IO import qualified Dhall import qualified Dhall.Core +import qualified Dhall.DirectoryTree as DirectoryTree import qualified Dhall.Import import qualified Dhall.TypeCheck import qualified Dhall.Util @@ -30,6 +31,7 @@ import qualified Options.Applicative import qualified System.FilePath import qualified System.IO +import qualified System.IO.Error import qualified System.Process -- | Options from general dhall tools @@ -42,6 +44,7 @@ data Options = Options { file :: Input , output :: Output + , asDirectoryTree :: Bool , argCmds :: [String] } @@ -58,6 +61,7 @@ parseOptions = Options <$> parseFile <*> parseOutput + <*> parseAsDirectoryTree <*> Options.Applicative.many parseArgCmd parseFile = fmap f (optional p) where @@ -81,6 +85,8 @@ <> Options.Applicative.metavar "FILE" <> Options.Applicative.action "file" ) + parseAsDirectoryTree = switch "directory-tree" + "Create a directory tree a la dhall to-directory-tree instead of a single file" parseArgCmd = Options.Applicative.strOption ( Options.Applicative.long "argCmd" <> Options.Applicative.help "Use shell command to supply as `Text -> Text` argument" @@ -112,27 +118,35 @@ resolvedExpression <- Dhall.Import.loadRelativeTo (rootDirectory file) UseSemanticCache expression - let addPiLayer :: Expr Src Void -> Expr Src Void - addPiLayer = Dhall.Core.Pi - Nothing "_" - (Dhall.Core.Pi Nothing "_" Dhall.Core.Text Dhall.Core.Text) - expectedType = iterate addPiLayer Dhall.Core.Text !! length argCmds - _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf (Annot resolvedExpression expectedType)) + case asDirectoryTree of + False -> do + let addPiLayer :: Expr Src Void -> Expr Src Void + addPiLayer = Dhall.Core.Pi + Nothing "_" + (Dhall.Core.Pi Nothing "_" Dhall.Core.Text Dhall.Core.Text) + expectedType = iterate addPiLayer Dhall.Core.Text !! length argCmds + void $ Dhall.Core.throws (Dhall.TypeCheck.typeOf (Annot resolvedExpression expectedType)) + True -> case output of + StandardOutput -> Control.Exception.throwIO $ + System.IO.Error.userError "Usage of --directory-tree requires --output to be specified" + OutputFile _ -> pure () let normalizedExpression = Dhall.Core.normalize resolvedExpression peelArg :: (Expr Void Void, Data.Map.Map Text [String]) -> String - -> Maybe (Expr Void Void, Data.Map.Map Text [String]) + -> Either (Expr Void Void) (Expr Void Void, Data.Map.Map Text [String]) peelArg (currExp, currMap) arg = case currExp of Dhall.Core.Lam _ (Dhall.Core.FunctionBinding { functionBindingVariable }) subExp -> - Just (subExp, Data.Map.insertWith (++) functionBindingVariable [arg] currMap) - _ -> Nothing + Right (subExp, Data.Map.insertWith (++) functionBindingVariable [arg] currMap) + e -> Left e peeledExprAndMap = foldM peelArg (normalizedExpression, Data.Map.empty) argCmds case peeledExprAndMap of - Nothing -> pure () -- this should have been caught during the typecheck - Just (expr, argMap) -> do + Left e + | asDirectoryTree -> Control.Exception.throwIO $ DirectoryTree.FilesystemError e + | otherwise -> pure () -- this should have been caught during the typecheck + Right (expr, argMap) -> do res <- Dhall.Core.normalizeWithM (\x -> case x of Dhall.Core.App (Dhall.Core.Var (Dhall.Core.V v i)) @@ -147,20 +161,25 @@ _ -> pure Nothing ) expr - case res of - Dhall.Core.TextLit (Dhall.Core.Chunks [] text) -> - let write = case output of - StandardOutput -> Data.Text.IO.putStr - OutputFile file_ -> Data.Text.IO.writeFile file_ - in write text - _ -> do - let invalidDecoderExpected :: Expr Void Void - invalidDecoderExpected = Dhall.Core.Text + case asDirectoryTree of + False -> case res of + Dhall.Core.TextLit (Dhall.Core.Chunks [] text) -> + let write = case output of + StandardOutput -> Data.Text.IO.putStr + OutputFile file_ -> Data.Text.IO.writeFile file_ + in write text + _ -> do + let invalidDecoderExpected :: Expr Void Void + invalidDecoderExpected = Dhall.Core.Text - let invalidDecoderExpression :: Expr Void Void - invalidDecoderExpression = res + let invalidDecoderExpression :: Expr Void Void + invalidDecoderExpression = res - Control.Exception.throwIO (Dhall.InvalidDecoder {..}) + Control.Exception.throwIO (Dhall.InvalidDecoder {..}) + True -> case output of + StandardOutput -> Control.Exception.throwIO $ + System.IO.Error.userError "Usage of --directory-tree requires --output to be specified" + OutputFile file_ -> DirectoryTree.toDirectoryTree file_ res -- | Copy as much as possible the setup in "Dhall.Main". If that module -- changes, this should update as well.