dhall-text-shell (empty) → 0.1.0.0
raw patch · 6 files changed
+399/−0 lines, 6 filesdep +basedep +containersdep +dhall
Dependencies added: base, containers, dhall, dhall-text-shell, filepath, optparse-applicative, process, text
Files
- CHANGELOG.md +11/−0
- LICENSE +27/−0
- README.md +62/−0
- app/dhall-text-shell.hs +6/−0
- dhall-text-shell.cabal +69/−0
- src/Dhall/TextShell.hs +224/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+Changelog+=========++Version 0.1.0.0+---------------++*April 21, 2022*++<https://github.com/mstksg/dhall-text-shell/releases/tag/v0.1.0.0>++* Initial commit
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2022 Justin Le+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,62 @@+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+-- testfile.dhall+let text = https://raw.githubusercontent.com/dhall-lang/dhall-lang/v21.1.0/Prelude/Text/package.dhall+in \(f : Text -> Text) -> text.concatMapSep "," Text f [ "hello", "world" ]+```++Would give:++```+$ dhall-text-shell --file testfile.dhall --argCmd cat+hello,world+$ dhall-text-shell --file testfile.dhall --argCmd "tr '[:lower:]' '[:upper:]'"+HELLO,WORLD+$ dhall-text-shell --file testfile.dhall --argCmd "pandoc -f markdown -t html"+<p>hello</p>+,<p>world</p>+$ dhall-text-shell --file testfile.dhall --argCmd "md5sum -z"+5d41402abc4b2a76b9719d911017c592 -,7d793037a0760186574b0282f2f435e7 -+```++Error messages:++```+$ dhall-text-shell --file testfile.dhall+Error: Expression doesn't match annotation++- Text++ .. -> .. (a function type)+$ dhall-text-shell --file testfile.dhall --argCmd cat --argCmd cat+Error: Expression doesn't match annotation++- .. -> .. (a function type)++ Text+```++Supports multiple arguments as well:++```dhall+-- testfile2.dhall+let text = https://raw.githubusercontent.com/dhall-lang/dhall-lang/v21.1.0/Prelude/Text/package.dhall+in \(f : Text -> Text) -> \(g : Text -> Text) -> text.concatMapSep "," Text f [ "hello", g "world" ]+```++```+$ dhall-text-shell --file testfile2.dhall --argCmd cat --argCmd "tr '[:lower:]' '[:upper:]'"+hello,WORLD+```++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+program on that ffi function.++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.
+ app/dhall-text-shell.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import qualified Dhall.TextShell++main :: IO ()+main = Dhall.TextShell.main
+ dhall-text-shell.cabal view
@@ -0,0 +1,69 @@+cabal-version: 2.4+name: dhall-text-shell+version: 0.1.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` ?+ .+ 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+ program on that ffi function.+homepage: https://github.com/mstksg/dhall-text-shell+bug-reports: https://github.com/mstksg/dhall-text-shell/issues+license: MIT+license-file: LICENSE+category: Compiler+author: Justin Le+maintainer: Justin Le <justin@jle.im>+copyright: 2021 Justin Le+build-type: Simple+extra-doc-files: README.md+ CHANGELOG.md+tested-with: GHC == 8.8.3++source-repository head+ type: git+ location: https://github.com/mstksg/dhall-text-shell.git++common common-options+ build-depends: base >= 4.11.0.0 && < 5+ , containers+ , dhall+ , filepath+ , optparse-applicative+ , process+ , text++ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ if impl(ghc >= 8.0)+ ghc-options: -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.8)+ ghc-options: -Wmissing-deriving-strategies++ default-language: Haskell2010++library+ import: common-options+ hs-source-dirs: src+ exposed-modules: Dhall.TextShell++executable dhall-text-shell+ import: common-options+ hs-source-dirs: app+ main-is: dhall-text-shell.hs+ build-depends: dhall-text-shell+ ghc-options: -threaded+ -rtsopts+ -with-rtsopts=-N+
+ src/Dhall/TextShell.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}++module Dhall.TextShell (main) where++import Control.Exception (Handler (..), SomeException)+import Control.Monad (foldM)+import Control.Applicative (optional)+import Data.Text (Text)+import Data.Void (Void)+import Dhall.Core (Expr(Annot))+import Dhall.Import (SemanticCacheMode (..), Imported(..))+import Dhall.Parser (Src)+import Dhall.TypeCheck (Censored (..), DetailedTypeError (..), TypeError)+import Dhall.Util (Input (..), Output (..), Censor(..))+import Options.Applicative (Parser)+import System.Exit (ExitCode, exitFailure)+import qualified Control.Exception+import qualified Data.Map+import qualified Data.Text+import qualified Data.Text.IO+import qualified Dhall+import qualified Dhall.Core+import qualified Dhall.Import+import qualified Dhall.TypeCheck+import qualified Dhall.Util+import qualified GHC.IO.Encoding+import qualified Options.Applicative+import qualified System.FilePath+import qualified System.IO+import qualified System.Process++-- | Options from general dhall tools+data AsCommand = AsCommand+ { censor :: Censor+ , explain :: Bool+ }++-- | Options specifically for TextShell+data Options = Options+ { file :: Input+ , output :: Output+ , argCmds :: [String]+ }++-- | Parse 'Options' and 'AsCommand'+parseConfig :: Parser (Options, AsCommand)+parseConfig = (,) <$> parseOptions+ <*> parseAsCommand+ where+ switch name description =+ Options.Applicative.switch+ ( Options.Applicative.long name+ <> Options.Applicative.help description+ )+ parseOptions =+ Options <$> parseFile+ <*> parseOutput+ <*> Options.Applicative.many parseArgCmd+ parseFile = fmap f (optional p)+ where+ f Nothing = StandardInput+ f (Just file) = InputFile file++ p = Options.Applicative.strOption+ ( Options.Applicative.long "file"+ <> Options.Applicative.help "Read expression from a file instead of standard input"+ <> Options.Applicative.metavar "FILE"+ <> Options.Applicative.action "file"+ )+ parseOutput = fmap f (optional p)+ where+ f Nothing = StandardOutput+ f (Just file) = OutputFile file++ p = Options.Applicative.strOption+ ( Options.Applicative.long "output"+ <> Options.Applicative.help "Write result to a file instead of standard output"+ <> Options.Applicative.metavar "FILE"+ <> Options.Applicative.action "file"+ )+ parseArgCmd = Options.Applicative.strOption+ ( Options.Applicative.long "argCmd"+ <> Options.Applicative.help "Use shell command to supply as `Text -> Text` argument"+ <> Options.Applicative.metavar "CMD"+ <> Options.Applicative.action "CMD"+ )+ parseAsCommand =+ AsCommand <$> parseCensor+ <*> switch "explain" "Explain error messages in more detail"+ parseCensor = fmap f (switch "censor" "Hide source code in error messages")+ where+ f True = Censor+ f False = NoCensor++main :: IO ()+main = do+ (options, ac) <- Options.Applicative.execParser $+ Options.Applicative.info+ (Options.Applicative.helper <*> parseConfig)+ ( Options.Applicative.progDesc "render dhall text with shell commands as function arguments"+ <> Options.Applicative.fullDesc+ )+ runWithOptions ac options++runWithOptions :: AsCommand -> Options -> IO ()+runWithOptions ac Options{..} = asCommand ac $ \getExpression rootDirectory -> do+ expression <- getExpression file++ 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))++ 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])+ peelArg (currExp, currMap) arg = case currExp of+ Dhall.Core.Lam _ (Dhall.Core.FunctionBinding { functionBindingVariable }) subExp ->+ Just (subExp, Data.Map.insertWith (++) functionBindingVariable [arg] currMap)+ _ -> Nothing+ 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+ res <- Dhall.Core.normalizeWithM+ (\x -> case x of+ Dhall.Core.App (Dhall.Core.Var (Dhall.Core.V v i))+ (Dhall.Core.TextLit (Dhall.Core.Chunks [] txt))+ | Just as <- Data.Map.lookup v argMap+ , a:_ <- drop i as+ -> Just <$> do+ sysOut <- Data.Text.pack <$> System.Process.readCreateProcess+ (System.Process.shell a)+ (Data.Text.unpack txt)+ pure $ Dhall.Core.TextLit (Dhall.Core.Chunks [] sysOut)+ _ -> 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++ let invalidDecoderExpression :: Expr Void Void+ invalidDecoderExpression = res++ Control.Exception.throwIO (Dhall.InvalidDecoder {..})++-- | Copy as much as possible the setup in "Dhall.Main". If that module+-- changes, this should update as well.+asCommand+ :: AsCommand+ -> ((Input -> IO (Expr Src Dhall.Core.Import)) -> (Input -> FilePath) -> IO ())+ -> IO ()+asCommand AsCommand{..} act = do+ GHC.IO.Encoding.setLocaleEncoding System.IO.utf8++ let rootDirectory = \case+ InputFile f -> System.FilePath.takeDirectory f+ StandardInput -> "."++ let getExpression = Dhall.Util.getExpression censor++ let handle io =+ Control.Exception.catches io+ [ Handler handleTypeError+ , Handler handleImported+ , Handler handleExitCode+ ]+ where+ handleAll e = do+ let string = show (e :: SomeException)++ if not (null string)+ then System.IO.hPutStrLn System.IO.stderr string+ else return ()++ System.Exit.exitFailure++ handleTypeError e = Control.Exception.handle handleAll $ do+ let _ = e :: TypeError Src Void+ System.IO.hPutStrLn System.IO.stderr ""+ if explain+ then+ case censor of+ Censor -> Control.Exception.throwIO (CensoredDetailed (DetailedTypeError e))+ NoCensor -> Control.Exception.throwIO (DetailedTypeError e)++ else do+ Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"+ case censor of+ Censor -> Control.Exception.throwIO (Censored e)+ NoCensor -> Control.Exception.throwIO e++ handleImported (Imported ps e) = Control.Exception.handle handleAll $ do+ let _ = e :: TypeError Src Void+ System.IO.hPutStrLn System.IO.stderr ""+ if explain+ then Control.Exception.throwIO (Imported ps (DetailedTypeError e))+ else do+ Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"+ Control.Exception.throwIO (Imported ps e)++ handleExitCode e =+ Control.Exception.throwIO (e :: ExitCode)++ handle $ act getExpression rootDirectory+