Skip to content

Commit bf4f802

Browse files
gmorphemegmorpheme
authored
Feature/render json (#24)
* Add basic JSON render. * Basic tests * Add TTY to docker to support in/out usage
1 parent 2cd3773 commit bf4f802

File tree

7 files changed

+216
-27
lines changed

7 files changed

+216
-27
lines changed

‎.circleci/config.yml

+2-2
Original file line numberDiff line numberDiff line change
@@ -100,7 +100,7 @@ jobs:
100100
at: /tmp/workspace
101101
- run: docker login -u $DOCKER_USER -p $DOCKER_PASS
102102
- run:
103-
command: "docker run -v /tmp/workspace:/tmp/workspace
103+
command: "docker run -t -v /tmp/workspace:/tmp/workspace
104104
-e EXECUTABLE=/tmp/workspace/dist/x86_64-linux/Cabal-2.0.1.0/build/eu/eu
105105
curvelogic/eucalypt-test-harness:latest
106106
./eut.py "
@@ -115,7 +115,7 @@ jobs:
115115
at: /tmp/workspace
116116
- run: docker login -u $DOCKER_USER -p $DOCKER_PASS
117117
- run:
118-
command: "docker run -v /tmp/workspace:/tmp/workspace
118+
command: "docker run -t -v /tmp/workspace:/tmp/workspace
119119
-e EXECUTABLE=/tmp/workspace/dist/x86_64-linux/Cabal-2.0.1.0/build/eu/eu
120120
curvelogic/eucalypt-test-harness:latest
121121
./eut.py -b -n 25 "

‎package.yaml

+4
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ library:
1919
source-dirs: src
2020
dependencies:
2121
- aeson
22+
- aeson-pretty
2223
- bound
2324
- bytestring
2425
- comonad
@@ -79,6 +80,9 @@ tests:
7980
- -rtsopts
8081
- -with-rtsopts=-N
8182
dependencies:
83+
- aeson
84+
- aeson-pretty
85+
- bytestring
8286
- eucalypt-hs
8387
- hspec
8488
- QuickCheck

‎src/Eucalypt/Render.hs

+6-3
Original file line numberDiff line numberDiff line change
@@ -15,17 +15,20 @@ module Eucalypt.Render (configureRenderer)
1515
import Eucalypt.Driver.Options (EucalyptOptions(..))
1616
import Eucalypt.Render.Classes
1717
import qualified Eucalypt.Render.Yaml as Yaml
18+
import qualified Eucalypt.Render.Json as Json
1819

1920
-- | Tagged renderer for dispatch to the correct implementation
20-
data DispatchRenderer = YamlRenderer Yaml.YamlConfig | JsonRenderer
21+
data DispatchRenderer
22+
= YamlRenderer Yaml.YamlConfig
23+
| JsonRenderer Json.JsonConfig
2124

2225
instance Renderer DispatchRenderer where
2326
renderBytes (YamlRenderer config) expr = renderBytes config expr
24-
renderBytes JsonRenderer _ = undefined
27+
renderBytes (JsonRenderer config) expr = renderBytes config expr
2528

2629
-- | Select and configure an appropriate renderer from options
2730
configureRenderer :: EucalyptOptions -> DispatchRenderer
2831
configureRenderer opts = case optionExportFormat opts of
2932
Just "yaml" -> YamlRenderer Yaml.YamlConfig {}
30-
Just "json" -> JsonRenderer
33+
Just "json" -> JsonRenderer Json.JsonConfig { Json.jsonPretty = True }
3134
_ -> YamlRenderer Yaml.YamlConfig {}

‎src/Eucalypt/Render/Common.hs

+36
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
{-|
2+
Module : Eucalypt.Render.Common
3+
Description : Common utilities for all renderers
4+
Copyright : (c) Greg Hawkins, 2018
5+
License :
6+
Maintainer : [email protected]
7+
Stability : experimental
8+
-}
9+
module Eucalypt.Render.Common where
10+
11+
import Data.Text (Text, pack)
12+
import Eucalypt.Core.Builtin
13+
import Eucalypt.Core.Error
14+
import Eucalypt.Core.Interpreter
15+
import Eucalypt.Core.Syn
16+
17+
18+
-- | Return text if the expressio is string-like otherwise runtime error
19+
expectText :: CoreExpr -> Interpreter Text
20+
expectText e =
21+
case e of
22+
CorePrim (CoreString s) -> return $ pack s
23+
CorePrim (CoreSymbol s) -> return $ pack s
24+
_ -> throwEvalError $ LookupKeyNotStringLike (CoreExpShow e)
25+
26+
-- | Get rid of any metadata returning just the expression for the
27+
-- list item or Nothing if the metadata indicated that export should
28+
-- be suppressed.
29+
boilAwayMetadata :: WhnfEvaluator -> CoreExpr -> Interpreter (Maybe CoreExpr)
30+
boilAwayMetadata whnfM (CoreMeta m e) = do
31+
meta <- whnfM m
32+
export <- lookupOr whnfM (return (CorePrim (CoreSymbol "copy"))) meta "export"
33+
if export == CorePrim (CoreSymbol "suppress")
34+
then return Nothing
35+
else return $ Just e
36+
boilAwayMetadata _ e = return $ Just e

‎src/Eucalypt/Render/Json.hs

+93
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,93 @@
1+
{-|
2+
Module : Eucalypt.Render.Json
3+
Description : JSON renderer for Eucalypt
4+
Copyright : (c) Greg Hawkins, 2018
5+
License :
6+
Maintainer : [email protected]
7+
Stability : experimental
8+
-}
9+
module Eucalypt.Render.Json
10+
where
11+
12+
import Control.Monad ((>=>))
13+
import Data.Aeson
14+
import Data.Aeson.Encode.Pretty (encodePretty)
15+
import Data.Maybe
16+
import Data.Text (Text, pack)
17+
import Data.Scientific
18+
import qualified Data.Vector as V
19+
import qualified Data.HashMap.Strict as HM
20+
import Eucalypt.Core.Error
21+
import Eucalypt.Core.Interpreter
22+
import Eucalypt.Core.Syn
23+
import Eucalypt.Render.Classes
24+
import Eucalypt.Render.Common
25+
import qualified Data.ByteString.Lazy as BS
26+
27+
-- | Render key and value to YAML
28+
renderKeyValue :: WhnfEvaluator -> CoreExpr -> CoreExpr -> Interpreter (Maybe (Text, Value))
29+
renderKeyValue whnfM k v = do
30+
key <- (whnfM >=> expectText) k
31+
value <- whnfM v
32+
case value of
33+
CoreLambda{} -> return Nothing
34+
CoreOperator{} -> return Nothing
35+
CoreBuiltin _ -> return Nothing
36+
CorePAp {} -> return Nothing
37+
_ -> toJSONExpr whnfM value >>= \rendered -> return (Just (key, rendered))
38+
39+
40+
-- | Json rendering configuration
41+
newtype JsonConfig = JsonConfig
42+
{ jsonPretty :: Bool }
43+
44+
45+
-- | Generate an Aeson Value model of the required JSON in the
46+
-- Interpreter monad.
47+
toJSONExpr :: WhnfEvaluator -> CoreExpr -> Interpreter Value
48+
toJSONExpr _ (CorePrim p) =
49+
return $
50+
case p of
51+
CoreString s -> String $ pack s
52+
CoreSymbol s -> String $ pack s
53+
CoreInt i -> Number $ fromInteger i
54+
CoreFloat f -> Number $ fromFloatDigits f
55+
CoreBoolean b -> Bool b
56+
CoreNull -> Null
57+
toJSONExpr whnfM (CoreList items) =
58+
Array . V.fromList <$> traverse (whnfM >=> toJSONExpr whnfM) items
59+
toJSONExpr whnfM (CoreBlock list) = do
60+
content <- whnfM list
61+
case content of
62+
CoreList items -> Object . HM.fromList . catMaybes <$> traverse (whnfM >=> pair) items
63+
e -> throwEvalError $ BadBlockContent (CoreExpShow e)
64+
where
65+
pair item = do
66+
i <- boilAwayMetadata whnfM item
67+
case i of
68+
Just (CoreList [k, v]) -> renderKeyValue whnfM k v
69+
Just expr -> throwEvalError $ BadBlockElement (CoreExpShow expr)
70+
Nothing -> return Nothing
71+
toJSONExpr whnfM (CoreMeta _ v) = toJSONExpr whnfM v
72+
toJSONExpr _ expr = throwEvalError $ NotWeakHeadNormalForm (CoreExpShow expr)
73+
74+
75+
-- | Reduce and render
76+
renderJsonBytes ::
77+
JsonConfig
78+
-> WhnfEvaluator
79+
-> CoreExpr
80+
-> IO (Either EvaluationError BS.ByteString)
81+
renderJsonBytes cfg whnfM expr =
82+
case runInterpreter (whnfM expr >>= toJSONExpr whnfM) of
83+
Left e -> (return . Left) e
84+
Right j ->
85+
return $
86+
Right $
87+
if jsonPretty cfg
88+
then encodePretty j
89+
else encode j
90+
91+
92+
instance Renderer JsonConfig where
93+
renderBytes config whnfM = fmap (fmap BS.toStrict) . renderJsonBytes config whnfM

‎src/Eucalypt/Render/Yaml.hs

+1-22
Original file line numberDiff line numberDiff line change
@@ -19,22 +19,14 @@ import Data.Maybe (catMaybes)
1919
import Data.Scientific
2020
import Data.Text (Text, pack)
2121
import qualified Data.Yaml.Builder as B
22-
import Eucalypt.Core.Builtin
2322
import Eucalypt.Core.Error
2423
import Eucalypt.Core.Interpreter
2524
import Eucalypt.Core.Syn
2625
import Eucalypt.Render.Classes
26+
import Eucalypt.Render.Common
2727
import qualified Text.Libyaml as L
2828

2929

30-
-- | Return text if the expressio is string-like otherwise runtime error
31-
expectText :: CoreExpr -> Interpreter Text
32-
expectText e =
33-
case e of
34-
CorePrim (CoreString s) -> return $ pack s
35-
CorePrim (CoreSymbol s) -> return $ pack s
36-
_ -> throwEvalError $ LookupKeyNotStringLike (CoreExpShow e)
37-
3830

3931

4032

@@ -45,19 +37,6 @@ class Monad m => ToMYaml m a where
4537

4638

4739

48-
-- | Get rid of any metadata returning just the expression for the
49-
-- list item or Nothing if the metadata indicated that export should
50-
-- be suppressed.
51-
boilAwayMetadata :: WhnfEvaluator -> CoreExpr -> Interpreter (Maybe CoreExpr)
52-
boilAwayMetadata whnfM (CoreMeta m e) = do
53-
meta <- whnfM m
54-
export <- lookupOr whnfM (return (CorePrim (CoreSymbol "copy"))) meta "export"
55-
if export == CorePrim (CoreSymbol "suppress")
56-
then return Nothing
57-
else return $ Just e
58-
boilAwayMetadata _ e = return $ Just e
59-
60-
6140

6241
-- | Render key and value to YAML
6342
renderKeyValue :: WhnfEvaluator -> CoreExpr -> CoreExpr -> Interpreter (Maybe (Text, B.YamlBuilder))

‎test/Eucalypt/Render/JsonSpec.hs

+74
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
module Eucalypt.Render.JsonSpec
3+
( main
4+
, spec
5+
) where
6+
7+
import Data.Aeson
8+
import qualified Data.ByteString as BS
9+
import qualified Data.ByteString.Lazy as BL
10+
import Data.Either (fromRight)
11+
import Eucalypt.Core.Error
12+
import Eucalypt.Core.EvalByName
13+
import Eucalypt.Core.Interpreter
14+
import Eucalypt.Core.Syn
15+
import Eucalypt.Render.Classes
16+
import Eucalypt.Render.Json
17+
import Test.Hspec
18+
19+
right :: Either l r -> r
20+
right = fromRight undefined
21+
22+
main :: IO ()
23+
main = hspec spec
24+
25+
26+
coreNF1 :: CoreExp a
27+
coreNF1 =
28+
block
29+
[ element "a" $ int 1234
30+
, element "b" $ CoreList [str "x", str "y", str "z"]
31+
]
32+
33+
34+
35+
coreNF2 :: CoreExp a
36+
coreNF2 = CoreList [int 1, int 2, int 3, int 4, int 5, int 6, int 7]
37+
38+
39+
40+
_coreNF3 :: CoreExp a
41+
_coreNF3 =
42+
block
43+
[ element "a" $ int 1
44+
, element "b" $ int 2
45+
, element "c" $ int 3
46+
, element "d" $ int 4
47+
, element "e" $ int 5
48+
, element "f" $ int 6
49+
, element "g" $ int 7
50+
]
51+
52+
jsonSampleNull :: CoreExp a
53+
jsonSampleNull = block [element "a" $ bif "NULL"]
54+
55+
render :: WhnfEvaluator -> CoreExpr -> IO (Either EvaluationError BS.ByteString)
56+
render = renderBytes (JsonConfig { jsonPretty = True })
57+
58+
spec :: Spec
59+
spec =
60+
describe "JSON rendering" $ do
61+
it "Renders simple NF core block to readable JSON" $
62+
(decode . BL.fromStrict . right <$> render return coreNF1) `shouldReturn`
63+
(decode "{\"a\": 1234, \"b\": [\"x\", \"y\", \"z\"]}" :: Maybe Value)
64+
it "Renders NF core list to readable JSON" $
65+
(decode . BL.fromStrict . right <$> render return coreNF2) `shouldReturn`
66+
(decode "[1, 2, 3, 4, 5, 6, 7]" :: Maybe Value)
67+
it "Maintains key order" pending
68+
it "Forces to WHNF to render" pending
69+
it "Renders and evals { a: __NULL }" $
70+
(decode . BL.fromStrict . right <$> render whnfM jsonSampleNull) `shouldReturn`
71+
(decode "{ \"a\": null }" :: Maybe Value)
72+
it "omits builtin declarations from render" $
73+
(decode . BL.fromStrict . right <$> render whnfM (block [element "a" $ bif "OR"])) `shouldReturn`
74+
(decode "{}\n" :: Maybe Value)

0 commit comments

Comments
 (0)