Add untagged and generics derivations

.github/workflows/haskell-ci.yml

@@ -8,9 +8,9 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.19.20260209
+# version: 0.19.20260331
 #
-# REGENDATA ("0.19.20260209",["github","--config=cabal.haskell-ci","tagged-json.cabal"])
+# REGENDATA ("0.19.20260331",["github","--config=cabal.haskell-ci","tagged-json.cabal"])
 #
 name: Haskell-CI
 on:
@@ -37,9 +37,9 @@ jobs:
     strategy:
       matrix:
         include:
-          - compiler: ghc-9.12.2
+          - compiler: ghc-9.12.4
             compilerKind: ghc
-            compilerVersion: 9.12.2
+            compilerVersion: 9.12.4
             setup-method: ghcup
             allow-failure: false
           - compiler: ghc-9.10.3
@@ -183,8 +183,6 @@ jobs:
           echo "packages: ${PKGDIR_tagged_json}" >> cabal.project
           echo "package tagged-json" >> cabal.project
           echo "    ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project
-          if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package tagged-json" >> cabal.project ; fi
-          if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "    ghc-options: -Werror=unused-packages" >> cabal.project ; fi
           echo "package tagged-json" >> cabal.project
           echo "    ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project
           cat >> cabal.project <<EOF

cabal.haskell-ci

@@ -1,4 +1,5 @@
-branches:     main
-cabal-check:  False
-doctest:      False
-tests:        True
+branches: main
+cabal-check: False
+doctest: False
+error-unused-packages: False
+tests: True

example/DerivingViaInstances.hs

@@ -12,9 +12,9 @@ import Data.Proxy
 import Deriving.TaggedJson
 import GHC.TypeLits
 
