Last active
December 26, 2015 20:38
-
-
Save fimad/7209668 to your computer and use it in GitHub Desktop.
I needed some way of working with arbitrarily deep stacks of arbitrary types for my current project. This is what I came up with. I thought it was pretty neat so I figured I'd share it.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE FlexibleContexts #-} | |
| {-# LANGUAGE FlexibleInstances #-} | |
| {-# LANGUAGE MultiParamTypeClasses #-} | |
| {-# LANGUAGE OverlappingInstances #-} | |
| {-# LANGUAGE TypeOperators #-} | |
| -- An example of how to have an arbitrary stack of types, while still allowing | |
| -- for easy querying and modifying the value at arbitrary depths of the stack. | |
| -- | |
| -- While having multiple of the same type in the stack still type checks, the | |
| -- value that is closer to the bottom of the stack is essentially hidden by the | |
| -- type that is higher up. | |
| -- Types l and i being an instance of Label, means that the type i is contained | |
| -- in the type l. | |
| class Label l i where | |
| get :: l -> i | |
| modify :: (i -> i) -> l -> l | |
| put :: i -> l -> l | |
| put value = modify (const value) | |
| -- Our actual data type that glues together two different types. This is | |
| -- basically a list of Types, the outer type is the one that is readily | |
| -- available, while the inner type is itself some wrapped up type. | |
| data outer :*: inner = outer :*: inner | |
| infixr 7 :*: | |
| -- Base case; handles operations where the outer type is the same as the type | |
| -- that the Label is to query/modify. | |
| instance Label (a :*: b) a where | |
| get (a :*: _) = a | |
| modify f (a :*: b) = f a :*: b | |
| -- Recursive case; conceptually strips off layers of the (:*:) type until the | |
| -- desired type is the same as the outer type. | |
| instance (Label b c) => Label (a :*: b) c where | |
| get (_ :*: inner) = get inner | |
| modify f (a :*: b) = a :*: modify f b | |
| -- Examples | |
| labelOne :: Int :*: Bool :*: [Int] :*: () | |
| labelOne = 1 :*: True :*: [1,2,3] :*: () | |
| labelTwo :: Bool :*: Maybe Int :*: Int :*: () | |
| labelTwo = True :*: Nothing :*: 2 :*: () | |
| --getLabel labelOne :: Int -- returns 1 | |
| --getLabel labelOne :: Bool -- returns True | |
| --getLabel labelOne :: Double -- Type error | |
| sumLabels :: (Label a Int, Label b Int) => a -> b -> Int | |
| sumLabels a b = get a + get b | |
| --sumLabels labelOne labelTwo -- returns 3 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment