packages feed

dhall-text-shell 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+67/−32 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -1,6 +1,16 @@ Changelog ========= +Version 0.2.0.0+---------------++*April 30, 2022*++<https://github.com/mstksg/dhall-text-shell/releases/tag/v0.2.0.0>++*   Add `--directory-tree` to support `dhall to-directory-tree` behavior as+    well.+ Version 0.1.0.0 --------------- 
README.md view
@@ -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.
dhall-text-shell.cabal view
@@ -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
src/Dhall/TextShell.hs view
@@ -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.