# Algebraic Data Types (ADTs) with Aeson

As of March 2020, School of Haskell has been switched to read-only mode.

### Sections

This is tiny cheat sheet, which will help with decoding JSON data to Haskell's ADT.

``````data YesNo = Yes
| No
deriving Show``````

First of all let's think how we could express our Haskell values in JSON format? According to Aeson's documentation:

So stick to objects (e.g. maps in Haskell) or arrays (lists or vectors in Haskell):

To avoid possible decoding pitfalls we should stick with objects and arrays. Here are possible (or valid) respresentations:

``````For Yes value: { "value" : "yes" } { "value" : 1 } { "value" : 1.0 }
No value: { "value" : "no" }  { "value" : 0 } { "value" : 0.0 }``````

Let's declare `FromJSON` instance for our `YesNo` data type:

``````instance FromJSON YesNo where

-- parseJSON takes a Value, it could be one of follwing data constructors:
-- Object, Array, String, Number, Bool or Null.
-- First of all we expect an Object, it is defined as Object !Object,
-- where second Object is just a type synonym for HashMap Text Value. In
-- our case we should choose somehow our Haskell value constructor
-- according to recieved value.
-- So, `o` is actually a HashMap, and all we need is to lookup key "type"
-- We should use strict Text for key:
parseJSON (Object o) = case HML.lookup (pack "type") o of
-- value of entity has type Value
Just (String t) -> fromString (TL.unpack (TL.fromStrict t))
Just (Number n) -> fromNum n
-- Other cases are invalid
_               -> empty
where fromString :: String -> Parser YesNo
fromString "yes" = pure Yes
fromString "no"  = pure No
fromString _     = empty
fromNum n
| n == 1 || n == 1.0 = pure Yes
| n == 0 || n == 0.0 = pure No
| otherwise = empty``````

Let's also declare `ToJSON` instance for our Haskell data type:

``````instance ToJSON YesNo where
toJSON Yes = object [ "value" .= String "yes" ]
toJSON No  = object [ "value" .= String "no" ]``````

Now we can play with it and test it:

