Created
December 13, 2014 20:58
-
-
Save JoeyEremondi/101ae63387c27141bd64 to your computer and use it in GitHub Desktop.
json start
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
import Json.Decode as Json | |
import Json.Encode as Encode | |
import Dict | |
{-| Given the number of constructors a type has, a constructor name string, | |
and a list of JSON values to pack, | |
pack the values into a JSON object representing an ADT, | |
using the same format as Haskell's Aeson. | |
-} | |
packContents : Int -> String -> List Json.Value -> Json.Value | |
packContents numCtors name contentList = | |
case contentList of | |
-- [] -> Json.Null TODO special case for only string | |
[item] -> let | |
dictList = [("tag", Encode.string name), ("contents", item)] | |
in Encode.object <| Dict.fromList dictList | |
_ -> | |
if (numCtors == 0) | |
then Encode.array contentList | |
else | |
let | |
dictList = [("tag", Encode.string name), ("contents", Encode.array contentList)] | |
in Encode.object <| Dict.fromList dictList | |
{-| Given the number of constructors a type has, and a JSON value, | |
get the sub-values wrapped up in that constructor, | |
assuming the values are packed using the same format as Haskell's Aeson. | |
-} | |
unpackContents : Int -> Json.Value -> List Json.Value | |
unpackContents numCtors json = case (json, numCtors) of | |
(Json.Array contents, 0) -> contents | |
--Case when there are no values, just constructor | |
(Json.String s, _) -> [] | |
(Json.Object valDict, _) -> case (Dict.get "contents" valDict) of | |
Just (Json.Array contents) -> contents | |
--any other case, means we had a single element for contents | |
Just json -> [json] | |
--_ -> Error.raise <| "No contents field of JSON " ++ (show json) | |
--_ -> Error.raise <| "No contents field of JSON. num: " ++ (show numCtors) ++ " json " ++ (show json) | |
{- | |
{-| Given FromJson instances for a comparable key type and some value type, | |
generate the conversion from a JSON object do a Dict mapping keys to values. | |
Assumes the JSON values represents a list of pairs. | |
-} | |
dictFromJson : FromJson comparable -> FromJson b -> FromJson (Dict.Dict comparable b) | |
dictFromJson keyFrom valueFrom = \(Json.Array tuples) -> | |
let unJsonTuples = map (\ (Json.Array [kj,vj]) -> (keyFrom kj, valueFrom vj)) tuples | |
in Dict.fromList unJsonTuples | |
{-| Given ToJson instances for a comparable key type and some value type, | |
generate the conversion from a Dict mapping keys to values to a JSON object. | |
Represents the Dict as a list of pairs. | |
-} | |
dictToJson : ToJson comparable -> ToJson b -> ToJson (Dict.Dict comparable b) | |
dictToJson keyTo valueTo = \dict -> | |
let | |
dictList = Dict.toList dict | |
tupleJson = map (\(k,v) -> Json.Array [keyTo k, valueTo v]) dictList | |
in Json.Array tupleJson | |
{-| From a Json Object, get a string from a field named "tag". | |
Fails using `Error.raise` if no such field exists. | |
Useful for extracting values from Haskell's Aeson instances. | |
-} | |
getTag : Json.Value -> String | |
getTag json = case json of | |
(Json.Object dict) -> case (Dict.get "tag" dict) of | |
Just (Json.String s) -> s | |
-- _ -> Error.raise <| "Couldn't get tag from JSON" ++ (show dict) | |
(Json.String s) -> s --Ctors with no contents get stored as strings | |
{-| From a Json Object, get a value from a field with the given name. | |
Fails using `Error.raise` if no such field exists. | |
Useful for extracting values from Haskell's Aeson instances. | |
-} | |
varNamed : Json.Value -> String -> Json.Value | |
varNamed (Json.Object dict) name = case (Dict.get name dict) of | |
Just j -> j | |
-} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment