创建具有Contravariant、Divisible和Decidable的ADT实例

Question

我正在尝试为Grouping1创建一个实例

import Data.Discrimination
import Data.Discrimination.Grouping (hashing)
import Data.Text (Text)
import Data.Vector (Vector)
import GHC.Generics
import GHC.Exts (toList, fromList)
import qualified Data.HashMap.Lazy as HashMap

data JSONPrimitive = JString | JNumber | JBool | JNull deriving (Show, Eq, Generic, Hashable, Grouping)
data JSONTypeF a =
    JObject (HashMap.HashMap Text a)
  | JArray (Maybe a)
  | JInvalidArray (Vector a)
  | JPrimitive JSONPrimitive
  deriving (Show, Eq, Functor, Generic)

instance (Grouping a, Eq a, Hashable a) => Grouping1 (HashMap.HashMap a) where
  grouping1 g = contramap toList $ grouping1 (divide id grouping g)
instance Grouping1 Vector where
  grouping1 g = contramap toList (grouping1 g)
instance Grouping Text where
  grouping = hashing

但是，我不确定如何定义JSONTypeF ADT的实例Grouping1 JSONTypeF。

instance Grouping1 JSONTypeF where
  grouping1 g = contramap fun _
    where
      fun (JObject map) = undefined
      fun (JArray ary) = undefined
      fun (JInvalidArray ary) = undefined
      fun (JPrimitive primitive) = undefined

Answer 1

我用很难的方式做了，没有任何实例，尽管choose的一些嵌套可能会使它成为可能。

instance Grouping1 JSONTypeF where
  grouping1 g = Group $ \k -> do
    kb <- flip getGroup
    kc <- flip getGroup
    kd <- flip getGroup
    ke <- flip getGroup
    pure (\obj ->
            case obj of
              (JObject map) -> kb map
              (JArray ary) -> kc ary
              (JInvalidArray ary) -> kd ary
              (JPrimitive primitive) -> ke primitive
            ) k