OverlappingInstance workarounds
{-# LANGUAGE CPP #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} | |
{-# LANGUAGE DataKinds, GADTs, KindSignatures, TypeOperators, UndecidableInstances #-} | |
#if __GLASGOW_HASKELL__ < 708 | |
#error "requires GHC 7.10 or newer" | |
#endif | |
module Main (main) where | |
import Data.Type.Equality | |
import Unsafe.Coerce | |
import qualified Data.Text as T | |
------------------------------------------------------------------------------- | |
-- OverlappingInstances | |
------------------------------------------------------------------------------- | |
-- | Example class counting things | |
-- | |
-- With special instance for 'String' which counts words, not characters | |
class Count a where | |
count :: a -> Int | |
countListDefault :: [a] -> Int | |
countListDefault = length | |
instance {-# OVERLAPPABLE #-} Count [a] where | |
count = countListDefault | |
-- This requires @FlexibleInstances@ | |
instance {-# OVERLAPPING #-} Count [Char] where | |
count = length . words | |
-- | | |
-- >>> test1 | |
-- 2 | |
test1 :: Int | |
test1 = count "foo bar" | |
-- | | |
-- >>> test2 | |
-- 3 | |
test2 :: Int | |
test2 = count [True, False, True] | |
{- | |
Polymorphic use | |
> poly :: [a] -> Int | |
> poly = count | |
is problematic: | |
Overlapping instances for Count [a] arising from a use of ‘count’ | |
Matching instances: | |
instance [overlappable] Count [a] -- Defined at overlap.hs:13:31 | |
instance [overlapping] Count [Char] -- Defined at overlap.hs:17:30 | |
-} | |
------------------------------------------------------------------------------- | |
-- Incoherent instances | |
------------------------------------------------------------------------------- | |
class CountI a where | |
countI :: a -> Int | |
instance CountI [a] where | |
countI = length | |
instance {-# INCOHERENT #-} CountI [Char] where | |
countI = length . words | |
-- | | |
-- >>> testI_1 | |
-- 2 | |
testI_1 :: Int | |
testI_1 = countI "foo bar" | |
-- | | |
-- >>> testI_2 | |
-- 3 | |
testI_2 :: Int | |
testI_2 = countI [True, False, True] | |
{- | |
Now we can write 'polyI' function. And it uses generic [a] instance. | |
The rules are somehow complicated. It's chosen because the rule | |
"If exactly one non-incoherent candidate remains, select it." | |
apply. | |
See <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#overlapping-instances> | |
-} | |
-- | | |
-- >>> polyI "foo bar" | |
-- 7 | |
polyI :: [a] -> Int | |
polyI = countI | |
-- | Note that we can defer the selection of instance: | |
-- | |
-- >>> polyI' "foo bar" | |
-- 2 | |
polyI' :: CountI [a] => [a] -> Int | |
polyI' = countI | |
-- This scales also if we wan't to add more "special" instances | |
-- | |
-- /Note:/ that polyI still works. | |
instance {-# INCOHERENT #-} CountI [Int] where | |
countI = sum | |
intlist :: [Int] | |
intlist = [1..4] | |
-- | | |
-- >>> exampleSumI | |
-- 10 | |
exampleSumI :: Int | |
exampleSumI = countI intlist | |
--------------------------------------------------------------------------------- | |
-- Read/Show approach | |
------------------------------------------------------------------------------- | |
{- | |
This is Haskell98 definition, which is good thing. | |
But there are two problems: | |
* class definition is more complicated | |
* Need to define instances for Char and Bool, yet we don't reealy need them. | |
Generally we have to define instances for each element type we might use. | |
It's not a problem for classes where per element instances are meaningful, | |
but maybe not for our 'Count'. | |
-} | |
class CountRS a where | |
countRS :: a -> Int | |
countRS _ = 1 | |
countRSList :: [a] -> Int | |
countRSList = countListDefault | |
instance CountRS Char where | |
countRSList = length . words | |
instance CountRS a => CountRS [a] where | |
countRS = countRSList | |
instance CountRS Bool | |
-- | | |
-- >>> testRS_1 | |
-- 2 | |
testRS_1 :: Int | |
testRS_1 = countRS "foo bar" | |
-- | | |
-- >>> testRS_2 | |
-- 3 | |
testRS_2 :: Int | |
testRS_2 = countRS [True, False, True] | |
-- | | |
-- >>> polyRS "foo bar" | |
-- 7 | |
polyRS :: [a] -> Int | |
polyRS = countListDefault | |
-- | | |
-- >>> polyRS' "foo bar" | |
-- 2 | |
polyRS' :: CountRS a => [a] -> Int | |
polyRS' = countRS | |
-- Adding special case for [Int] works as well: | |
-- This scales also if we wan't to add more "special" instances | |
-- | |
-- /Note:/ that polyI still works. | |
instance CountRS Int where | |
countRSList = sum | |
-- | | |
-- >>> exampleSumRS | |
-- 10 | |
exampleSumRS :: Int | |
exampleSumRS = countRS intlist | |
-- Adding special case for some other container, e.g. @Maybe Int@ | |
-- would require adding new member to the class. | |
------------------------------------------------------------------------------- | |
-- Data.Type.Equality | |
------------------------------------------------------------------------------- | |
-- Type level equality approach | |
-- | |
-- Con: requires many extensions | |
class CountE a where | |
countE :: a -> Int | |
instance SBoolI (a == Char) => CountE [a] where | |
countE = case sbool :: SBool (a == Char) of | |
STrue -> gcastWith (eqToRefl :: a :~: Char) $ length . words | |
SFalse -> countListDefault | |
eqToRefl :: forall a b. (a == b) ~ 'True => a :~: b | |
eqToRefl = unsafeCoerce (Refl :: () :~: ()) | |
-- | | |
-- >>> testE_1 | |
-- 2 | |
testE_1 :: Int | |
testE_1 = countE "foo bar" | |
-- | | |
-- >>> testE_2 | |
-- 3 | |
testE_2 :: Int | |
testE_2 = countE [True, False, True] | |
-- | | |
-- >>> polyE "foo bar" | |
-- 7 | |
polyE :: [a] -> Int | |
polyE = countListDefault | |
-- | | |
-- >>> polyE' "foo bar" | |
-- 2 | |
polyE' :: SBoolI (a == Char) => [a] -> Int | |
polyE' = countE | |
-- | We have ability to write function which could accept all lists, | |
-- except @[Char] ~ String@ | |
-- | |
-- >>> polyE'' [(), (), ()] | |
-- 3 | |
-- | |
-- > polyE'' "foo" | |
-- <interactive>:55:1: | |
-- Couldn't match type ‘'True’ with ‘'False’ | |
polyE'' :: (a == Char) ~ 'False => [a] -> Int | |
polyE'' = countE | |
-- Now it's relatively easy to add special treatment of 'Maybe Int' instance | |
-- | | |
-- >>> countE (Just 'a') | |
-- 1 | |
-- | |
-- >>> countE (Just (5 :: Int)) | |
-- 5 | |
instance SBoolI (a == Int) => CountE (Maybe a) where | |
countE = case sbool :: SBool (a == Int) of | |
STrue -> gcastWith (eqToRefl :: a :~: Int) $ maybe 0 id | |
SFalse -> maybe 0 (const 1) | |
-- OTOH it's requires change of CountE [a] definition to add special treatment | |
-- of [a] | |
------------------------------------------------------------------------------- | |
-- Bonus, when you don't care about containers: | |
------------------------------------------------------------------------------- | |
class CountT a where | |
countT :: a -> Int | |
-- | The only valid instance for lists is lists of chars | |
instance a ~ Char => CountT [a] where | |
countT = length . words | |
instance CountT T.Text where | |
countT = length . T.words | |
-- | | |
-- >>> testT_1 | |
-- 2 | |
testT_1 :: Int | |
testT_1 = countT "foo bar" | |
{- | |
> testT_2 :: Int | |
> testT_2 = countT [True, False, True] | |
overlap.hs:284:11: | |
Couldn't match type ‘Bool’ with ‘Char’ | |
-} | |
-- | | |
-- >>> testT_3 | |
-- 3 | |
testT_3 :: Int | |
testT_3 = countT $ T.pack "foo bar baz" | |
------------------------------------------------------------------------------- | |
-- singgleton Bool | |
------------------------------------------------------------------------------- | |
data SBool (b :: Bool) where | |
STrue :: SBool 'True | |
SFalse :: SBool 'False | |
class SBoolI b where sbool :: SBool b | |
instance SBoolI 'True where sbool = STrue | |
instance SBoolI 'False where sbool = SFalse | |
------------------------------------------------------------------------------- | |
-- Main | |
------------------------------------------------------------------------------- | |
main :: IO () | |
main = pure () |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment