我正在尝试为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
但是,我不确定如何为Grouping1 JSONTypeF
ADT定义实例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
答案 0 :(得分: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