pure-sum-aeson (empty) → 0.1.0.0

raw patch · 5 files changed

+219/−0 lines, 5 filesdep +aesondep +basedep +containers

Dependencies added: aeson, base, containers, hspec, hspec-core, hspec-discover, pure-sum, pure-sum-aeson, text

Files

• LICENSE +15/−0
• pure-sum-aeson.cabal +91/−0
• src/Data/Sum/Pure/Aeson.hs +77/−0
• test/Data/Sum/Pure/AesonSpec.hs +35/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,15 @@+ISC License++Copyright (c) 2022 Gautier DI FOLCO++Permission to use, copy, modify, and/or distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY+AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM+LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR+PERFORMANCE OF THIS SOFTWARE.

@@ -0,0 +1,91 @@+cabal-version:       3.0+name:                pure-sum-aeson+version:             0.1.0.0+author:              Gautier DI FOLCO+maintainer:          gautier.difolco@gmail.com+category:            Data+build-type:          Simple+license:             ISC+license-file:        LICENSE+synopsis:            Derive fromString/toString-like for pure sum types (aeson instances)+description:         Derive fromString/toString-like for pure sum types (aeson instances).+Homepage:            http://github.com/blackheaven/pure-sum/pure-sum-aeson+tested-with:         GHC==9.6.3, GHC==9.4.8, GHC==9.2.8, GHC==9.0.2, GHC==8.10.7++library+  default-language:   Haskell2010+  build-depends:+          base == 4.*+        , pure-sum+        , aeson == 2.*+        , text == 2.*+  hs-source-dirs: src+  exposed-modules:+      Data.Sum.Pure.Aeson+  other-modules:+      Paths_pure_sum_aeson+  autogen-modules:+      Paths_pure_sum_aeson+  default-extensions:+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveGeneric+      DerivingStrategies+      DerivingVia+      DuplicateRecordFields+      FlexibleContexts+      GADTs+      GeneralizedNewtypeDeriving+      KindSignatures+      LambdaCase+      OverloadedLists+      OverloadedStrings+      RankNTypes+      RecordWildCards+      ScopedTypeVariables+      TypeApplications+      TypeFamilies+      TypeOperators+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints++test-suite spec+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  other-modules:+      Data.Sum.Pure.AesonSpec+      Paths_pure_sum_aeson+  autogen-modules:+      Paths_pure_sum_aeson+  default-extensions:+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveGeneric+      DerivingStrategies+      DerivingVia+      DuplicateRecordFields+      FlexibleContexts+      GADTs+      GeneralizedNewtypeDeriving+      KindSignatures+      LambdaCase+      OverloadedLists+      OverloadedStrings+      RankNTypes+      RecordWildCards+      ScopedTypeVariables+      TypeApplications+      TypeFamilies+      TypeOperators+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+  build-depends:+      base+    , pure-sum-aeson+    , aeson+    , containers+    , hspec+    , hspec-core+    , hspec-discover+  default-language: Haskell2010

@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module        : Data.Sum.Pure.Aeson+-- Copyright     : Gautier DI FOLCO+-- License       : BSD2+--+-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>+-- Stability     : Unstable+-- Portability   : GHC+--+-- Derive fromText/toText-like for pure sum types (aeson instances).+module Data.Sum.Pure.Aeson+  ( -- * Base type+    FromJSON (..),+    FromJSONKey (..),+    ToJSON (..),+    ToJSONKey (..),++    -- * Reexport+    module X,+  )+where++import Data.Aeson.Types+import Data.Proxy+import Data.Sum.Pure as X+import qualified Data.Text as T+import GHC.Generics+import GHC.TypeLits++-- -- * Base interface+--+-- -- | Wrapper for derivation.+-- -- @transformation@ is a @Transformation@ applied during derivations+-- newtype PureSumWith transformation a = PureSumWith {unPureSumWith :: a}+--   deriving stock (Eq, Ord, Show)+--+-- -- | Basic sum derivation+-- type PureSum = PureSumWith IdTransformation+--+-- class ToSumText a where+--   toSumText :: a -> T.Text+--+-- class FromSumText a where+--   fromSumText :: T.Text -> Maybe a++instance (FromSumText a, Generic a, GConstructorName (Rep a)) => FromJSON (PureSumWith transformation a) where+  parseJSON = withText (unConstructionName $ (to @a) <$> gConstructorName) pureSumWithParser++instance (FromSumText a, Generic a, GConstructorName (Rep a)) => FromJSONKey (PureSumWith transformation a) where+  fromJSONKey = FromJSONKeyTextParser pureSumWithParser++pureSumWithParser :: (FromSumText a) => T.Text -> Parser (PureSumWith transformation a)+pureSumWithParser x =+  maybe (fail $ "unknown value: " <> show x) (pure . PureSumWith) $+    fromSumText x++newtype ConstructorName x = ConstructorName {unConstructionName :: String}++instance Functor ConstructorName where+  fmap _ (ConstructorName x) = ConstructorName x++class GConstructorName f where+  gConstructorName :: ConstructorName (f a)++instance (KnownSymbol typeName) => GConstructorName (M1 D ('MetaData typeName c i b) a) where -- base type+  gConstructorName = ConstructorName $ symbolVal (Proxy @typeName)++instance (ToSumText a) => ToJSON (PureSumWith transformation a) where+  toJSON = toJSON . toSumText . unPureSumWith+  toEncoding = toEncoding . toSumText . unPureSumWith++instance (ToSumText a) => ToJSONKey (PureSumWith transformation a) where+  toJSONKey = toJSONKeyText (toSumText . unPureSumWith)

@@ -0,0 +1,35 @@+{-# LANGUAGE StandaloneDeriving #-}++module Data.Sum.Pure.AesonSpec+  ( main,+    spec,+  )+where++import Data.Aeson+import qualified Data.Map as Map+import Data.Sum.Pure.Aeson+import GHC.Generics+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  it "encoding regular derivation is broken" $+    encode (Map.singleton RSunday ("Happy day" :: String)) `shouldBe` "[[\"RSunday\",\"Happy day\"]]"+  it "encoding pure sum derivation is working" $+    encode (Map.singleton BSunday ("Happy day" :: String)) `shouldBe` "{\"BSunday\":\"Happy day\"}"+  it "decoding pure sum derivation is working" $+    eitherDecode "{\"BSunday\":\"Happy day\"}" `shouldBe` Right (Map.singleton BSunday ("Happy day" :: String))+  it "decoding unknown pure sum derivation is working" $+    eitherDecode @(Map.Map BetterWeekend String) "{\"Sunday\":\"Happy day\"}" `shouldBe` Left "Error in $.Sunday: unknown value: \"Sunday\""++data RegularWeekend = RSaturday | RSunday+  deriving stock (Eq, Ord, Show, Generic)+  deriving anyclass (FromJSON, FromJSONKey, ToJSON, ToJSONKey)++data BetterWeekend = BSaturday | BSunday+  deriving stock (Eq, Ord, Show, Generic)+  deriving (ToSumText, FromSumText, FromJSON, FromJSONKey, ToJSON, ToJSONKey) via (PureSum BetterWeekend)

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}