Skip to content

Instantly share code, notes, and snippets.

@gabiseabra
Last active July 21, 2021 01:18
Show Gist options
  • Select an option

  • Save gabiseabra/3203028c1f9ad818fc31efbf393d2d5b to your computer and use it in GitHub Desktop.

Select an option

Save gabiseabra/3203028c1f9ad818fc31efbf393d2d5b to your computer and use it in GitHub Desktop.
typeclass for unstacking of adts
{-# LANGUAGE
TypeFamilies
, FlexibleInstances
, UndecidableInstances
, FunctionalDependencies
#-}
module Garbage where
data Root m a = Root (m a)
class Layer m where
type Pop m :: * -> *
pop :: m a -> Pop m a
class Stack m0 m | m -> m0 where unstack :: m a -> m0 a
instance {-# OVERLAPPING #-} Stack m (Root m) where unstack (Root m) = m
instance {-# OVERLAPPABLE #-} (Layer m, Stack m0 (Pop m)) => Stack m0 m where unstack = unstack . pop
-- usage
data Id a = Id a
data T m a = T (m a)
instance Layer (T m) where type Pop (T m) = m; pop (T m) = m
test = unstack (T (T (T (Root (Id 1))))) -- = (Id 1)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment