blob: 8963b7cb1ca6fbdbd36a88d4c03d22b4aec4d321 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
{-# LANGUAGE TypeFamilies, FlexibleInstances, FlexibleContexts, UndecidableInstances,
MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module T10139 where
import GHC.Exts
import Data.Monoid
class Monoid v => Measured v a | a -> v where
_measure :: v -> a
data FingerTree v a = Dummy v a
singleton :: Measured v a => a -> FingerTree v a
singleton = undefined
class DOps a where
plus :: a -> D a -> a
type family D a :: *
type instance D (FingerTree (Size Int, v) (Sized a)) = [Diff (Normal a)]
type family Normal a :: *
data Diff a = Add Int a
newtype Sized a = Sized a
newtype Size a = Size a
-- This works:
{-
instance (Measured (Size Int, v) (Sized a), Coercible (Normal a) (Sized a)) => DOps (FingerTree (Size Int, v) (Sized a)) where
plus = foldr (\(Add index val) seq -> singleton ((coerce) val))
-}
-- This hangs:
instance (Measured (Size Int, v) (Sized a), Coercible (Normal a) (Sized a)) => DOps (FingerTree (Size Int, v) (Sized a)) where
plus = foldr (flip f)
where f _seq x = case x of
Add _index val -> singleton ((coerce) val)
|
