HaskellJsonTypescript.hs

#!/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"]