Examples.hs

{- cabal:
build-depends: base, base-unicode-symbols
  , containers, containers-unicode-symbols
  , pretty-show
  , tasty, tasty-quickcheck, quickcheck-instances, tasty-smallcheck, smallcheck-series, tasty-hunit
  , aeson
default-extensions: UnicodeSyntax, BlockArguments, TupleSections, TypeApplications, PartialTypeSignatures, PatternSynonyms
  , LiberalTypeSynonyms, StandaloneDeriving
  , DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric
  , FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies
  , RankNTypes, DataKinds, PolyKinds, GADTs, ConstraintKinds, PolyKinds, KindSignatures, TypeOperators, TypeFamilies, TypeFamilyDependencies
ghc-options: -Wpartial-type-signatures -fdefer-typed-holes
-}

module Main where

import Data.Aeson hiding (Array)
import GHC.Generics
import Data.Foldable (traverse_)

defaultOptionsWithTagSingleConstructorsAndNoAllNullaryToStringTag = defaultOptions {tagSingleConstructors = True, allNullaryToStringTag = False}

defaultOptionsWithNoAllNullaryToStringTag = defaultOptions {allNullaryToStringTag = False}

defaultOptionsWithTagSingleConstructors = defaultOptions {tagSingleConstructors = True}

data Inner = Inner deriving (Generic, Show)
instance ToJSON Inner where toJSON = genericToJSON defaultOptions

data InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag = InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag deriving (Generic, Show)
instance ToJSON InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag where toJSON = genericToJSON defaultOptionsWithTagSingleConstructorsAndNoAllNullaryToStringTag

data InnerWithNoAllNullaryToStringTag = InnerWithNoAllNullaryToStringTag deriving (Generic, Show)
instance ToJSON InnerWithNoAllNullaryToStringTag where toJSON = genericToJSON defaultOptionsWithNoAllNullaryToStringTag

data InnerWithTagSingleConstructors = InnerWithTagSingleConstructors deriving (Generic, Show)
instance ToJSON InnerWithTagSingleConstructors where toJSON = genericToJSON defaultOptionsWithTagSingleConstructors

data Nested a = Nested a deriving (Generic, Show)

variantsOfOptions =
  [ defaultOptions
  , defaultOptionsWithNoAllNullaryToStringTag
  , defaultOptionsWithTagSingleConstructors
  , defaultOptionsWithTagSingleConstructorsAndNoAllNullaryToStringTag
  ]

data F = forall α. (Generic α, Show α, GToJSON' Value Zero (Rep α)) => F α

displaySerialization :: Options → F → String
displaySerialization options (F value) = show value ++ "\t" ++ (show . encode . genericToJSON options) value

type Array α = [α]

values =
  [ F (Nested Inner)
  , F (Nested ([ ] :: Array Inner))
  , F (Nested [Inner])
  , F (Nested [Inner, Inner])
  , F (Nested InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag)
  , F (Nested ([ ] :: Array InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag))
  , F (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag])
  , F (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag, InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag])
  , F (Nested InnerWithNoAllNullaryToStringTag)
  , F (Nested ([ ] :: Array InnerWithNoAllNullaryToStringTag))
  , F (Nested [InnerWithNoAllNullaryToStringTag])
  , F (Nested [InnerWithNoAllNullaryToStringTag, InnerWithNoAllNullaryToStringTag])
  , F (Nested InnerWithTagSingleConstructors)
  , F (Nested ([ ] :: Array InnerWithTagSingleConstructors))
  , F (Nested [InnerWithTagSingleConstructors])
  , F (Nested [InnerWithTagSingleConstructors, InnerWithTagSingleConstructors])
  ]

main ∷ IO ( )
main = do
  traverse_ putStrLn [displaySerialization options x | options <- variantsOfOptions, x <- values]