Skip to content

Instantly share code, notes, and snippets.

@avh4
Last active December 21, 2019 19:10
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save avh4/59676bac72148df38057a89266f1213e to your computer and use it in GitHub Desktop.
Save avh4/59676bac72148df38057a89266f1213e to your computer and use it in GitHub Desktop.
Haskell type params subset
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE Rank2Types #-}
data Never
class MapAll t where
type GetA t
type GetB t
type SetA a' t
type SetB b' t
-- m ::
-- (a1 -> a2) -> (b1 -> b2)
-- -> t -> SetA a1 a2 (SetB b1 b2 t)
ma :: GetA t ~ a1 => (a1 -> a2) -> t -> SetA a2 t
mb :: GetB t ~ b1 => (b1 -> b2) -> t -> SetB b2 t
data ABC a b c = ABC a b c deriving Show
instance MapAll (ABC a1 b1 c1) where
type GetA (ABC a1 b1 c1) = a1
type GetB (ABC a1 b1 c1) = b1
type SetA a2 (ABC a1 b1 c1) = ABC a2 b1 c1
type SetB b2 (ABC a1 b1 c1) = ABC a1 b2 c1
--m fa fb fc (ABC a b c) = ABC (fa a) (fb b) (fc c)
ma fa (ABC a b c) = ABC (fa a) b c
mb fb (ABC a b c) = ABC a (fb b) c
data AC a c = AC a c deriving Show
instance MapAll (AC a1 c1) where
type GetA (AC a1 c1) = a1
type GetB (AC a1 c1) = Int -- XXX must not hardcode this
type SetA a2 (AC a1 c1) = AC a2 c1
type SetB b2 (AC a1 c1) = AC a1 c1
--m fa _ fc (AC a c) = AC (fa a) (fc c)
ma fa (AC a c) = AC (fa a) c
mb _ (AC a c) = AC a c
data Two e f = Two e f deriving (Show)
--deriving instance (Show (Apply e a b c), Show (Apply f a b c)) => Show (Two e f a b c)
instance (MapAll e, MapAll f, GetA e ~ GetA f, GetB e ~ GetB f) => MapAll (Two e f) where
type GetA (Two e f) = GetA e
type GetB (Two e f) = GetB e
type SetA a2 (Two e f) = Two (SetA a2 e) (SetA a2 f)
type SetB b2 (Two e f) = Two (SetB b2 e) (SetB b2 f)
--m fa fb fc (Two e f) = Two (m fa fb fc e) (m fa fb fc f)
ma fa (Two e f) = Two (ma fa e) (ma fa f)
mb fb (Two e f) = Two (mb fb e) (mb fb f)
x :: (Two (ABC Int Int Int) (AC Int Int))
x = Two (ABC 1 2 3) (AC 4 5 )
y :: (Two (ABC Int Int Int) (AC Int Int))
y = ma (+ 1) x --m (+ 1) (+ 1) (+ 1) x
main = putStrLn (show $ ma show y)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment