packages feed

autodocodec-yaml 0.3.0.0 → 0.3.0.1

raw patch · 3 files changed

+17/−57 lines, 3 filesdep ~autodocodecdep ~autodocodec-schemaPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: autodocodec, autodocodec-schema

API changes (from Hackage documentation)

Files

autodocodec-yaml.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           autodocodec-yaml-version:        0.3.0.0+version:        0.3.0.1 synopsis:       Autodocodec interpreters for yaml homepage:       https://github.com/NorfairKing/autodocodec#readme bug-reports:    https://github.com/NorfairKing/autodocodec/issues@@ -34,8 +34,8 @@   hs-source-dirs:       src   build-depends:-      autodocodec >=0.2.3.0-    , autodocodec-schema >=0.1.0.0+      autodocodec >=0.3.0.0+    , autodocodec-schema >=0.1.0.5     , base >=4.7 && <5     , bytestring     , containers
src/Autodocodec/Yaml/Encode.hs view
@@ -12,6 +12,7 @@ import Autodocodec.Codec import Autodocodec.DerivingVia import Control.Arrow (first)+import Data.Coerce (coerce) import Data.Scientific import Data.Text (Text) import qualified Data.Text as T@@ -33,17 +34,17 @@     go :: a -> ValueCodec a void -> YamlBuilder     go a = \case       NullCodec -> Yaml.null-      BoolCodec _ -> Yaml.bool (a :: Bool)-      StringCodec _ -> Yaml.string (a :: Text)-      NumberCodec _ _ -> yamlNumber (a :: Scientific)-      ArrayOfCodec _ c -> Yaml.array (map (`go` c) (V.toList (a :: Vector _)))+      BoolCodec _ -> Yaml.bool (coerce a :: Bool)+      StringCodec _ -> Yaml.string (coerce a :: Text)+      NumberCodec _ _ -> yamlNumber (coerce a :: Scientific)+      ArrayOfCodec _ c -> Yaml.array (map (`go` c) (V.toList (coerce a :: Vector _)))       ObjectOfCodec _ oc -> Yaml.mapping (goObject a oc)-      HashMapCodec c -> go (toJSONVia (HashMapCodec c) a) ValueCodec -- This may be optimisable?-      MapCodec c -> go (toJSONVia (MapCodec c) a) ValueCodec -- This may be optimisable?-      ValueCodec -> yamlValue (a :: JSON.Value)+      c@(HashMapCodec {}) -> go (toJSONVia c a) valueCodec -- This may be optimisable?+      c@(MapCodec {}) -> go (toJSONVia c a) valueCodec -- This may be optimisable?+      ValueCodec -> yamlValue (coerce a :: JSON.Value)       EqCodec value c -> go value c       BimapCodec _ g c -> go (g a) c-      EitherCodec _ c1 c2 -> case (a :: Either _ _) of+      EitherCodec _ c1 c2 -> case (coerce a :: Either _ _) of         Left a1 -> go a1 c1         Right a2 -> go a2 c2       CommentCodec _ c -> go a c@@ -52,16 +53,16 @@     goObject :: a -> ObjectCodec a void -> [(Text, YamlBuilder)]     goObject a = \case       RequiredKeyCodec k c _ -> [(k, go a c)]-      OptionalKeyCodec k c _ -> case (a :: Maybe _) of+      OptionalKeyCodec k c _ -> case (coerce a :: Maybe _) of         Nothing -> []         Just b -> [k Yaml..= go b c]-      OptionalKeyWithDefaultCodec k c _ mDoc -> goObject (Just a) (OptionalKeyCodec k c mDoc)+      OptionalKeyWithDefaultCodec k c _ mDoc -> goObject (Just a) (optionalKeyCodec k c mDoc)       OptionalKeyWithOmittedDefaultCodec k c defaultValue mDoc ->-        if a == defaultValue+        if coerce a == defaultValue           then []-          else goObject a (OptionalKeyWithDefaultCodec k c defaultValue mDoc)+          else goObject a (optionalKeyWithDefaultCodec k (coerce c) (coerce defaultValue) mDoc)       BimapCodec _ g c -> goObject (g a) c-      EitherCodec _ c1 c2 -> case (a :: Either _ _) of+      EitherCodec _ c1 c2 -> case (coerce a :: Either _ _) of         Left a1 -> goObject a1 c1         Right a2 -> goObject a2 c2       DiscriminatedUnionCodec propertyName m _ ->
src/Autodocodec/Yaml/Schema.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -23,12 +21,10 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import qualified Data.Map as M-import Data.Scientific (Scientific, floatingOrInteger) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE-import Data.Word import Data.Yaml as Yaml import Text.Colour @@ -173,40 +169,3 @@           MinusPowerOf2MinusOne w -> chunk $ T.pack $ "- (2^" <> show w <> "-1)"           OtherInteger i -> chunk $ T.pack $ show i           OtherDouble d -> chunk $ T.pack $ show d--data NumberBoundsSymbolic-  = BitUInt !Word8 -- w bit unsigned int-  | BitSInt !Word8 -- w bit signed int-  | OtherNumberBounds !ScientificSymbolic !ScientificSymbolic--guessNumberBoundsSymbolic :: NumberBounds -> NumberBoundsSymbolic-guessNumberBoundsSymbolic NumberBounds {..} =-  case (guessScientificSymbolic numberBoundsLower, guessScientificSymbolic numberBoundsUpper) of-    (Zero, PowerOf2MinusOne w) -> BitUInt w-    (MinusPowerOf2 w1, PowerOf2MinusOne w2) | w1 == w2 -> BitSInt (succ w1)-    (l, u) -> OtherNumberBounds l u--data ScientificSymbolic-  = Zero-  | PowerOf2 !Word8 -- 2^w-  | PowerOf2MinusOne !Word8 -- 2^w -1-  | MinusPowerOf2 !Word8 -- - 2^w-  | MinusPowerOf2MinusOne !Word8 -- - (2^w -1)-  | OtherInteger !Integer-  | OtherDouble !Double--guessScientificSymbolic :: Scientific -> ScientificSymbolic-guessScientificSymbolic s = case floatingOrInteger s of-  Left d -> OtherDouble d-  Right i ->-    let log2Rounded :: Word8-        log2Rounded = round (logBase 2 (fromInteger (abs i)) :: Double)-        guess :: Integer-        guess = 2 ^ log2Rounded-     in if-          | i == 0 -> Zero-          | guess == i -> PowerOf2 log2Rounded-          | (guess - 1) == i -> PowerOf2MinusOne log2Rounded-          | -guess == i -> MinusPowerOf2 log2Rounded-          | -(guess - 1) == i -> MinusPowerOf2MinusOne log2Rounded-          | otherwise -> OtherInteger i