deriving via example

autodocodec-aeson/autodocodec-aeson.cabal

@@ -24,6 +24,7 @@ library
   exposed-modules:
       Autodocodec.Aeson
       Autodocodec.Aeson.Decode
+      Autodocodec.Aeson.DerivingVia
       Autodocodec.Aeson.Document
       Autodocodec.Aeson.Encode
   other-modules:

autodocodec-aeson/src/Autodocodec/Aeson.hs

@@ -1,11 +1,15 @@
+{-# OPTIONS_GHC -fno-warn-dodgy-exports #-}
+
 module Autodocodec.Aeson
   ( -- * To makes sure we definitely export everything.
     module Autodocodec.Aeson.Decode,
+    module Autodocodec.Aeson.DerivingVia,
     module Autodocodec.Aeson.Document,
     module Autodocodec.Aeson.Encode,
   )
 where
 
 import Autodocodec.Aeson.Decode
+import Autodocodec.Aeson.DerivingVia ()
 import Autodocodec.Aeson.Document
 import Autodocodec.Aeson.Encode

autodocodec-aeson/src/Autodocodec/Aeson/DerivingVia.hs

@@ -0,0 +1,14 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Autodocodec.Aeson.DerivingVia where
+
+import Autodocodec
+import Autodocodec.Aeson.Decode
+import Autodocodec.Aeson.Encode
+import Data.Aeson
+
+instance HasCodec a => ToJSON (Autodocodec a) where
+  toJSON = toJSONViaCodec . unAutodocodec
+
+instance HasCodec a => FromJSON (Autodocodec a) where
+  parseJSON = fmap Autodocodec <$> parseJSONViaCodec

autodocodec-api-usage/src/Autodocodec/Usage.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -10,6 +11,7 @@
 module Autodocodec.Usage where
 
 import Autodocodec
+import Autodocodec.Aeson ()
 import Control.Applicative
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as JSON
@@ -32,8 +34,8 @@ data Fruit
 instance Validity Fruit
 
 instance GenValid Fruit where
-  genValid = genValidStructurally
-  shrinkValid = shrinkValidStructurally
+  genValid = genValidStructurallyWithoutExtraChecking
+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
 
 instance HasCodec Fruit where
   codec = shownBoundedEnumCodec
@@ -149,3 +151,20 @@ instance HasCodec Recursive where
             eitherCodec
               (codec @Int <?> "base case")
               (object "Recurse" $ requiredField "recurse" "recursive case")
+
+data Via = Via {viaOne :: !Text, viaTwo :: !Text}
+  deriving stock (Show, Eq, Generic)
+  deriving (FromJSON, ToJSON) via (Autodocodec Via)
+
+instance Validity Via
+
+instance GenValid Via where
+  genValid = genValidStructurallyWithoutExtraChecking
+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+
+instance HasCodec Via where
+  codec =
+    object "Via" $
+      Via
+        <$> requiredField "one" "first field" .= viaOne
+        <*> requiredField "two" "second field" .= viaTwo

autodocodec-api-usage/test/Autodocodec/Aeson/DocumentSpec.hs

@@ -55,6 +55,7 @@ spec = do
   jsonSchemaSpec @[Text] "list-text"
   jsonSchemaSpec @Example "example"
   jsonSchemaSpec @Recursive "recursive"
+  jsonSchemaSpec @Via "via"
   describe "JSONSchema" $ do
     genValidSpec @JSONSchema
     it "roundtrips through json and back" $

autodocodec-api-usage/test/Autodocodec/AesonSpec.hs

@@ -53,6 +53,7 @@ spec = do
   aesonCodecSpec @Fruit
   aesonCodecSpec @Example
   aesonCodecSpec @Recursive
+  aesonCodecSpec @Via
 
 aesonCodecSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a, ToJSON a, FromJSON a, HasCodec a) => Spec
 aesonCodecSpec =

autodocodec-api-usage/test/Autodocodec/Yaml/DocumentSpec.hs

@@ -50,6 +50,7 @@ spec = do
   yamlSchemaSpec @Fruit "fruit"
   yamlSchemaSpec @Example "example"
   yamlSchemaSpec @Recursive "recursive"
+  yamlSchemaSpec @Via "via"
 
 yamlSchemaSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a, HasCodec a) => FilePath -> Spec
 yamlSchemaSpec filePath = do

autodocodec-api-usage/test_resources/schema/via.json

@@ -0,0 +1,16 @@
+{
+    "$comment": "Via",
+    "required": [
+        "one",
+        "two"
+    ],
+    "type": "object",
+    "properties": {
+        "two": {
+            "type": "string"
+        },
+        "one": {
+            "type": "string"
+        }
+    }
+}

autodocodec-api-usage/test_resources/schema/via.txt

@@ -0,0 +1,7 @@
+# Via
+one: # required
+  # first field
+  <string>
+two: # required
+  # second field
+  <string>

autodocodec/autodocodec.cabal

@@ -25,6 +25,7 @@ library
       Autodocodec
       Autodocodec.Class
       Autodocodec.Codec
+      Autodocodec.DerivingVia
   other-modules:
       Paths_autodocodec
   hs-source-dirs:

autodocodec/src/Autodocodec.hs

@@ -68,14 +68,19 @@ module Autodocodec
     pureCodec,
     apCodec,
 
+    -- * Deriving Via
+    Autodocodec (..),
+
     -- ** Internals you most likely don't need
     showCodecABit,
 
     -- * To make sure we definitely export everything
     module Autodocodec.Class,
+    module Autodocodec.DerivingVia,
     module Autodocodec.Codec,
   )
 where
 
 import Autodocodec.Class
 import Autodocodec.Codec
+import Autodocodec.DerivingVia

autodocodec/src/Autodocodec/DerivingVia.hs

@@ -0,0 +1,17 @@
+module Autodocodec.DerivingVia where
+
+-- | 'Autodocodec' is a wrapper to provide codec-based deriving strategies.
+--
+-- === Example usage
+--
+-- > data Via = Via {viaOne :: !Text, viaTwo :: !Text}
+-- >   deriving stock (Show, Eq, Generic)
+-- >   deriving (FromJSON, ToJSON) via (Autodocodec Via)
+-- >
+-- > instance HasCodec Via where
+-- >   codec =
+-- >     object "Via" $
+-- >       Via
+-- >         <$> requiredField "one" "first field" .= viaOne
+-- >         <*> requiredField "two" "second field" .= viaTwo
+newtype Autodocodec a = Autodocodec {unAutodocodec :: a}