-data Opts (prefix :: Symbol) (tagKey :: Maybe Symbol)
-type Tagged prefix tagKey = GTaggedJSON (Opts prefix ('Just tagKey))
-type Untagged prefix = GTaggedJSON (Opts prefix 'Nothing)
+data Opts (prefix :: Symbol)
+type Tagged prefix tagKey = GTagged tagKey (Opts prefix)
+type Untagged prefix = GUntagged (Opts prefix)
 
 exampleTaggedOptions :: String -> TaggedOptions
 exampleTaggedOptions prefix =
@@ -27,14 +27,5 @@ exampleTaggedOptions prefix =
  where
   snakeCase = camelTo2 '_'
 
-instance (KnownSymbol prefix, KnownSymbol tagKey) => HasTaggedOptions (Opts prefix ('Just tagKey)) where
-  taggedOptions =
-    (exampleTaggedOptions (symbolVal $ Proxy @prefix))
-      { tagKey = Just (fromString . symbolVal $ Proxy @tagKey)
-      }
-
-instance (KnownSymbol prefix) => HasTaggedOptions (Opts prefix 'Nothing) where
-  taggedOptions =
-    (exampleTaggedOptions (symbolVal $ Proxy @prefix))
-      { tagKey = Nothing
-      }
+instance (KnownSymbol prefix) => HasTaggedOptions (Opts prefix) where
+  taggedOptions = exampleTaggedOptions (symbolVal $ Proxy @prefix)

example/GenericInstances.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module GenericInstances (genericInstances) where
@@ -11,11 +12,10 @@ import Data.List (stripPrefix)
 import Data.Maybe (fromJust)
 import Deriving.TaggedJson
 
-options :: String -> Maybe Key -> TaggedOptions
-options prefix tagKey =
+options :: String -> TaggedOptions
+options prefix =
   defaultTaggedOptions
-    { tagKey = tagKey
-    , fieldLabelModifier = snakeCase . fromJust . stripPrefix prefix
+    { fieldLabelModifier = snakeCase . fromJust . stripPrefix prefix
     , constructorTagModifier = snakeCase . fromJust . stripPrefix prefix
     , datatypeNameModifier = snakeCase
     , omitNothingFields = True
@@ -29,36 +29,40 @@ data Command
   | Turn Turn
   deriving (Eq, Show, Generic)
 
+type TaggedCommand = GTagged "command" TaggedOptions
+
 instance ToKeyMap Command where
-  toSeries = genericToSeries (options "" (Just "command"))
-  toPairs = genericToPairs (options "" (Just "command"))
+  toSeries = genericToSeries @TaggedCommand (options "")
+  toPairs = genericToPairs @TaggedCommand (options "")
 
 instance ToJSON Command where
-  toJSON = genericToJSON (options "" (Just "command"))
+  toJSON = genericToJSON @TaggedCommand (options "")
 
 instance FromJSON Command where
-  parseJSON = genericParseJSON (options "" (Just "command"))
+  parseJSON = genericParseJSON @TaggedCommand (options "")
 
 instance ToSchema Command where
-  declareNamedSchema = genericDeclareNamedSchema (options "" (Just "command"))
+  declareNamedSchema = genericDeclareNamedSchema @TaggedCommand (options "")
 
 instance SchemaDetails Command
 
 newtype Distance = MkDistance {distance :: Maybe Int}
   deriving (Eq, Show, Generic)
 
+type UntaggedDistance = GUntagged TaggedOptions
+
 instance ToKeyMap Distance where
-  toSeries = genericToSeries (options "" Nothing)
-  toPairs = genericToPairs (options "" Nothing)
+  toSeries = genericToSeries @UntaggedDistance (options "")
+  toPairs = genericToPairs @UntaggedDistance (options "")
 
 instance ToJSON Distance where
-  toJSON = genericToJSON (options "" Nothing)
+  toJSON = genericToJSON @UntaggedDistance (options "")
 
 instance FromJSON Distance where
-  parseJSON = genericParseJSON (options "" Nothing)
+  parseJSON = genericParseJSON @UntaggedDistance (options "")
 
 instance ToSchema Distance where
-  declareNamedSchema = genericDeclareNamedSchema (options "" Nothing)
+  declareNamedSchema = genericDeclareNamedSchema @UntaggedDistance (options "")
 
 instance SchemaDetails Distance
 
@@ -68,18 +72,20 @@ data Turn
   | TurnBack
   deriving (Eq, Show, Generic)
 
+type TaggedTurn = GTagged "direction" TaggedOptions
+
 instance ToKeyMap Turn where
-  toSeries = genericToSeries (options "Turn" (Just "direction"))
-  toPairs = genericToPairs (options "Turn" (Just "direction"))
+  toSeries = genericToSeries @TaggedTurn (options "Turn")
+  toPairs = genericToPairs @TaggedTurn (options "Turn")
 
 instance ToJSON Turn where
-  toJSON = genericToJSON (options "Turn" (Just "direction"))
+  toJSON = genericToJSON @TaggedTurn (options "Turn")
 
 instance FromJSON Turn where
-  parseJSON = genericParseJSON (options "Turn" (Just "direction"))
+  parseJSON = genericParseJSON @TaggedTurn (options "Turn")
 
 instance ToSchema Turn where
-  declareNamedSchema = genericDeclareNamedSchema (options "Turn" (Just "direction"))
+  declareNamedSchema = genericDeclareNamedSchema @TaggedTurn (options "Turn")
 
 instance SchemaDetails Turn
 

fourmolu.yaml

@@ -1 +1,78 @@
+# Number of spaces per indentation step
 indentation: 2
+
+# Max line length for automatic line breaking
+column-limit: none
+
+# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)
+function-arrows: trailing
+
+# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)
+comma-style: leading
+
+# Styling of import/export lists (choices: leading, trailing, or diff-friendly)
+import-export-style: diff-friendly
+
+# Rules for grouping import declarations
+import-grouping: legacy
+
+# Whether to full-indent or half-indent 'where' bindings past the preceding body
+indent-wheres: false
+
+# Whether to leave a space before an opening record brace
+record-brace-space: true
+
+# Number of spaces between top-level declarations
+newlines-between-decls: 1
+
+# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)
+haddock-style: multi-line
+
+# How to print module docstring
+haddock-style-module: null
+
+# Where to put docstring comments in function signatures (choices: auto, leading, or trailing)
+haddock-location-signature: auto
+
+# Styling of let blocks (choices: auto, inline, newline, or mixed)
+let-style: auto
+
+# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)
+in-style: right-align
+
+# Styling of if-statements (choices: indented or hanging)
+if-style: indented
+
+# Whether to put parentheses around a single constraint (choices: auto, always, or never)
+single-constraint-parens: always
+
+# Whether to put parentheses around a single deriving class (choices: auto, always, or never)
+single-deriving-parens: always
+
+# Whether to sort constraints
+sort-constraints: false
+
+# Whether to sort derived classes
+sort-derived-classes: false
+
+# Whether to sort deriving clauses
+sort-deriving-clauses: false
+
+# Whether to place section operators (those that are infixr 0, such as $) in trailing position, continuing the expression indented below
+trailing-section-operators: true
+
+# Output Unicode syntax (choices: detect, always, or never)
+unicode: never
+
+# Give the programmer more choice on where to insert blank lines
+respectful: true
+
+# Fixity information for operators
+fixities: []
+
+# Module reexports Fourmolu should know about
+reexports:
+  - module Prelude exports "base" Data.Function
+
+# Modules defined by the current Cabal package for import grouping
+local-modules:    []