``````{-# LANGUAGE OverloadedStrings #-}

import Data.Aeson
import Data.Aeson.Types                          ( Parser )

import Data.Text                                 ( Text, pack )
import qualified Data.Text.Lazy as TL            ( fromStrict, unpack )
import qualified Data.ByteString.Lazy as BSL     ( toChunks )
import qualified Data.ByteString.Lazy.Char8 as C ( fromChunks, unpack )

import qualified Data.HashMap.Lazy as HML        ( lookup )

import Control.Applicative                       ( empty, pure )

data YesNo = Yes
| No
deriving Show

instance FromJSON YesNo where
parseJSON (Object o) = case HML.lookup "value" o of
Just (String t) -> fromString (TL.unpack (TL.fromStrict t))
Just (Number n) -> fromNum n
_               -> empty
where fromString :: String -> Parser YesNo
fromString "yes" = pure Yes
fromString "no"  = pure No
fromString _     = empty
fromNum n
| n == 1 || n == 1.0 = pure Yes
| n == 0 || n == 0.0 = pure No
| otherwise = empty

instance ToJSON YesNo where
toJSON Yes = object [ "value" .= String "yes" ]
toJSON No  = object [ "value" .= String "no" ]

-- show
main = do
let yesJ  = encode Yes
yesJS = C.unpack \$ C.fromChunks \$ BSL.toChunks yesJ
putStrLn "Encoded:"
print yesJS
putStrLn "Decoding:"
print (decode yesJ :: Maybe Value)
print (decode yesJ :: Maybe YesNo)``````

Now, let's imagine we are designing some kind of API. Assume that we store in database pairs of person's name and his/her cash amount.

``````data Command = NotCommand
| WrongArg      String
| CommandCreate { name :: Text, value :: Double }
| CommandUpdate { id   :: Int,  value :: Double }
| CommandDelete { id   :: Int }
deriving Show``````

Here are valid representations of out `Command` data type:

`Create` command example

``````{ "type" : "command",
"name" : "create",
"data" : {
"name" : "Arthur",
"value" : 100.0
}
}``````

`Update` command example

``````{ "type" : "command",
"name" : "update",
"data" : {
"id" : 1,
"value" : 90.0
}
}``````

`Delete` command example

``````{ "type" : "command",
"name" : "delete",
"data" : 1
}``````

So, we expect key `type`, which always should be `"command"`, to distinguish commands we use key `name`, and each command have third mandatory key `data`, which differs for each command.

We could declare following `FromJSON` instance for `Command`:

``````instance FromJSON Command where
-- First of all we lookup for mandatory key `type`
parseJSON (Object o) = case HML.lookup "type" o of
Just (String "command") -> let dt = HML.lookup "data" o
in case HML.lookup "name" o of
-- Then we lookup for key `name`, to distinguish commands
Just (String "create") -> createCmd dt
Just (String "update") -> updateCmd dt
Just (String "delete") -> CommandDelete <\$> o .: "data"
_                      -> unrecognizedCommand
_ -> pure NotCommand
where createCmd Nothing           = missingData
createCmd (Just (Object d)) = CommandCreate <\$> d .: "name" <*> d .: "value"
createCmd _                 = incorrectData
updateCmd Nothing           = missingData
updateCmd (Just (Object d)) = CommandUpdate <\$> d .: "id"   <*> d .: "value"
updateCmd _                 = incorrectData

missingData         = pure \$ WrongArg "Missing mandatory `data` key."
incorrectData       = pure \$ WrongArg "Incorrect data received."
unrecognizedCommand = pure \$ WrongArg "Unrecognized command name."
parseJSON _ = pure NotCommand``````

There is nothing special about `ToJSON` instance, so let's just omit its declaration and test our code!

``````{-# LANGUAGE OverloadedStrings #-}

import Data.Aeson

import Data.Text                                 ( Text, pack )
import qualified Data.Text.Lazy as TL            ( fromStrict, unpack )

import qualified Data.HashMap.Lazy as HML        ( lookup )

import Control.Applicative                       ( empty, pure, (<\$>), (<*>) )
import qualified Data.ByteString.Lazy.Char8 as BSCL

data Command = NotCommand
| WrongArg      String
| CommandCreate { name :: Text, value :: Double }
| CommandUpdate { id   :: Int,  value :: Double }
| CommandDelete { id   :: Int }
deriving Show

instance FromJSON Command where
parseJSON (Object o) = case HML.lookup "type" o of
Just (String "command") -> let dt = HML.lookup "data" o
in case HML.lookup "name" o of
Just (String "create") -> createCmd dt
Just (String "update") -> updateCmd dt
Just (String "delete") -> CommandDelete <\$> o .: "data"
_                      -> unrecognizedCommand
_ -> pure NotCommand
where createCmd Nothing           = missingData
createCmd (Just (Object d)) = CommandCreate <\$> d .: "name" <*> d .: "value"
createCmd _                 = incorrectData
updateCmd Nothing           = missingData
updateCmd (Just (Object d)) = CommandUpdate <\$> d .: "id"   <*> d .: "value"
updateCmd _                 = incorrectData

missingData         = pure \$ WrongArg "Missing mandatory `data` key."
incorrectData       = pure \$ WrongArg "Incorrect data received."
unrecognizedCommand = pure \$ WrongArg "Unrecognized command name."
parseJSON _ = pure NotCommand

instance ToJSON Command where
toJSON NotCommand = String "Not a command"
toJSON (WrongArg t) = String (pack t)
toJSON (CommandCreate n v) = object [ "type" .= String "command"
, "name" .= String "create"
, "data" .= object [ "name" .= String n
, "value" .= toJSON v
]
]
toJSON (CommandUpdate i v) = object [ "type" .= String "command"
, "name" .= String "update"
, "data" .= object [ "id" .= toJSON i
, "value" .= toJSON v
]
]
toJSON (CommandDelete i)   = object [ "type" .= String "command"
, "name" .= String "delete"
, "data" .= toJSON i
]
-- show
main = do
let c = encode \$ CommandCreate "Svetlana" 100.0
print (decode c :: Maybe Command)
print (decode "{\"type\":\"command\",\"name\":\"create\"}" :: Maybe Command)
print (decode "{\"type\":\"command\",\"name\":\" reate\",\"data\":{\"name\":\"Svetlana\",\"value\":100.0}}" :: Maybe Command)
print (decode "{\"type\":\"command\",\"name\":\"create\",\"data\":{\" ame\":\"Svetlana\",\"value\":100.0}}" :: Maybe Command)``````