Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
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