diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,24 @@ +Copyright (c) 2017 Gabriel Gonzalez +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * 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. + * Neither the name of Gabriel Gonzalez nor the names of other 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 OWNER 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/dhall-json.cabal b/dhall-json.cabal new file mode 100644 --- /dev/null +++ b/dhall-json.cabal @@ -0,0 +1,67 @@ +Name: dhall-json +Version: 1.0.0 +Cabal-Version: >=1.8.0.2 +Build-Type: Simple +Tested-With: GHC == 7.10.2, GHC == 8.0.1 +License: BSD3 +License-File: LICENSE +Copyright: 2017 Gabriel Gonzalez +Author: Gabriel Gonzalez +Maintainer: Gabriel439@gmail.com +Bug-Reports: https://github.com/Gabriel439/Haskell-Dhall-JSON-Library/issues +Synopsis: Compile Dhall to JSON or YAML +Description: + Use this package if you want to compile Dhall expressions to JSON or YAML. + You can use this package as a library or an executable: + . + * See the "Dhall.JSON" module if you want to use this package as a library + . + * Use the @dhall-to-json@ or @dhall-to-yaml@ programs from this package if + you want an executable + . + The "Dhall.JSON" module also contains instructions for how to use this + package +Category: Compiler +Source-Repository head + Type: git + Location: https://github.com/Gabriel439/Haskell-Dhall-JSON-Library + +Library + Hs-Source-Dirs: src + Build-Depends: + base >= 4.8.0.0 && < 5 , + aeson >= 1.0.0.0 && < 1.2, + dhall >= 1.0.1 && < 1.2, + neat-interpolation < 0.4, + text >= 0.11.1.0 && < 1.3, + vector + Exposed-Modules: Dhall.JSON + GHC-Options: -Wall + +Executable dhall-to-json + Hs-Source-Dirs: dhall-to-json + Main-Is: Main.hs + Build-Depends: + base >= 4.8.0.0 && < 5 , + aeson >= 1.0.0.0 && < 1.2 , + bytestring < 0.11, + dhall >= 1.0.1 && < 1.2 , + dhall-json , + optparse-generic >= 1.1.1 && < 1.2 , + trifecta >= 1.6 && < 1.7 , + text >= 0.11.1.0 && < 1.3 + GHC-Options: -Wall + +Executable dhall-to-yaml + Hs-Source-Dirs: dhall-to-yaml + Main-Is: Main.hs + Build-Depends: + base >= 4.8.0.0 && < 5 , + bytestring < 0.11, + dhall >= 1.0.1 && < 1.2 , + dhall-json , + optparse-generic >= 1.1.1 && < 1.2 , + trifecta >= 1.6 && < 1.7 , + yaml >= 0.5.0 && < 0.9 , + text >= 0.11.1.0 && < 1.3 + GHC-Options: -Wall diff --git a/dhall-to-json/Main.hs b/dhall-to-json/Main.hs new file mode 100644 --- /dev/null +++ b/dhall-to-json/Main.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} + +module Main where + +import Control.Exception (SomeException) +import Options.Generic (Generic, ParseRecord, type ()) +import Text.Trifecta.Delta (Delta(..)) + +import qualified Control.Exception +import qualified Data.Aeson +import qualified Data.ByteString.Lazy +import qualified Data.Text.Lazy.IO +import qualified Dhall +import qualified Dhall.Import +import qualified Dhall.JSON +import qualified Dhall.Parser +import qualified Dhall.TypeCheck +import qualified GHC.IO.Encoding +import qualified Options.Generic +import qualified System.Exit +import qualified System.IO + +newtype Options = Options + { explain :: Bool "Explain error messages in detail" + } deriving (Generic, ParseRecord) + +main :: IO () +main = handle (do + GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 + Options {..} <- Options.Generic.getRecord "Compile Dhall to JSON" + + (if Options.Generic.unHelpful explain then Dhall.detailed else id) (do + inText <- Data.Text.Lazy.IO.getContents + + expr <- case Dhall.Parser.exprFromText (Directed "(stdin)" 0 0 0 0) inText of + Left err -> Control.Exception.throwIO err + Right expr -> return expr + + expr' <- Dhall.Import.load expr + case Dhall.TypeCheck.typeOf expr' of + Left err -> Control.Exception.throwIO err + Right _ -> return () + + json <- case Dhall.JSON.dhallToJSON expr' of + Left err -> Control.Exception.throwIO err + Right json -> return json + Data.ByteString.Lazy.putStr (Data.Aeson.encode json) )) + +handle :: IO a -> IO a +handle = Control.Exception.handle handler + where + handler :: SomeException -> IO a + handler e = do + System.IO.hPutStrLn System.IO.stderr "" + System.IO.hPrint System.IO.stderr e + System.Exit.exitFailure diff --git a/dhall-to-yaml/Main.hs b/dhall-to-yaml/Main.hs new file mode 100644 --- /dev/null +++ b/dhall-to-yaml/Main.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} + +module Main where + +import Control.Exception (SomeException) +import Options.Generic (Generic, ParseRecord, type ()) +import Text.Trifecta.Delta (Delta(..)) + +import qualified Control.Exception +import qualified Data.ByteString +import qualified Data.Text.Lazy.IO +import qualified Data.Yaml +import qualified Dhall +import qualified Dhall.Import +import qualified Dhall.JSON +import qualified Dhall.Parser +import qualified Dhall.TypeCheck +import qualified GHC.IO.Encoding +import qualified Options.Generic +import qualified System.Exit +import qualified System.IO + +newtype Options = Options + { explain :: Bool "Explain error messages in detail" + } deriving (Generic, ParseRecord) + +main :: IO () +main = handle (do + GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 + Options {..} <- Options.Generic.getRecord "Compile Dhall to JSON" + + (if Options.Generic.unHelpful explain then Dhall.detailed else id) (do + inText <- Data.Text.Lazy.IO.getContents + + expr <- case Dhall.Parser.exprFromText (Directed "(stdin)" 0 0 0 0) inText of + Left err -> Control.Exception.throwIO err + Right expr -> return expr + + expr' <- Dhall.Import.load expr + case Dhall.TypeCheck.typeOf expr' of + Left err -> Control.Exception.throwIO err + Right _ -> return () + + json <- case Dhall.JSON.dhallToJSON expr' of + Left err -> Control.Exception.throwIO err + Right json -> return json + Data.ByteString.putStr (Data.Yaml.encode json) )) + +handle :: IO a -> IO a +handle = Control.Exception.handle handler + where + handler :: SomeException -> IO a + handler e = do + System.IO.hPutStrLn System.IO.stderr "" + System.IO.hPrint System.IO.stderr e + System.Exit.exitFailure diff --git a/src/Dhall/JSON.hs b/src/Dhall/JSON.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/JSON.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +{-| This library only exports a single `dhallToJSON` function for translating a + Dhall syntax tree to a JSON syntax tree (i.e. a `Value`) for the @aeson@ + library + + NOTE: The @yaml@ library uses the same `Value` type to represent YAML + files, so you can use this to convert Dhall expressions to YAML, too + + See the @dhall@ package if you would like to transform Dhall source code + into a Dhall syntax tree. Similarly, see the @aeson@ package if you would + like to translate a JSON syntax tree into JSON. + + This package also provides @dhall-to-json@ and @dhall-to-yaml@ executables + which you can use to compile Dhall source code directly to JSON or YAML for + your convenience + + Not all Dhall expressions can be converted to JSON since JSON is not a + programming language. The only things you can convert are: + + * @Bool@s + * @Natural@s + * @Integer@s + * @Double@s + * @Text@ + * @List@s + * @Optional@ values + * records + + Dhall @Bool@s translate to JSON bools: + +> $ dhall-to-json <<< 'True' +> true +> $ dhall-to-json <<< 'False' +> false + + Dhall numbers translate to JSON numbers: + +> $ dhall-to-json <<< '+2' +> 2 +> $ dhall-to-json <<< '2' +> 2 +> $ dhall-to-json <<< '2.3' +> 2.3 + + Dhall @Text@ translates to JSON text: + +> $ dhall-to-json <<< '"ABC"' +> "ABC" + + Dhall @List@s translate to JSON lists: + +> $ dhall-to-json <<< '[1, 2, 3] : List Integer' +> [1,2,3] + + Dhall @Optional@ values translate to @null@ if absent and the unwrapped + value otherwise: + +> $ dhall-to-json <<< '[] : Optional Integer' +> null +> $ dhall-to-json <<< '[1] : Optional Integer' +> 1 + + Dhall records translate to JSON records: + +> $ dhall-to-json <<< '{ foo = 1, bar = True }' +> {"foo":1,"bar":true} + + Note that you cannot convert Dhall unions since JSON does not support sum + types. You will need to convert your unions to use the above types within + Dhall before translating to JSON + + Also, all Dhall expressions are normalized before translation to JSON: + +> $ dhall-to-json <<< "True == False" +> false + +-} + +module Dhall.JSON ( + -- * Dhall to JSON + dhallToJSON + + -- * Exceptions + , CompileError(..) + ) where + +import Control.Exception (Exception) +import Data.Aeson (Value) +import Data.Typeable (Typeable) +import Dhall.Core (Expr) +import Dhall.TypeCheck (X) + +import qualified Data.Aeson +import qualified Data.Text +import qualified Data.Text.Lazy +import qualified Data.Text.Lazy.Builder +import qualified Data.Vector +import qualified Dhall.Core +import qualified NeatInterpolation + +{-| This is the exception type for errors that might arise when translating + Dhall to JSON + + Because the majority of Dhall language features do not translate to JSON + this just returns the expression that failed +-} +data CompileError = Unsupported (Expr X X) deriving (Typeable) + +instance Show CompileError where + show (Unsupported e) = + Data.Text.unpack [NeatInterpolation.text| +$_ERROR: Cannot translate to JSON + +Explanation: Only primitive values, records, ❰List❱s, and ❰Optional❱ values can +be translated from Dhall to JSON + +The following Dhall expression could not be translated to JSON: + +↳ $txt +|] + where + txt = Data.Text.Lazy.toStrict (Dhall.Core.pretty e) + +_ERROR :: Data.Text.Text +_ERROR = "\ESC[1;31mError\ESC[0m" + +instance Exception CompileError + +{-| Convert a Dhall expression to the equivalent Nix expression + +>>> :set -XOverloadedStrings +>>> :set -XOverloadedLists +>>> import Dhall.Core +>>> dhallToJSON (RecordLit [("foo", IntegerLit 1), ("bar", TextLit "ABC")]) +Right (Object (fromList [("foo",Number 1.0),("bar",String "ABC")])) +>>> fmap Data.Aeson.encode it +Right "{\"foo\":1,\"bar\":\"ABC\"}" +-} +dhallToJSON :: Expr s X -> Either CompileError Value +dhallToJSON e0 = loop (Dhall.Core.normalize e0) + where + loop e = case e of + Dhall.Core.BoolLit a -> return (Data.Aeson.toJSON a) + Dhall.Core.NaturalLit a -> return (Data.Aeson.toJSON a) + Dhall.Core.IntegerLit a -> return (Data.Aeson.toJSON a) + Dhall.Core.DoubleLit a -> return (Data.Aeson.toJSON a) + Dhall.Core.TextLit a -> do + return (Data.Aeson.toJSON (Data.Text.Lazy.Builder.toLazyText a)) + Dhall.Core.ListLit _ a -> do + a' <- traverse loop a + return (Data.Aeson.toJSON a') + Dhall.Core.OptionalLit _ a -> + if Data.Vector.null a + then return (Data.Aeson.toJSON (Nothing :: Maybe ())) + else do + b <- dhallToJSON (Data.Vector.head a) + return (Data.Aeson.toJSON (Just b)) + Dhall.Core.RecordLit a -> do + a' <- traverse loop a + return (Data.Aeson.toJSON a') + _ -> Left (Unsupported e)