Skip to content

toPairs :: TypeRepMap f -> [(SomeTypeRep, WrapTypeable f)] #69

@akhra

Description

@akhra

Currently we can get the first half of this via keys and the second via toList, but I see no permanent guarantee that those have the same ordering (it's implied by the internal structure, but we're explicitly not supposed to rely on that).

Motivation: if your f includes an existential wrapper witnessing a typeclass, you can map across the elements of TypeRepMap f and generate a monomorphic result. Paired with the keys, this can become a regular Map. My immediate use case is a ToJSON instance:

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Main where

import Control.Arrow ((***))
import qualified Data.Map as M
import Data.Aeson
import Data.Functor.Compose
import Data.Functor.Identity
import Data.TypeRepMap

-- With the proposed function, these imports go away
import Type.Reflection (SomeTypeRep(..))
import Data.TypeRepMap.Internal (toTriples, anyToTypeRep, wrapTypeable, fromAny)
import GHC.Types (Any)

-- proposed addition to Data.TypeRepMap
toPairs :: TypeRepMap f -> [(SomeTypeRep, WrapTypeable f)]
toPairs = map toPair . toTriples
  where
  toPair :: (a, Any, Any) -> (SomeTypeRep, WrapTypeable f)
  toPair (_, v, k) =
    ( SomeTypeRep (anyToTypeRep k)
    , wrapTypeable (anyToTypeRep k) (fromAny v)
    )

-- motivation
data Aesonic a where
  Aesonic :: ToJSON a => a -> Aesonic a

instance ToJSON (Aesonic a) where
  toJSON (Aesonic a) = toJSON a
  toEncoding (Aesonic a) = toEncoding a

type Aesonic1 f = Compose f Aesonic

wrapTypeableToJSON :: ToJSON1 f => WrapTypeable (Aesonic1 f) -> Value
wrapTypeableToJSON (WrapTypeable x) = toJSON1 $ getCompose x

instance ToJSON1 f => ToJSON (TypeRepMap (Aesonic1 f)) where
  toJSON = toJSON . M.fromList . fmap go . toPairs
    where go = show *** wrapTypeableToJSON @f

-- proof of concept
aesonic :: TypeRepMap Aesonic
aesonic = insert (Aesonic (5::Int)) $ one (Aesonic True)

lifted :: TypeRepMap (Aesonic1 Identity)
lifted = hoist (Compose . Identity) aesonic

main :: IO ()
main = print $ encode lifted
-- >>> main
-- "{\"Int\":5,\"Bool\":true}"

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type
    No fields configured for issues without a type.

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions