Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
#!/usr/bin/env stack
{- stack
--resolver lts-13.4
--install-ghc
script
--ghc-options "-Wall"
--package aeson
--package aeson-pretty
--package aeson-typescript
--package base
--package bytestring
--package doctest
-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
import Data.Aeson.TH (deriveJSON, defaultOptions)
import Data.Aeson.TypeScript.TH (deriveTypeScript)
import Test.DocTest (doctest)
-- $setup
-- >>> import Data.Aeson.Encode.Pretty (encodePretty)
-- >>> import Data.Aeson.TypeScript.TH (formatTSDeclarations, getTypeScriptDeclarations)
-- >>> import qualified Data.ByteString.Lazy.Char8 as LB8
-- >>> import Data.Proxy (Proxy(..))
data Circle = Circle
{ _circleRadius :: Int
}
$(deriveJSON defaultOptions ''Circle)
$(deriveTypeScript defaultOptions ''Circle)
data Shape
= ShapeCircle Circle
| ShapeRectangle Int Int
$(deriveJSON defaultOptions ''Shape)
$(deriveTypeScript defaultOptions ''Shape)
data Canvas = Canvas
{ _canvasAvailableShapes :: [Shape]
, _canvasSelectedShape :: Maybe Shape
, _canvasNewShape :: Either String Shape
}
$(deriveJSON defaultOptions ''Canvas)
$(deriveTypeScript defaultOptions ''Canvas)
-- |
-- >>> LB8.putStrLn $ encodePretty $ ShapeCircle $ Circle { _circleRadius = 42 }
-- {
-- "tag": "ShapeCircle",
-- "contents": {
-- "_circleRadius": 42
-- }
-- }
--
--
-- >>> LB8.putStrLn $ encodePretty $ ShapeRectangle 20 30
-- {
-- "tag": "ShapeRectangle",
-- "contents": [
-- 20,
-- 30
-- ]
-- }
--
--
-- >>> putStrLn $ formatTSDeclarations $ getTypeScriptDeclarations (Proxy :: Proxy Shape)
-- type Shape = IShapeCircle | IShapeRectangle;
-- <BLANKLINE>
-- interface IShapeCircle {
-- tag: "ShapeCircle";
-- contents: Circle;
-- }
-- <BLANKLINE>
-- interface IShapeRectangle {
-- tag: "ShapeRectangle";
-- contents: [number, number];
-- }
--
-- >>> :{
-- LB8.putStrLn $ encodePretty $ Canvas
-- { _canvasAvailableShapes = []
-- , _canvasSelectedShape = Nothing
-- , _canvasNewShape = Left "missing rectangle length"
-- }
-- :}
-- {
-- "_canvasNewShape": {
-- "Left": "missing rectangle length"
-- },
-- "_canvasAvailableShapes": [],
-- "_canvasSelectedShape": null
-- }
--
-- >>> putStrLn $ formatTSDeclarations $ getTypeScriptDeclarations (Proxy :: Proxy Canvas)
-- type Canvas = ICanvas;
-- <BLANKLINE>
-- interface ICanvas {
-- _canvasAvailableShapes: Shape[];
-- _canvasSelectedShape?: Shape;
-- _canvasNewShape: Either<string, Shape>;
-- }
main :: IO ()
main = doctest ["-isrc", "HaskellJsonTypeScript.hs"]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.