mirror of
https://github.com/NorfairKing/autodocodec.git
synced 2024-12-02 09:52:01 +03:00
withDefault and documentation
This commit is contained in:
parent
32dfb6191e
commit
c7749e2947
@ -68,7 +68,7 @@ instance HasCodec Example where
|
|||||||
<*> requiredField "maybe" .= exampleRequiredMaybe
|
<*> requiredField "maybe" .= exampleRequiredMaybe
|
||||||
<*> optionalField "optional" .= exampleOptional
|
<*> optionalField "optional" .= exampleOptional
|
||||||
<*> optionalFieldOrNull "optional-or-null" .= exampleOptionalOrNull
|
<*> optionalFieldOrNull "optional-or-null" .= exampleOptionalOrNull
|
||||||
<*> optionalFieldWithDefault "optional-with-default" "foobar" .= exampleOptionalWithDefault
|
<*> optionalField "optional-with-default" .!= "foobar" .= exampleOptionalWithDefault
|
||||||
<*> requiredField "fruit" .= exampleFruit
|
<*> requiredField "fruit" .= exampleFruit
|
||||||
|
|
||||||
instance ToJSON Example where
|
instance ToJSON Example where
|
||||||
|
@ -146,26 +146,3 @@ optionalFieldOrNull key =
|
|||||||
g = \case
|
g = \case
|
||||||
Nothing -> Nothing
|
Nothing -> Nothing
|
||||||
Just a -> Just (Just a)
|
Just a -> Just (Just a)
|
||||||
|
|
||||||
-- | An optional field with a default value
|
|
||||||
--
|
|
||||||
-- During decoding, the field may be in the object. The default value will be parsed if it is not.
|
|
||||||
--
|
|
||||||
-- During encoding, the field will be always be in the object. The default value is not used.
|
|
||||||
optionalFieldWithDefault ::
|
|
||||||
forall output.
|
|
||||||
HasCodec output =>
|
|
||||||
-- | The key
|
|
||||||
Text ->
|
|
||||||
-- | The default value to use during parsing
|
|
||||||
output ->
|
|
||||||
ObjectCodec output output
|
|
||||||
optionalFieldWithDefault key defaultValue =
|
|
||||||
bimapObjectCodec f g $ OptionalKeyCodec key codec
|
|
||||||
where
|
|
||||||
f :: Maybe output -> output
|
|
||||||
f = \case
|
|
||||||
Nothing -> defaultValue
|
|
||||||
Just value -> value
|
|
||||||
g :: output -> Maybe output
|
|
||||||
g = Just
|
|
||||||
|
@ -303,30 +303,107 @@ apObjectCodec = ApObjectCodec
|
|||||||
(.=) :: ObjectCodec oldInput output -> (newInput -> oldInput) -> ObjectCodec newInput output
|
(.=) :: ObjectCodec oldInput output -> (newInput -> oldInput) -> ObjectCodec newInput output
|
||||||
(.=) = flip comapObjectCodec
|
(.=) = flip comapObjectCodec
|
||||||
|
|
||||||
(<?>) :: Codec input output -> Text -> Codec input output
|
-- | Add a default value to a codec
|
||||||
|
--
|
||||||
|
-- During encoding, the default value is not used.
|
||||||
|
-- During decoding, the default value will be parsed if the underlying codec decodes 'Nothing'.
|
||||||
|
withDefault ::
|
||||||
|
forall value.
|
||||||
|
-- | default value
|
||||||
|
value ->
|
||||||
|
-- |
|
||||||
|
ObjectCodec (Maybe value) (Maybe value) ->
|
||||||
|
-- |
|
||||||
|
ObjectCodec value value
|
||||||
|
withDefault defaultValue = bimapObjectCodec f g
|
||||||
|
where
|
||||||
|
f :: Maybe value -> value
|
||||||
|
f = \case
|
||||||
|
Nothing -> defaultValue
|
||||||
|
Just value -> value
|
||||||
|
g :: value -> Maybe value
|
||||||
|
g = Just
|
||||||
|
|
||||||
|
-- | Infix version of 'withDefault'
|
||||||
|
--
|
||||||
|
-- Example usage:
|
||||||
|
--
|
||||||
|
-- > data Example = Example
|
||||||
|
-- > { exampleText :: !Text,
|
||||||
|
-- > exampleOptionalWithDefault :: !Text
|
||||||
|
-- > }
|
||||||
|
-- >
|
||||||
|
-- > instance HasCodec Example where
|
||||||
|
-- > codec =
|
||||||
|
-- > object "Example" $
|
||||||
|
-- > Example
|
||||||
|
-- > <$> requiredField "text" .= exampleText
|
||||||
|
-- > <*> optionalField "optional-with-default" .!= "default-value" .= exampleOptionalWithDefault
|
||||||
|
(.!=) ::
|
||||||
|
forall value.
|
||||||
|
-- |
|
||||||
|
ObjectCodec (Maybe value) (Maybe value) ->
|
||||||
|
-- | default value
|
||||||
|
value ->
|
||||||
|
-- |
|
||||||
|
ObjectCodec value value
|
||||||
|
(.!=) = flip withDefault
|
||||||
|
|
||||||
|
-- | Infix version of 'CommentCodec'
|
||||||
|
(<?>) ::
|
||||||
|
Codec input output ->
|
||||||
|
-- | The comment
|
||||||
|
Text ->
|
||||||
|
Codec input output
|
||||||
(<?>) = flip CommentCodec
|
(<?>) = flip CommentCodec
|
||||||
|
|
||||||
(<??>) :: Codec input output -> [Text] -> Codec input output
|
-- | A version of '<?>' that lets you supply a list of lines of text instead of a single text.
|
||||||
|
--
|
||||||
|
-- This helps when you use an automated formatter that deals with lists more nicely than with multi-line strings.
|
||||||
|
(<??>) ::
|
||||||
|
Codec input output ->
|
||||||
|
-- | The lines of comments
|
||||||
|
[Text] ->
|
||||||
|
Codec input output
|
||||||
(<??>) c ls = CommentCodec (T.unlines ls) c
|
(<??>) c ls = CommentCodec (T.unlines ls) c
|
||||||
|
|
||||||
|
-- | Forward-compatible version of 'NullCodec'
|
||||||
|
--
|
||||||
|
-- > nullCodec = NullCodec
|
||||||
nullCodec :: Codec () ()
|
nullCodec :: Codec () ()
|
||||||
nullCodec = NullCodec
|
nullCodec = NullCodec
|
||||||
|
|
||||||
|
-- | Forward-compatible version of 'BoolCodec' without a name
|
||||||
|
--
|
||||||
|
-- > boolCodec = BoolCodec Nothing
|
||||||
boolCodec :: Codec Bool Bool
|
boolCodec :: Codec Bool Bool
|
||||||
boolCodec = BoolCodec Nothing
|
boolCodec = BoolCodec Nothing
|
||||||
|
|
||||||
|
-- | Forward-compatible version of 'StringCodec' without a name
|
||||||
|
--
|
||||||
|
-- > textCodec = StringCodec Nothing
|
||||||
textCodec :: Codec Text Text
|
textCodec :: Codec Text Text
|
||||||
textCodec = StringCodec Nothing
|
textCodec = StringCodec Nothing
|
||||||
|
|
||||||
|
-- | A 'String' version of 'textCodec'.
|
||||||
|
--
|
||||||
|
-- WARNING: this codec uses 'T.unpack' and 'T.pack' to bimap a 'textCodec', so it DOES NOT ROUNDTRIP.
|
||||||
stringCodec :: Codec String String
|
stringCodec :: Codec String String
|
||||||
stringCodec = bimapCodec T.unpack T.pack $ StringCodec Nothing
|
stringCodec = bimapCodec T.unpack T.pack textCodec
|
||||||
|
|
||||||
|
-- | Forward-compatible version of 'NumberCodec' without a name
|
||||||
|
--
|
||||||
|
-- > scientificCodec = NumberCodec Nothing
|
||||||
scientificCodec :: Codec Scientific Scientific
|
scientificCodec :: Codec Scientific Scientific
|
||||||
scientificCodec = NumberCodec Nothing
|
scientificCodec = NumberCodec Nothing
|
||||||
|
|
||||||
|
-- | An object codec with a given name
|
||||||
object :: Text -> ObjectCodec value value -> Codec value value
|
object :: Text -> ObjectCodec value value -> Codec value value
|
||||||
object name = ObjectCodec (Just name)
|
object name = ObjectCodec (Just name)
|
||||||
|
|
||||||
|
-- | A codec for bounded integers like 'Int', 'Int8', and 'Word'.
|
||||||
|
--
|
||||||
|
-- WARNING: This codec will fail to parse numbers that are too big, for security reasons.
|
||||||
boundedIntegerCodec :: (Integral i, Bounded i) => Codec i i
|
boundedIntegerCodec :: (Integral i, Bounded i) => Codec i i
|
||||||
boundedIntegerCodec = MapCodec go fromIntegral $ NumberCodec Nothing
|
boundedIntegerCodec = MapCodec go fromIntegral $ NumberCodec Nothing
|
||||||
where
|
where
|
||||||
@ -334,16 +411,21 @@ boundedIntegerCodec = MapCodec go fromIntegral $ NumberCodec Nothing
|
|||||||
Nothing -> Left $ "Number too big: " <> show s
|
Nothing -> Left $ "Number too big: " <> show s
|
||||||
Just i -> Right i
|
Just i -> Right i
|
||||||
|
|
||||||
|
-- | A codec for a literal piece of 'Text'.
|
||||||
literalText :: Text -> Codec Text Text
|
literalText :: Text -> Codec Text Text
|
||||||
literalText text = EqCodec text textCodec
|
literalText text = EqCodec text textCodec
|
||||||
|
|
||||||
|
-- | A codec for a literal value corresponding to a literal piece of 'Text'.
|
||||||
literalTextValue :: a -> Text -> Codec a a
|
literalTextValue :: a -> Text -> Codec a a
|
||||||
literalTextValue value text = bimapCodec (const value) (const text) (literalText text)
|
literalTextValue value text = bimapCodec (const value) (const text) (literalText text)
|
||||||
|
|
||||||
matchChoiceCodec ::
|
matchChoiceCodec ::
|
||||||
forall input output newInput.
|
forall input output newInput.
|
||||||
|
-- |
|
||||||
(newInput -> Maybe input, Codec input output) ->
|
(newInput -> Maybe input, Codec input output) ->
|
||||||
|
-- |
|
||||||
(newInput -> Maybe input, Codec input output) ->
|
(newInput -> Maybe input, Codec input output) ->
|
||||||
|
-- |
|
||||||
Codec newInput output
|
Codec newInput output
|
||||||
matchChoiceCodec (f1, c1) (f2, c2) =
|
matchChoiceCodec (f1, c1) (f2, c2) =
|
||||||
bimapCodec f g $
|
bimapCodec f g $
|
||||||
@ -361,7 +443,9 @@ matchChoiceCodec (f1, c1) (f2, c2) =
|
|||||||
|
|
||||||
matchChoicesCodec ::
|
matchChoicesCodec ::
|
||||||
forall input output.
|
forall input output.
|
||||||
|
-- |
|
||||||
NonEmpty (input -> Maybe input, Codec input output) ->
|
NonEmpty (input -> Maybe input, Codec input output) ->
|
||||||
|
-- |
|
||||||
Codec input output
|
Codec input output
|
||||||
matchChoicesCodec ((f, c) :| rest) = case NE.nonEmpty rest of
|
matchChoicesCodec ((f, c) :| rest) = case NE.nonEmpty rest of
|
||||||
Nothing -> c
|
Nothing -> c
|
||||||
@ -373,7 +457,9 @@ matchChoicesCodec ((f, c) :| rest) = case NE.nonEmpty rest of
|
|||||||
enumCodec ::
|
enumCodec ::
|
||||||
forall enum.
|
forall enum.
|
||||||
Eq enum =>
|
Eq enum =>
|
||||||
|
-- |
|
||||||
NonEmpty (enum, Codec enum enum) ->
|
NonEmpty (enum, Codec enum enum) ->
|
||||||
|
-- |
|
||||||
Codec enum enum
|
Codec enum enum
|
||||||
enumCodec =
|
enumCodec =
|
||||||
matchChoicesCodec
|
matchChoicesCodec
|
||||||
@ -390,7 +476,9 @@ enumCodec =
|
|||||||
stringConstCodec ::
|
stringConstCodec ::
|
||||||
forall constant.
|
forall constant.
|
||||||
Eq constant =>
|
Eq constant =>
|
||||||
|
-- |
|
||||||
NonEmpty (constant, Text) ->
|
NonEmpty (constant, Text) ->
|
||||||
|
-- |
|
||||||
Codec constant constant
|
Codec constant constant
|
||||||
stringConstCodec =
|
stringConstCodec =
|
||||||
enumCodec
|
enumCodec
|
||||||
@ -401,9 +489,11 @@ stringConstCodec =
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
-- | A codec for a 'Bounded' 'Enum' that uses its 'Show' instance to have the values correspond to literal 'Text' values.
|
||||||
shownBoundedEnumCodec ::
|
shownBoundedEnumCodec ::
|
||||||
forall enum.
|
forall enum.
|
||||||
(Show enum, Eq enum, Enum enum, Bounded enum) =>
|
(Show enum, Eq enum, Enum enum, Bounded enum) =>
|
||||||
|
-- |
|
||||||
Codec enum enum
|
Codec enum enum
|
||||||
shownBoundedEnumCodec =
|
shownBoundedEnumCodec =
|
||||||
let ls = [minBound .. maxBound]
|
let ls = [minBound .. maxBound]
|
||||||
|
Loading…
Reference in New Issue
Block a user