Skip to content

Update codecs dependency #11

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Nov 9, 2018
Merged

Update codecs dependency #11

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions bower.json
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,12 +17,12 @@
"license": "MIT",
"dependencies": {
"purescript-argonaut-core": "^4.0.1",
"purescript-argonaut-codecs": "^4.0.1",
"purescript-argonaut-codecs": "^5.0.0",
"purescript-generics-rep": "^6.0.0",
"purescript-record": "^1.0.0"
},
"devDependencies": {
"purescript-assert": "^4.0.0",
"purescript-console": "^4.1.0"
}
}
}
71 changes: 3 additions & 68 deletions src/Data/Argonaut/Decode/Generic/Rep.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,11 +1,9 @@
module Data.Argonaut.Decode.Generic.Rep (
class DecodeRep,
class DecodeRepArgs,
class DecodeRepRowList,
class DecodeLiteral,
decodeRep,
decodeRepArgs,
decodeRepRowList,
genericDecodeJson,
decodeLiteralSum,
decodeLiteralSumWithTransform,
Expand All @@ -21,16 +19,11 @@ import Data.Array (uncons)
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Generic.Rep as Rep
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe, maybe)
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Foreign.Object as FO
import Partial.Unsafe (unsafeCrashWith)
import Prim.Row as Row
import Prim.RowList (class RowToList, Cons, Nil, kind RowList)
import Prim.TypeError (class Fail, Text)
import Record.Builder (Builder)
import Record.Builder as Builder
import Type.Data.RowList (RLProxy(..))

class DecodeRep r where
decodeRep :: Json -> Either String r
Expand Down Expand Up @@ -69,69 +62,11 @@ instance decodeRepArgsProduct :: (DecodeRepArgs a, DecodeRepArgs b) => DecodeRep
{init: b, rest: js''} <- decodeRepArgs js'
pure {init: Rep.Product a b, rest: js''}

instance decodeRepRecordArgument ::
( RowToList row rl
, DecodeRepRowList rl () row
) => DecodeRepArgs (Rep.Argument (Record row)) where
decodeRepArgs js = do
{head, tail} <- mFail "to few values were present" (uncons js)
obj <- mFail "no json object" (toObject head)
steps <- decodeRepRowList rlp obj
let arg = Rep.Argument $ Builder.build steps {}
pure {init: arg, rest: tail}
where
rlp :: RLProxy rl
rlp = RLProxy

else instance decodeRepArgsArgument :: (DecodeJson a) => DecodeRepArgs (Rep.Argument a) where
instance decodeRepArgsArgument :: (DecodeJson a) => DecodeRepArgs (Rep.Argument a) where
decodeRepArgs js = do
{head, tail} <- mFail "too few values were present" (uncons js)
{init: _, rest: tail} <<< Rep.Argument <$> decodeJson head


-- | a `DecodeRepRowList` represents a relation between a `RowList` and a record you
-- | can build from it by deserializing it's fields from a JSON `Object`
-- |
-- | this one is strictly internal to help out `decodeRepRecordArgument` handling records
-- |
-- | a `RowList` on the type level is very similar to a *cons-list* on the value level
-- | so the two instances handle all possible `RowList`s
-- |
-- | the idea is to use `Builder` to convert a `RowList` into a record at the type-level
-- | and have `decodeRepRowList` as witness on the value level that will try to decode
-- | JSON in to the resulting record value
-- |
-- | `from` and `to` are two helper types - using these `decodeRepRowListCons` can
-- | recursively create `Builder`-steps and make sure that every *symbol* in `rl`
-- | can only occur once (the fields in the records must be unique)
-- | (see `Row.Lacks`)
class DecodeRepRowList (rl :: RowList) (from :: #Type) (to :: #Type) | rl -> from to where
decodeRepRowList :: forall g . g rl -> FO.Object Json -> Either String (Builder (Record from) (Record to))

instance decodeRepRowListNil :: DecodeRepRowList Nil () () where
decodeRepRowList _ _ = pure identity

instance decodeRepRowListCons ::
( DecodeJson ty
, IsSymbol name
, DecodeRepRowList tail from from'
, Row.Lacks name from'
, Row.Cons name ty from' to
) => DecodeRepRowList (Cons name ty tail) from to where
decodeRepRowList _ obj = do
value :: ty <- (error $ FO.lookup name obj) >>= decodeJson
rest <- decodeRepRowList tailp obj
let
first :: Builder (Record from') (Record to)
first = Builder.insert namep value
pure $ first <<< rest
where
namep = SProxy :: SProxy name
tailp = RLProxy :: RLProxy tail
name = reflectSymbol namep
error Nothing = Left ("error while decoding field " <> name)
error (Just a) = Right a

-- | Decode `Json` representation of a value which has a `Generic` type.
genericDecodeJson :: forall a r. Rep.Generic a r => DecodeRep r => Json -> Either String a
genericDecodeJson = map Rep.to <<< decodeRep
Expand Down Expand Up @@ -164,7 +99,7 @@ instance decodeLiteralConstructor :: (IsSymbol name) => DecodeLiteral (Rep.Const
pure $ Rep.Constructor (Rep.NoArguments)


type FailMessage =
type FailMessage =
Text "`decodeLiteralSum` can only be used with sum types, where all of the constructors are nullary. This is because a string literal cannot be encoded into a product type."

instance decodeLiteralConstructorCannotTakeProduct
Expand Down
41 changes: 1 addition & 40 deletions src/Data/Argonaut/Encode/Generic/Rep.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,12 +2,10 @@ module Data.Argonaut.Encode.Generic.Rep (
class EncodeRep,
class EncodeRepArgs,
class EncodeRepFields,
class EncodeRepRowList,
class EncodeLiteral,
encodeRep,
encodeRepArgs,
encodeRepFields,
encodeRepRowList,
genericEncodeJson,
encodeLiteralSum,
encodeLiteralSumWithTransform,
Expand All @@ -22,11 +20,7 @@ import Data.Generic.Rep as Rep
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Foreign.Object as FO
import Partial.Unsafe (unsafeCrashWith)
import Prim.Row as Row
import Prim.RowList (class RowToList, Cons, Nil, kind RowList)
import Prim.TypeError (class Fail, Text)
import Record (get)
import Type.Data.RowList (RLProxy(..))

class EncodeRep r where
encodeRep :: r -> Json
Expand Down Expand Up @@ -54,11 +48,7 @@ instance encodeRepArgsNoArguments :: EncodeRepArgs Rep.NoArguments where
instance encodeRepArgsProduct :: (EncodeRepArgs a, EncodeRepArgs b) => EncodeRepArgs (Rep.Product a b) where
encodeRepArgs (Rep.Product a b) = encodeRepArgs a <> encodeRepArgs b

instance encodeRepRecordArgument :: (RowToList row rl, EncodeRepRowList rl row) => EncodeRepArgs (Rep.Argument (Record row)) where
encodeRepArgs (Rep.Argument rec) = [ fromObject (encodeRepRowList rlp rec FO.empty) ]
where rlp = RLProxy :: RLProxy rl

else instance encodeRepArgsArgument :: (EncodeJson a) => EncodeRepArgs (Rep.Argument a) where
instance encodeRepArgsArgument :: (EncodeJson a) => EncodeRepArgs (Rep.Argument a) where
encodeRepArgs (Rep.Argument a) = [encodeJson a]

class EncodeRepFields r where
Expand All @@ -69,35 +59,6 @@ instance encodeRepFieldsProduct :: (EncodeRepFields a, EncodeRepFields b) => Enc
FO.union (encodeRepFields a) (encodeRepFields b)


-- | a `EncodeRepRowList` represents a relation between a `RowList` and a record you
-- | can serialize into a Json `Object`
-- |
-- | this one is strictly internal to help out `encodeRepRecordArgument` handling records
-- |
-- | a `RowList` on the type level is very similar to a *cons-list* on the value level
-- | so the two instances handle all possible `RowList`s
-- |
-- | the idea is use the `Cons` cases to to compose functions that adds the field
-- | and values from the given record into a Json-`Object`
-- | the field in question is indicated by the head of the `RowList`
-- |
-- | the `Nil` case just returns `identity` to bootstrap the composition-chain
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Always good to get rid of this boilerplate

class EncodeRepRowList (rl :: RowList) (row :: #Type) | rl -> row where
encodeRepRowList :: forall g . g rl -> Record row -> (FO.Object Json -> FO.Object Json)

instance encodeRepRowListNil :: EncodeRepRowList Nil row where
encodeRepRowList _ _ = identity

instance encodeRepRowListCons :: (EncodeJson ty, IsSymbol name, EncodeRepRowList tail row, Row.Cons name ty ignore row) => EncodeRepRowList (Cons name ty tail) row where
encodeRepRowList _ rec = \obj -> FO.insert (reflectSymbol namep) (encodeJson value) (cont obj)
where
namep = SProxy :: SProxy name
value = get namep rec
tailp = RLProxy :: RLProxy tail
cont = encodeRepRowList tailp rec



-- | Encode any `Generic` data structure into `Json`.
genericEncodeJson :: forall a r. Rep.Generic a r => EncodeRep r => a -> Json
genericEncodeJson = encodeRep <<< Rep.from
Expand Down