packages feed

cretheus (empty) → 1.0.0

raw patch · 9 files changed

+778/−0 lines, 9 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, containers, primitive, reflection, text, time, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## [0.1.0] - Unreleased++- Initial release.
+ LICENSE view
@@ -0,0 +1,11 @@+Copyright 2023-2025 Mitchell Dalvi Rosen, Travis Staton++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# cretheus
+ cretheus.cabal view
@@ -0,0 +1,70 @@+cabal-version: 2.2++author: Mitchell Dalvi Rosen, Travis Staton+bug-reports: https://github.com/awkward-squad/cretheus/issues+category: Json+copyright: Copyright (C) 2023-2025 Mitchell Dalvi Rosen, Travis Staton+description: A clean `aeson` wrapper.+homepage: https://github.com/awkward-squad/cretheus+license: BSD-3-Clause+license-file: LICENSE+maintainer: Mitchell Dalvi Rosen <mitchellwrosen@gmail.com>, Travis Staton <hello@travisstaton.com>+name: cretheus+stability: experimental+synopsis: A clean aeson wrapper+tested-with: GHC == 9.8.4, GHC == 9.10.1, GHC == 9.12.2+version: 1.0.0++extra-source-files:+  CHANGELOG.md+  README.md++source-repository head+  type: git+  location: https://github.com/awkward-squad/cretheus.git++library+  build-depends:+    aeson ^>= 2.1.2 || ^>= 2.2.0,+    base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 || ^>= 4.20 || ^>= 4.21,+    bytestring ^>= 0.11.4 || ^>= 0.12.0,+    containers ^>= 0.6 || ^>= 0.7 || ^>= 0.8,+    primitive ^>= 0.8 || ^>= 0.9,+    reflection ^>= 2.1.7,+    text ^>= 2.0.2 || ^>= 2.1,+    time ^>= 1.12 || ^>= 1.14 || ^>= 1.15,+    vector ^>= 0.13.0,+  default-extensions:+    BlockArguments+    DerivingStrategies+    DerivingVia+    DuplicateRecordFields+    LambdaCase+    OverloadedRecordDot+  default-language: GHC2021+  exposed-modules:+    Cretheus.Codec+    Cretheus.Decode+    Cretheus.Encode+  ghc-options:+    -Weverything+    -Wno-all-missed-specialisations+    -Wno-implicit-prelude+    -Wno-missed-specialisations+    -Wno-missing-import-lists+    -Wno-safe+    -Wno-unsafe+  if impl(ghc >= 8.10)+    ghc-options:+      -Wno-missing-safe-haskell-mode+      -Wno-prepositive-qualified-module+  if impl(ghc >= 9.2)+    ghc-options:+      -Wno-missing-kind-signatures+  if impl(ghc >= 9.8)+    ghc-options:+      -Wno-missing-role-annotations+  hs-source-dirs: src+  other-modules:+    Cretheus.Internal.Decode+    Cretheus.Internal.Encode
+ src/Cretheus/Codec.hs view
@@ -0,0 +1,140 @@+module Cretheus.Codec+  ( -- * Codec+    Codec (..),++    -- ** Boolean codecs+    bool,++    -- ** Number codecs+    int,+    int32,+    int64,+    float,+    double,++    -- ** String codecs+    text,+    utcTime,++    -- ** Array codecs+    list,+    array,+    vector,+    set,++    -- ** Object codecs+    ObjectCodec (..),+    object,+    map,+    keyMap,++    -- ** Null codecs+    null,+  )+where++import Cretheus.Internal.Decode (Decoder, ObjectDecoder)+import Cretheus.Internal.Decode qualified as Decode+import Cretheus.Internal.Encode (Encoding, PropertyEncoding)+import Cretheus.Internal.Encode qualified as Encode+import Data.Aeson.KeyMap qualified as Aeson (Key, KeyMap)+import Data.Int (Int32, Int64)+import Data.Map.Strict (Map)+import Data.Primitive.Array (Array)+import Data.Set (Set)+import Data.Text (Text)+import Data.Time (UTCTime)+import Data.Vector (Vector)+import Prelude hiding (map, null)++-- | A value codec.+data Codec a = Codec+  { decoder :: Decoder a,+    encoder :: a -> Encoding+  }++-- | An object codec.+data ObjectCodec a = ObjectCodec+  { decoder :: ObjectDecoder a,+    encoder :: a -> [PropertyEncoding]+  }++-- | A bool codec.+bool :: Codec Bool+bool =+  Codec Decode.bool Encode.bool++-- | An int codec.+int :: Codec Int+int =+  Codec Decode.int Encode.int++-- | A 32-bit int codec.+int32 :: Codec Int32+int32 =+  Codec Decode.int32 Encode.int32++-- | A 64-bit int codec.+int64 :: Codec Int64+int64 =+  Codec Decode.int64 Encode.int64++-- | A 32-bit float codec.+float :: Codec Float+float =+  Codec Decode.float Encode.float++-- | A 64-bit float codec.+double :: Codec Double+double =+  Codec Decode.double Encode.double++-- | A text codec.+text :: Codec Text+text =+  Codec Decode.text Encode.text++-- | A timestamp codec (ISO 8601).+utcTime :: Codec UTCTime+utcTime =+  Codec Decode.utcTime Encode.utcTime++-- | A list codec.+list :: Codec a -> Codec [a]+list codec =+  Codec (Decode.list codec.decoder) (Encode.list codec.encoder)++-- | An array codec.+array :: Codec a -> Codec (Array a)+array codec =+  Codec (Decode.array codec.decoder) (Encode.array codec.encoder)++-- | A vector codec.+vector :: Codec a -> Codec (Vector a)+vector codec =+  Codec (Decode.vector codec.decoder) (Encode.vector codec.encoder)++-- | A set codec.+set :: (Ord a) => Codec a -> Codec (Set a)+set codec =+  Codec (Decode.set codec.decoder) (Encode.set codec.encoder)++-- | An object codec.+object :: ObjectCodec a -> Codec a+object codec =+  Codec (Decode.object codec.decoder) (Encode.object . codec.encoder)++-- | A map codec.+map :: (Ord k) => (Aeson.Key -> k) -> (k -> Aeson.Key) -> Codec a -> Codec (Map k a)+map fromKey toKey codec =+  Codec (Decode.map fromKey codec.decoder) (Encode.map toKey codec.encoder)++-- | A key map codec.+keyMap :: Codec a -> Codec (Aeson.KeyMap a)+keyMap codec =+  Codec (Decode.keyMap codec.decoder) (Encode.keyMap codec.encoder)++-- | A null codec.+null :: Codec ()+null =+  Codec Decode.null (const Encode.null)
+ src/Cretheus/Decode.hs view
@@ -0,0 +1,51 @@+module Cretheus.Decode+  ( -- * Decoding+    Decoder,+    fromBytes,+    fromLazyBytes,+    fromText,+    fromValue,++    -- * Decoders++    -- ** Boolean decoders+    bool,++    -- ** Number decoders+    int,+    int32,+    int64,+    float,+    double,++    -- ** String decoders+    text,+    utcTime,++    -- ** Array decoders+    list,+    array,+    vector,+    set,++    -- ** Object decoders+    ObjectDecoder,+    object,+    property,+    optionalProperty,+    map,+    keyMap,++    -- ** Null decoders+    nullable,++    -- ** Value decoders+    value,++    -- ** Decoder refinement+    refine,+  )+where++import Cretheus.Internal.Decode+import Prelude hiding (map)
+ src/Cretheus/Encode.hs view
@@ -0,0 +1,46 @@+module Cretheus.Encode+  ( -- * Encoding+    Encoding,+    asBytes,+    asLazyBytes,+    asBytesBuilder,+    asText,+    asValue,++    -- * Encoders++    -- ** Boolean encoders+    bool,++    -- ** Number encoders+    int,+    int32,+    int64,+    float,+    double,++    -- ** String encoders+    text,+    utcTime,++    -- ** Array encoders+    list,+    array,+    vector,+    set,++    -- ** Object encoders+    PropertyEncoding,+    object,+    property,+    optionalProperty,+    map,+    keyMap,++    -- ** Null encoders+    null,+  )+where++import Cretheus.Internal.Encode+import Prelude hiding (map, null)
+ src/Cretheus/Internal/Decode.hs view
@@ -0,0 +1,232 @@+module Cretheus.Internal.Decode+  ( Decoder,+    ObjectDecoder,+    array,+    bool,+    fromBytes,+    fromLazyBytes,+    double,+    float,+    fromText,+    fromValue,+    int,+    int32,+    int64,+    keyMap,+    list,+    map,+    null,+    nullable,+    object,+    optionalProperty,+    property,+    refine,+    set,+    text,+    utcTime,+    value,+    vector,+  )+where++import Control.Monad qualified as Monad+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as Aeson (KeyMap)+import Data.Aeson.KeyMap qualified as Aeson.KeyMap+import Data.Aeson.Types qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString.Lazy qualified as Lazy (ByteString)+import Data.Coerce (coerce)+import Data.Data (Proxy (..))+import Data.Int (Int32, Int64)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Primitive.Array (Array)+import Data.Reflection (Reifies (reflect), reify)+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Time (UTCTime)+import Data.Vector (Vector)+import Data.Vector qualified as Vector+import Prelude hiding (map, null)++newtype GDecoder a b = GDecoder+  { unGDecoder :: a -> Aeson.Parser b+  }+  deriving stock (Functor)++instance Applicative (GDecoder a) where+  pure x = GDecoder \_ -> pure x+  (<*>) = Monad.ap++instance Monad (GDecoder a) where+  return = pure+  GDecoder mx >>= f =+    GDecoder \i ->+      mx i >>= \x ->+        unGDecoder (f x) i++-- | A value decoder.+newtype Decoder a+  = Decoder (Aeson.Value -> Aeson.Parser a)+  deriving (Applicative, Functor, Monad) via (GDecoder Aeson.Value)++-- | An object decoder.+newtype ObjectDecoder a+  = ObjectDecoder (Aeson.Object -> Aeson.Parser a)+  deriving (Applicative, Functor, Monad) via (GDecoder Aeson.Object)++-- This didn't suck as bad before aeson-2.2, when they got rid of `eitherDecodeWith`...+newtype D (s :: k) a = D a++instance (Reifies s (Decoder a)) => Aeson.FromJSON (D s a) where+  parseJSON :: Aeson.Value -> Aeson.Parser (D s a)+  parseJSON =+    coerce+      @(Decoder a)+      @(Aeson.Value -> Aeson.Parser (D s a))+      (reflect (Proxy :: Proxy s))++-- | Decode bytes.+fromBytes :: Decoder a -> ByteString -> Either Text a+fromBytes decoder bytes =+  reify decoder \(_ :: Proxy s) ->+    case Aeson.eitherDecodeStrict bytes of+      Left err -> Left (Text.pack err)+      Right (D result :: D s a) -> Right result++-- | Decode lazy bytes.+fromLazyBytes :: Decoder a -> Lazy.ByteString -> Either Text a+fromLazyBytes decoder bytes =+  reify decoder \(_ :: Proxy s) ->+    case Aeson.eitherDecode bytes of+      Left err -> Left (Text.pack err)+      Right (D result :: D s a) -> Right result++-- | Decode text.+fromText :: Decoder a -> Text -> Either Text a+fromText decoder str =+  fromBytes decoder (Text.encodeUtf8 str)++-- | Decode a value.+fromValue :: Decoder a -> Aeson.Value -> Either Text a+fromValue (Decoder decoder) val =+  case Aeson.parseEither decoder val of+    Left err -> Left (Text.pack err)+    Right result -> Right result++-- | A value decoder.+value :: Decoder Aeson.Value+value =+  Decoder Aeson.parseJSON++-- | A bool decoder.+bool :: Decoder Bool+bool =+  Decoder Aeson.parseJSON++-- | An int decoder.+int :: Decoder Int+int =+  Decoder Aeson.parseJSON++-- | A 32-bit int decoder.+int32 :: Decoder Int32+int32 =+  Decoder Aeson.parseJSON++-- | A 64-bit int decoder.+int64 :: Decoder Int64+int64 =+  Decoder Aeson.parseJSON++-- | A 32-bit float decoder.+float :: Decoder Float+float =+  Decoder Aeson.parseJSON++-- | A 64-bit float decoder.+double :: Decoder Double+double =+  Decoder Aeson.parseJSON++-- | A text decoder.+text :: Decoder Text+text =+  Decoder Aeson.parseJSON++-- | A timestamp decoder (ISO 8601).+utcTime :: Decoder UTCTime+utcTime =+  Decoder Aeson.parseJSON++-- | A list decoder.+list :: Decoder a -> Decoder [a]+list =+  fmap Vector.toList . vector++-- | An array decoder.+array :: Decoder a -> Decoder (Array a)+array (Decoder f) =+  Decoder (Aeson.withArray "" (traverse f . Vector.toArray))++-- | A vector decoder.+vector :: Decoder a -> Decoder (Vector a)+vector (Decoder f) =+  Decoder (Aeson.withArray "" (traverse f))++-- | A set decoder.+set :: (Ord a) => Decoder a -> Decoder (Set a)+set =+  fmap Set.fromList . list++-- | An object decoder.+object :: ObjectDecoder a -> Decoder a+object (ObjectDecoder f) =+  Decoder (Aeson.withObject "" f)++-- | An object property decoder.+property :: Aeson.Key -> Decoder a -> ObjectDecoder a+property k (Decoder f) =+  ObjectDecoder \o -> Aeson.explicitParseField f o k++-- | An optional object property decoder.+optionalProperty :: Aeson.Key -> Decoder a -> ObjectDecoder (Maybe a)+optionalProperty k (Decoder f) =+  ObjectDecoder \o -> Aeson.explicitParseFieldMaybe' f o k++-- | A map decoder.+map :: (Ord k) => (Aeson.Key -> k) -> Decoder a -> Decoder (Map k a)+map fromKey (Decoder f) =+  object (ObjectDecoder (Aeson.KeyMap.foldrWithKey (\k v -> liftA2 (Map.insert (fromKey k)) (f v)) (pure Map.empty)))++-- | A key map decoder.+keyMap :: Decoder a -> Decoder (Aeson.KeyMap a)+keyMap (Decoder f) =+  object (ObjectDecoder (Aeson.KeyMap.traverse f))++-- | A null decoder.+null :: Decoder ()+null =+  Decoder \case+    Aeson.Null -> pure ()+    _ -> fail "expected null"++-- | A nullable decoder.+nullable :: Decoder v -> Decoder (Maybe v)+nullable (Decoder f) =+  Decoder \case+    Aeson.Null -> pure Nothing+    val -> Just <$> f val++-- | Refine a decoder with a predicate.+refine :: (a -> Either Text b) -> Decoder a -> Decoder b+refine p (Decoder f) =+  Decoder \val -> do+    x <- f val+    case p x of+      Left err -> fail (Text.unpack err)+      Right y -> pure y
+ src/Cretheus/Internal/Encode.hs view
@@ -0,0 +1,224 @@+module Cretheus.Internal.Encode+  ( Encoding,+    PropertyEncoding,+    array,+    asBytes,+    asBytesBuilder,+    asLazyBytes,+    asText,+    asValue,+    bool,+    double,+    float,+    int,+    int32,+    int64,+    keyMap,+    list,+    map,+    null,+    object,+    optionalProperty,+    property,+    set,+    text,+    utcTime,+    vector,+  )+where++import Data.Aeson qualified as Aeson+import Data.Aeson.Encoding qualified as Aeson+import Data.Aeson.Key qualified as Aeson.Key+import Data.Aeson.KeyMap qualified as Aeson (KeyMap)+import Data.Aeson.KeyMap qualified as Aeson.KeyMap+import Data.ByteString (ByteString)+import Data.ByteString.Builder qualified as ByteString (Builder)+import Data.ByteString.Lazy (LazyByteString)+import Data.ByteString.Lazy qualified as ByteString.Lazy+import Data.Foldable qualified as Foldable+import Data.Int (Int32, Int64)+import Data.List qualified as List+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Primitive.Array (Array)+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text.Encoding qualified as Text+import Data.Time (UTCTime)+import Data.Vector (Vector)+import Data.Vector qualified as Vector+import Prelude hiding (map, null)++-- | A value encoding.+data Encoding+  = Encoding Aeson.Encoding Aeson.Value++mk :: (a -> Aeson.Encoding) -> (a -> Aeson.Value) -> a -> Encoding+mk f g x =+  Encoding (f x) (g x)++asAesonEncoding :: Encoding -> Aeson.Encoding+asAesonEncoding (Encoding encoding _) =+  encoding++-- | Interpret an encoding as bytes.+asBytes :: Encoding -> ByteString+asBytes =+  ByteString.Lazy.toStrict . asLazyBytes++-- | Interpret an encoding as bytes.+asLazyBytes :: Encoding -> LazyByteString+asLazyBytes =+  Aeson.encodingToLazyByteString . asAesonEncoding++-- | Interpret an encoding as a bytes builder.+asBytesBuilder :: Encoding -> ByteString.Builder+asBytesBuilder =+  Aeson.fromEncoding . asAesonEncoding++-- | Interpret an encoding as text.+asText :: Encoding -> Text+asText =+  Text.decodeUtf8 . asBytes++-- | Interpret an encoding as a value.+asValue :: Encoding -> Aeson.Value+asValue (Encoding _ value) =+  value++-- | A bool encoder.+bool :: Bool -> Encoding+bool =+  mk Aeson.bool Aeson.toJSON++-- | An int encoder.+int :: Int -> Encoding+int =+  int64 . fromIntegral @Int @Int64++-- | A 32-bit int encoder.+int32 :: Int32 -> Encoding+int32 =+  mk Aeson.int32 Aeson.toJSON++-- | A 64-bit int encoder.+int64 :: Int64 -> Encoding+int64 =+  mk Aeson.int64 Aeson.toJSON++-- | A 32-bit float encoder.+float :: Float -> Encoding+float =+  mk Aeson.float Aeson.toJSON++-- | A 32-bit float encoder.+double :: Double -> Encoding+double =+  mk Aeson.double Aeson.toJSON++-- | A text encoder.+text :: Text -> Encoding+text =+  mk Aeson.text Aeson.toJSON++-- | A timestamp encoder (ISO 8601).+utcTime :: UTCTime -> Encoding+utcTime =+  mk Aeson.utcTime Aeson.toJSON++-- | A null encoder.+null :: Encoding+null =+  Encoding Aeson.null_ Aeson.Null++-- | A list encoder.+list :: (a -> Encoding) -> [a] -> Encoding+list f =+  mk toAesonEncoding toAesonValue+  where+    toAesonEncoding = Aeson.list (asAesonEncoding . f)+    toAesonValue = Aeson.toJSON . List.map (asValue . f)++-- | An array encoder.+array :: (a -> Encoding) -> Array a -> Encoding+array f =+  mk toAesonEncoding toAesonValue+  where+    toAesonEncoding = Aeson.list (asAesonEncoding . f) . Foldable.toList @Array+    toAesonValue = Aeson.Array . Vector.fromArray . fmap @Array (asValue . f)++-- | A vector encoder.+vector :: (a -> Encoding) -> Vector a -> Encoding+vector f =+  mk toAesonEncoding toAesonValue+  where+    toAesonEncoding = Aeson.list (asAesonEncoding . f) . Vector.toList+    toAesonValue = Aeson.Array . Vector.map (asValue . f)++-- | A set encoder.+set :: (a -> Encoding) -> Set a -> Encoding+set f =+  list f . Set.toList++-- | An object property encoding.+data PropertyEncoding+  = Algo !Prop+  | Nada++data Prop+  = Prop !Aeson.Key !Encoding++propToAesonSeries :: Prop -> Aeson.Series+propToAesonSeries (Prop k v) =+  Aeson.pair k (asAesonEncoding v)++propsToAesonEncoding :: [Prop] -> Aeson.Encoding+propsToAesonEncoding =+  Aeson.pairs . foldMap propToAesonSeries++propToAesonKeyValue :: Prop -> (Aeson.Key, Aeson.Value)+propToAesonKeyValue (Prop k v) =+  (k, asValue v)++propsToAesonValue :: [Prop] -> Aeson.Value+propsToAesonValue =+  Aeson.Object . Aeson.KeyMap.fromList . List.map propToAesonKeyValue++addProperty :: PropertyEncoding -> [Prop] -> [Prop]+addProperty = \case+  Algo prop -> (prop :)+  Nada -> id++-- | An object encoder.+object :: [PropertyEncoding] -> Encoding+object =+  mk propsToAesonEncoding propsToAesonValue . foldr addProperty []++-- | An object property encoder.+property :: Aeson.Key -> Encoding -> PropertyEncoding+property key val =+  Algo (Prop key val)++-- | A optional object property encoder.+optionalProperty :: Aeson.Key -> Maybe Encoding -> PropertyEncoding+optionalProperty key = \case+  Nothing -> Nada+  Just val -> Algo (Prop key val)++-- | A map encoder.+map :: (k -> Aeson.Key) -> (a -> Encoding) -> Map k a -> Encoding+map f g =+  mk toAesonEncoding toAesonValue+  where+    toAesonEncoding = Aeson.dict (Aeson.text . Aeson.Key.toText . f) (asAesonEncoding . g) Map.foldrWithKey+    toAesonValue = Aeson.Object . Aeson.KeyMap.fromList . List.map (\(k, v) -> (f k, asValue (g v))) . Map.toList++-- | A key map encoder.+keyMap :: (a -> Encoding) -> Aeson.KeyMap a -> Encoding+keyMap f =+  mk toAesonEncoding toAesonValue+  where+    toAesonEncoding = Aeson.dict (Aeson.text . Aeson.Key.toText) (asAesonEncoding . f) Aeson.KeyMap.foldrWithKey+    toAesonValue = Aeson.Object . Aeson.KeyMap.map (asValue . f)