Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
A simple JSON EDSL
{- | An EDSL for defining and printing JSON values
-}
import Data.List (intercalate)
----------------
-- JSON Model --
----------------
-- | The JSONValue data type represents a JSON Value
data JSONValue
= JString String
| JNumber Double
| JBool Bool
| JNull
| JArray [JSONValue]
| JObject [NamedValue]
-- | A value with a name
data NamedValue = NamedValue String JSONValue
---------------
-- utilities --
---------------
-- Utility functions for construction a JSON (or: the API)
-- | Create a string
str_ :: String -> JSONValue
str_ = JString
-- | Create a number
num_ :: Double -> JSONValue
num_ = JNumber
-- | The value `true`
true_ :: JSONValue
true_ = JBool True
-- | The value `false`
false_ :: JSONValue
false_ = JBool False
-- | The value `null`
null_ :: JSONValue
null_ = JNull
-- | A function for creating a JS array for a list of `JSONValue`s
arr_ :: [JSONValue] -> JSONValue
arr_ = JArray
-- | A function for creating a JS object from a list of `NamedValues`s
obj_ :: [NamedValue] -> JSONValue
obj_ = JObject
-- | A utility function for field definition in an object
(.=) :: String -> JSONValue -> NamedValue
name .= value = NamedValue name value
-- this defines the associativity (in this case r - right) and the precedence (in this case, 9) of the operator .=
infixr 9 .=
---------------------------------------------
-- Generate a JSON string from a JSONValue --
---------------------------------------------
-- we are going to use the function `show` which can escape strings and convert Int to String
-- | Pretty print a JSON value
ppJSON :: JSONValue -> String
ppJSON jsval = case jsval of
JString str ->
show str
JNumber n ->
show n
JBool True ->
"true"
JBool False ->
"false"
JNull ->
"null"
JArray arr ->
"[ "
++ intercalate ", " (map ppJSON arr)
++ " ]"
JObject elems ->
"{ "
++ intercalate ", " (map ppElement elems)
++ " }"
where
-- | Pretty print a JSON object element, optionally place a comma at the end
ppElement :: NamedValue -> String
ppElement (NamedValue str jv') =
show str ++ ": " ++ ppJSON jv'
----------
-- Main --
----------
main :: IO ()
main = do
putStrLn (ppJSON links)
links =
obj_
[ "language" .= str_ "Haskell"
, "age" .= num_ 27
, "fun" .= true_
, "get_started" .= str_ "https://www.haskell-lang.org/get-started"
, "learn" .= str_ "http://haskellbook.com"
, "tools" .= obj_
[ "hoogle" .= str_ "http://hoogle.haskell.org"
, "ghcid" .= str_ "https://github.com/ndmitchell/ghcid"
, "minimal_haskell_emacs" .= str_ "https://github.com/soupi/minimal-haskell-emacs"
, "atom-haskell" .= str_ "https://atom.io/packages/atom-haskell"
, "vscode_haskero" .= str_ "https://marketplace.visualstudio.com/items?itemName=Vans.haskero"
]
, "libraries" .= arr_
[ str_ "http://haskellisseasy.com/"
, str_ "https://hackage.haskell.org/"
, str_ "https://stackage.org/"
]
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment