Created
March 25, 2019 05:32
-
-
Save soraismus/bfa243ddb797c6c3d4387d8c1bf072c7 to your computer and use it in GitHub Desktop.
Attempt to generalize or expand upon generic decoding of json
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
module FlexDecode.Class | |
( class FlexDecodeJson | |
, class FlexGDecodeJson | |
, flexDecodeJson | |
, flexGDecodeJson | |
) where | |
import Prelude | |
import Data.Argonaut.Core (Json, toObject) | |
import Data.Argonaut.Decode (class DecodeJson, decodeJson) | |
import Data.Either (Either(Left, Right)) | |
import Data.Maybe (Maybe(Just, Nothing)) | |
import Data.Symbol (class IsSymbol, SProxy(SProxy), reflectSymbol) | |
import Foreign.Object as FO | |
import Prim.Row as Row | |
import Prim.RowList as RL | |
import Record as Record | |
import Type.Data.RowList (RLProxy(RLProxy)) | |
import Type.Proxy (Proxy(Proxy)) | |
import Type.Row as R | |
class FlexGDecodeJson (row :: # Type) (list :: RL.RowList) | list -> row where | |
flexGDecodeJson :: FO.Object Json -> RLProxy list -> Either String (Record row) | |
instance flexGDecodeJsonCons | |
:: ( DecodeJson value | |
, FlexGDecodeJson rowTail tail | |
, IsSymbol field | |
, Row.Cons field (Maybe value) rowTail row | |
, Row.Lacks field rowTail | |
) | |
=> FlexGDecodeJson row (RL.Cons field (Maybe value) tail) where | |
flexGDecodeJson object _ = do | |
let sProxy = SProxy :: SProxy field | |
let fieldName = reflectSymbol sProxy | |
rest <- flexGDecodeJson object (RLProxy :: RLProxy tail) | |
case FO.lookup fieldName object of | |
Just jsonVal -> do | |
val <- decodeJson jsonVal | |
Right $ Record.insert sProxy (Just val) rest | |
Nothing -> | |
Right $ Record.insert sProxy Nothing rest | |
instance flexGDecodeJsonNil :: FlexGDecodeJson () RL.Nil where | |
flexGDecodeJson _ _ = Right {} | |
class FlexDecodeJson a where | |
flexDecodeJson :: Json -> Either String a | |
instance flexDecodeJsonRecord | |
:: ( FlexGDecodeJson row list | |
, RL.RowToList row list | |
) | |
=> FlexDecodeJson (Record row) where | |
flexDecodeJson json = | |
case toObject json of | |
Just object -> flexGDecodeJson object (RLProxy :: RLProxy list) | |
Nothing -> Left "Could not convert JSON to object" | |
decodeJsonLeniently | |
:: forall list0 list1 row0 row1 row2 | |
. R.RowToList row0 list0 | |
=> R.RowToList row1 list1 | |
=> R.Union row0 row1 row2 | |
=> GDecodeJson row0 list0 | |
=> FlexGDecodeJson row1 list1 | |
-> RProxy row1 | |
-> Json | |
-> Either String (Record row2) | |
decodeJsonLeniently _ json = | |
case toObject json of | |
Nothing -> Left "Could not convert JSON to object" | |
Just object -> | |
Right | |
$ Record.merge | |
(gDecodeJson object (RLProxy :: RLProxy list0)) | |
(flexGDecodeJson object (RLProxy :: RLProxy list1)) | |
class MatchCases | |
(rl :: R.RowList) | |
(rw :: # Type) | |
| rl -> rw | |
instance matchCasesCons | |
:: ( MatchCases rl rw' | |
, R.Cons sym a rw' rw | |
, TypeEquals k (Json -> Either String a) | |
) | |
=> MatchCases (R.Cons sym k rl) rw | |
instance matchCasesNil | |
:: MatchCases R.Nil () b | |
class OnMatch (l :: R.RowList) (r0 :: # Type) (r1 :: # Type) | r1 -> r0 l where | |
onMatch :: RLProxy l -> Record r0 -> FO.Object Json -> Either String (Record r1) | |
instance onMatch_nil :: OnMatch RL.Nil () () where | |
onMatch _ _ _ = Right {} | |
instance onMatch_cons | |
:: ( R.RowToList row list | |
, MatchCases list decoderRow | |
, R.RowToList decoderRow decoderList | |
, RL.Cons field value list' list | |
, RL.Cons field decoderValue decoderList' decoderList | |
, IsSymbol field | |
, OnMatch decoderList' decoderRow list' | |
) | |
=> OnMatch (RL.Cons field decoderValue decoderList') decoderRow row | |
where | |
onMatch _ decoderRecord object = do | |
let | |
sProxy = SProxy :: SProxy field | |
fieldName = reflectSymbol sProxy | |
decoder = Record.get sProxy decoderRecord | |
rest <- onMatch (RLProxy :: RLProxy decoderList') decoderRecord object | |
case FO.lookup fieldName object of | |
Just jsonVal -> | |
val <- decoder jsonVal | |
Right $ Record.insert sProxy val rest | |
Nothing -> | |
Left $ "JSON was missing expected field: " <> fieldName | |
decodeWith | |
:: forall decoderRow decoderList list0 list1 row0 row1 row2 | |
. R.RowToList row0 list0 | |
=> R.RowToList decoderRow decoderList | |
-- => MatchCases list0 decoderRow | |
=> R.Union row0 row1 row2 | |
=> R.RowToList row1 list1 | |
=> GDecodeJson row1 list1 | |
=> OnMatch decoderList decoderRow row0 | |
=> Record decoderRow | |
-> Json | |
-> Either String (Record row2) | |
decodeWith decoderRecord = case toObject _ of | |
Just object -> Right $ _decodeWith decoderRecord object | |
Nothing -> Left "Could not convert JSON to object" | |
_decodeWith | |
:: forall decoderRow decoderList list0 list1 row0 row1 row2 | |
. R.RowToList row0 list0 | |
=> R.RowToList decoderRow decoderList | |
-- => MatchCases list0 decoderRow | |
=> R.Union row0 row1 row2 | |
=> R.RowToList row1 list1 | |
=> GDecodeJson row1 list1 | |
=> OnMatch decoderList decoderRow row0 | |
=> Record decoderRow | |
-> FO.Object Json | |
-> Either String (Record row2) | |
_decodeWith decoderRecord object = Record.merge record0 record1 | |
where | |
record0 :: Record row0 | |
record1 = onMatch (RLProxy :: RLProxy decoderList) decoderRecord object | |
record1 :: Record row1 | |
record1 = gDecodeJson object (RLProxy :: RLProxy list1) | |
-- =========================================================================== | |
class MatchCasesLeniently | |
(rl :: R.RowList) | |
(rw :: # Type) | |
| rl -> rw | |
instance matchCasesLenientlyCons | |
:: ( MatchCases rl rw' | |
, R.Cons sym (Maybe a) rw' rw | |
, TypeEquals k (Json -> Either String (Maybe a)) | |
) | |
=> MatchCasesLeniently (R.Cons sym k rl) rw | |
instance matchCasesLenientlyNil | |
:: MatchCases R.Nil () b | |
class OnLenientMatch (l :: R.RowList) (r0 :: # Type) (r1 :: # Type) | r1 -> r0 l where | |
onLenientMatch :: RLProxy l -> Record r0 -> FO.Object Json -> Either String (Record r1) | |
instance onLenientMatch_nil :: OnLenientMatch RL.Nil () () where | |
onLenientMatch _ _ _ = Right {} | |
instance onLenientMatch_cons | |
:: ( R.RowToList row list | |
, MatchCases list decoderRow | |
, R.RowToList decoderRow decoderList | |
, RL.Cons field (Maybe value) list' list | |
, RL.Cons field decoderValue decoderList' decoderList | |
, IsSymbol field | |
, OnLenientMatch decoderList' decoderRow list' | |
) | |
=> OnLenientMatch (RL.Cons field decoderValue decoderList') decoderRow row | |
where | |
onLenientMatch _ decoderRecord object = do | |
let | |
sProxy = SProxy :: SProxy field | |
fieldName = reflectSymbol sProxy | |
decoder = Record.get sProxy decoderRecord | |
rest <- onLenientMatch (RLProxy :: RLProxy decoderList') decoderRecord object | |
case FO.lookup fieldName object of | |
Just jsonVal -> | |
val <- decoder jsonVal | |
Right $ Record.insert sProxy val rest | |
Nothing -> | |
Right $ Record.insert sProxy Nothing rest | |
decodeLenientlyWith | |
:: forall decoderRow decoderList list0 list1 row0 row1 row2 | |
. R.RowToList row0 list0 | |
=> R.RowToList decoderRow decoderList | |
-- => MatchCasesLeniently list0 decoderRow | |
=> R.Union row0 row1 row2 | |
=> R.RowToList row1 list1 | |
=> GDecodeJson row1 list1 | |
=> OnMatch decoderList decoderRow row0 | |
=> Record decoderRow | |
-> Json | |
-> Either String (Record row2) | |
decodeLenientlyWith decoderRecord = case toObject _ of | |
Just object -> Right $ _decodeLenientlyWith decoderRecord object | |
Nothing -> Left "Could not convert JSON to object" | |
_decodeLenientlyWith | |
:: forall decoderRow decoderList list0 list1 row0 row1 row2 | |
. R.RowToList row0 list0 | |
=> R.RowToList decoderRow decoderList | |
-- => MatchCasesLeniently list0 decoderRow | |
=> R.Union row0 row1 row2 | |
=> R.RowToList row1 list1 | |
=> GDecodeJson row1 list1 | |
=> OnMatch decoderList decoderRow row0 | |
=> Record decoderRow | |
-> FO.Object Json | |
-> Either String (Record row2) | |
_decodeLenientlyWith decoderRecord object = Record.merge record0 record1 | |
where | |
record0 :: Record row0 | |
record1 = onLenientMatch (RLProxy :: RLProxy decoderList) decoderRecord object | |
record1 :: Record row1 | |
record1 = gDecodeJson object (RLProxy :: RLProxy list1) |
Author
soraismus
commented
Mar 29, 2019
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment