-
Notifications
You must be signed in to change notification settings - Fork 1
Expand file tree
/
Copy pathMultiplicity.hs
More file actions
89 lines (68 loc) · 2.02 KB
/
Multiplicity.hs
File metadata and controls
89 lines (68 loc) · 2.02 KB
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
module Main
( main
) where
import Control.Monad.Cont (Cont, cont, runCont)
import Data.Functor.Identity (Identity (Identity), runIdentity)
import Data.List.NonEmpty (NonEmpty ((:|)))
-- type L a = forall r. (Zero r, Append r) => Cont r a
-- type N a = forall r. Append r => Cont r a
-- type O a = forall r. Zero r => Cont r a
-- type I a = forall r. Cont r a
class One l a | l -> a where
one :: a -> l
class Zero l where
zero :: l
class Append l where
append :: l -> l -> l
instance One [a] a where
one = (: [])
instance One (NonEmpty a) a where
one = (:| [])
instance One (Maybe a) a where
one = Just
instance One (Identity a) a where
one = Identity
instance Zero [a] where
zero = []
instance Zero (Maybe a) where
zero = Nothing
instance Append [a] where
append = (++)
instance Append (NonEmpty a) where
append = (<>)
class From l r a | l -> a where
from :: l -> Cont r a
instance (Zero r, Append r) => From [a] r a where
from l = cont $ \f -> foldr (append . f) zero l
instance Append r => From (NonEmpty a) r a where
from l = cont $ \f -> foldr1 append $ f <$> l
instance Zero r => From (Maybe a) r a where
from l = cont $ \f -> maybe zero f l
instance From (Identity a) r a where
from = pure . runIdentity
collect :: One l a => Cont l a -> l
collect = flip runCont one
main :: IO ()
main = do
print . collect @[String] $ do
a <- from $ Identity "1"
b <- from $ "2" :| ["3"]
c <- from $ Just "4"
d <- from ["5", "6"]
pure $ a <> b <> c <> d
print . collect @(Maybe String) $ do
a <- from $ Identity "1"
c <- from $ Just "4"
pure $ a <> c
print . collect @(NonEmpty String) $ do
a <- from $ Identity "1"
b <- from $ "2" :| ["3"]
pure $ a <> b
print . collect @(Identity String) $ do
a <- from $ Identity "1"
pure $ a <> a