servant-dhall (empty) → 0.1
raw patch · 5 files changed
+260/−0 lines, 5 filesdep +basedep +base-compatdep +bytestringsetup-changed
Dependencies added: base, base-compat, bytestring, dhall, formatting, http-media, megaparsec, prettyprinter, servant, servant-dhall, servant-server, text, wai, warp
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- example/Main.hs +37/−0
- servant-dhall.cabal +63/−0
- src/Servant/Dhall.hs +128/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Servant Contributors++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 Julian K. Arni 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Main.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+module Main (main) where++import Prelude ()+import Prelude.Compat++import Data.Maybe (fromMaybe)+import Network.Wai (Application)+import Servant+import Servant.Dhall+import System.Environment (getArgs, lookupEnv)+import Text.Read (readMaybe)++import qualified Network.Wai.Handler.Warp as Warp++type API = "post" :> ReqBody '[DHALL] [Integer] :> Post '[DHALL] [Integer]+ :<|> "get" :> Get '[DHALL] [Integer]++api :: Proxy API+api = Proxy++server :: Server API+server = pure . map (+1) :<|> pure [1..10]++app :: Application+app = serve api server++main :: IO ()+main = do+ args <- getArgs+ case args of+ ("run":_) -> do+ port <- fromMaybe 8000 . (>>= readMaybe) <$> lookupEnv "PORT"+ Warp.run port app+ _ -> putStrLn "To run, pass run argument"
+ servant-dhall.cabal view
@@ -0,0 +1,63 @@+name: servant-dhall+version: 0.1+synopsis: Servant Dhall content-type+description:+ Servant Dhall bindings.+ . + Provides @MineRender@ and @MimeUnrender@ instances.+ So you can accept and return Dhall expressions.+ .+ /Note:/ Reading (and evaluating) Dhall expressions from untrust4ed source is a security risk.+homepage: http://haskell-servant.readthedocs.org/+license: BSD3+license-file: LICENSE+author: Servant Contributors+maintainer: haskell-servant-maintainers@googlegroups.com+copyright: 2015-2016 Servant Contributors+category: Web, Servant, Dhall+build-type: Simple+cabal-version: >=1.10+bug-reports: http://github.com/haskell-servant/servant-dhall/issues+tested-with:+ GHC==8.0.2,+ GHC==8.2.2,+ GHC==8.4.3++source-repository head+ type: git+ location: http://github.com/haskell-servant/servant-dhall.git++library+ exposed-modules: Servant.Dhall+ build-depends: base >=4.9 && <4.12+ , base-compat >=0.10.1 && <0.11+ , bytestring >=0.10.4.0 && <0.11+ , dhall >=1.14.0 && <1.15+ , formatting >=6.3.4 && <6.4+ , megaparsec >=6.5.0 && <6.6+ , prettyprinter >=1.2.0.1 && <1.3+ , servant >=0.13 && <0.14+ , text >=1.2.3.0 && <1.3+ , http-media+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++test-suite example+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs:+ example+ ghc-options: -Wall+ build-depends:+ base+ , base-compat+ , bytestring+ , dhall+ , http-media+ , servant+ , servant-dhall+ , servant-server >=0.12 && <0.15+ , wai >=3.0.3.0 && <3.3+ , warp >=3.0.13.1 && <3.3+ default-language: Haskell2010
+ src/Servant/Dhall.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | A @DHALL@ empty datatype with `MimeRender` and `MimeUnrender` instances for+-- /Dhall/'s 'Interpret' and 'Inject' classes.+--+-- >>> type Eg = Get '[DHALL] Integer+--+-- /Note:/ reading and executing Dhall expressions from untrusted source is+-- a security risk.+--+module Servant.Dhall (+ DHALL,+ DHALL',+ HasInterpretOptions,+ DefaultInterpretOptions,+ ) where++import Prelude ()+import Prelude.Compat++import Control.Monad+ (unless)+import Data.Proxy+ (Proxy (..))+import Data.Text.Encoding.Error+ (lenientDecode)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB+import qualified Data.Text.Lazy.Encoding as TLE+import Data.Text.Prettyprint.Doc+ (defaultLayoutOptions, layoutPretty, layoutSmart, line)+import Data.Text.Prettyprint.Doc.Render.String+ (renderString)+import Data.Text.Prettyprint.Doc.Render.Text+ (renderLazy)+import Data.Traversable+ (for)+import Data.Typeable+ (Typeable)+import Dhall+ (Inject (..), InputType (..), Interpret (..),+ InterpretOptions, Type (..), defaultInterpretOptions)+import qualified Dhall.Core+import Dhall.Parser+ (exprFromText, unwrap)+import Dhall.Pretty+ (prettyExpr)+import qualified Dhall.TypeCheck+import Formatting.Buildable+ (Buildable (..))+import qualified Network.HTTP.Media as M+import Servant.API+ (Accept (..), MimeRender (..), MimeUnrender (..))+import qualified Text.Megaparsec as MP++type DHALL = DHALL' DefaultInterpretOptions+data DHALL' opt deriving (Typeable)++instance Accept (DHALL' opts) where+ contentType _ = "application" M.// "x-dhall"++-------------------------------------------------------------------------------+-- Encoding+-------------------------------------------------------------------------------++instance (Inject a, HasInterpretOptions opts) => MimeRender (DHALL' opts) a where+ mimeRender _ x+ = TLE.encodeUtf8+ $ renderLazy+ $ layoutSmart defaultLayoutOptions+ $ (`mappend` line)+ $ prettyExpr+ $ embed ty x+ where+ ty :: InputType a+ ty = injectWith (interpretOptions (Proxy :: Proxy opts))++-------------------------------------------------------------------------------+-- Decoding+-------------------------------------------------------------------------------++instance (Interpret a, HasInterpretOptions opts) => MimeUnrender (DHALL' opts) a where+ mimeUnrender _ lbs = do+ expr0 <- firstEither showParseError $ exprFromText "(input)" te+ expr1 <- for expr0 $ \i -> Left $ "Import found: " ++ fromBuildable i+ tyExpr <- firstEither showTypeError $ Dhall.TypeCheck.typeOf expr1+ unless (Dhall.Core.judgmentallyEqual tyExpr $ expected ty) $+ Left $ "Expected and actual types don't match : "+ ++ ppExpr (expected ty) ++ " /= " ++ ppExpr tyExpr+ case extract ty (Dhall.Core.normalizeWith (const Nothing) expr1) of+ Just x -> Right x+ Nothing -> Left "Invalid type"+ where+ showParseError = MP.parseErrorPretty . unwrap+ showTypeError e = "Type error: " ++ fromBuildable e++ te = TLE.decodeUtf8With lenientDecode lbs++ ty :: Type a+ ty = autoWith (interpretOptions (Proxy :: Proxy opts))++ ppExpr = renderString . layoutPretty defaultLayoutOptions . prettyExpr++ fromBuildable :: Buildable b => b -> String+ fromBuildable = TL.unpack . TLB.toLazyText . build++firstEither :: (a -> b) -> Either a c -> Either b c+firstEither f (Left a) = Left (f a)+firstEither _ (Right c) = Right c++-------------------------------------------------------------------------------+-- Options+-------------------------------------------------------------------------------++class HasInterpretOptions opts where+ interpretOptions :: Proxy opts -> InterpretOptions++-- | 'defaultInterpretOptions'+data DefaultInterpretOptions deriving (Typeable)++instance HasInterpretOptions DefaultInterpretOptions where+ interpretOptions _ = defaultInterpretOptions