Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Open
akhra opened this issue Mar 26, 2019 · 5 comments
Open

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

akhra opened this issue Mar 26, 2019 · 5 comments

Comments

@akhra
Copy link

akhra commented Mar 26, 2019

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}"
@int-index
Copy link
Collaborator

You can extract SomeTypeRep from WrapTypeable, can you not?

@akhra
Copy link
Author

akhra commented Apr 9, 2019

Can I? Type.Reflection is still mostly voodoo to me. I assumed that since they're stored separately in the TypeRepMap (trAnys vs. trKeys), they're not trivially convertible.

@o1lo01ol1o
Copy link

It might be sensible to have aeson, serialize, etc witnesses defined like this inside the Internal module. I was about to attempt something similar.

@akhra
Copy link
Author

akhra commented Apr 9, 2019

Ideally those would go in one or more separate orphans modules to avoid contagious dependencies. Pragmatically that might be more hassle than it's worth, and in any case I'm certainly +1 for centralizing them.

Actually... not able to test this now, but could something like this be the basis of a more abstract mechanism?

data Witnessing c a where
  Witnessing :: c a => a -> Witnessing c a

witnessed :: c a => (a -> b) -> Witnessing c a -> b
witnessed f (Witnessing x) = f x

@int-index
Copy link
Collaborator

Can I? Type.Reflection is still mostly voodoo to me. I assumed that since they're stored separately in the TypeRepMap (trAnys vs. trKeys), they're not trivially convertible.

The elements of trAnys are the values, and the elements of trKeys are the TypeReps. Indeed, they are not convertible, but both of them end up in WrapTypeable. If you look at the definition of WrapTypeable, you will see it contains two fields:

data WrapTypeable f where
WrapTypeable :: Typeable a => f a -> WrapTypeable f

The first one is Typeable a (which comes from trKeys), the second one is f a (which comes from trAnys). So if you want to get SomeTypeRep out of it, you just need to make use of the Typeable a field:

extract :: WrapTypeable f -> SomeTypeRep
extract (WrapTypeable (_ :: f a)) = SomeTypeRep (typeRep @a)

Alternatively, using the someTypeRep helper function:

extract :: WrapTypeable f -> SomeTypeRep
extract (WrapTypeable p) = someTypeRep p

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

3 participants