Created
February 20, 2019 23:07
-
-
Save nicolashery/426c84b572511e51b4c971b872c21db7 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/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