Last active
December 9, 2015 15:41
-
-
Save rraval/da741d1ec0f65e148127 to your computer and use it in GitHub Desktop.
A non-trivial identity function that is not bottom
This file contains hidden or 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 FlexibleInstances #-} | |
{-# LANGUAGE MultiParamTypeClasses #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE UndecidableInstances #-} | |
import Prelude hiding (id) | |
import Data.Char (chr, ord) | |
-- A simple typeclass with a single instance for `Char` that lets us return a | |
-- different `Char` than the one provided | |
class IsChar a where | |
next :: a -> a | |
instance IsChar Char where | |
next = chr . (+1) . ord | |
-- The typeclass to circumvent | |
class Identity a where | |
id :: a -> a | |
data HTrue | |
data HFalse | |
-- `flag` is either `HTrue` or `HFalse` depending on `CharPred a`. | |
class FlagIdentity flag a where | |
flagid :: flag -> a -> a | |
instance (IsChar a) => FlagIdentity HTrue a where | |
flagid _ a = next a | |
instance FlagIdentity HFalse a where | |
flagid _ a = a | |
type family CharPred a where | |
CharPred Char = HTrue | |
CharPred a = HFalse | |
-- the magic, lifted from https://wiki.haskell.org/GHC/AdvancedOverlap | |
instance (CharPred a ~ flag, FlagIdentity flag a) => Identity a where | |
id = flagid (undefined :: flag) | |
main = do | |
print $ id 'a' | |
print $ id True | |
print $ id (1 :: Int) -- GHC cant handle the dispatch based on the Num | |
-- typeclass alone without `FlexibleContexts` | |
-- Outputs: | |
-- 'b' | |
-- True | |
-- 1 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment