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 | {-# LANGUAGE TypeOperators, MultiParamTypeClasses, FlexibleInstances, ViewPatterns, FunctionalDependencies #-}
import Data.Sequence
data a :- as = E | a :- as
class ViewL' a as | as -> a, as -> a where
viewl' :: as -> a :- as
instance ViewL' a [a] where
viewl' [] = E
viewl' (x:xs) = x :- xs
instance ViewL' a (Seq a) where
viewl' (viewl -> EmptyL) = E
viewl' (viewl -> x :< xs) = x :- xs
class Cons a as | as -> a, as -> a where
cons' :: a -> as -> as
nil :: as
instance Cons a [a] where
cons' x xs = x:xs
nil = []
instance Cons a (Seq a) where
cons' x xs = x <| xs
nil = empty
map' :: (ViewL' a as, Cons b bs) => (a -> b) -> as -> bs
map' _ (viewl' -> E) = nil
map' f (viewl' -> x :- xs) = f x `cons'` map' f xs
convert :: (ViewL' a as, Cons a bs) => as -> bs
convert = map' id
toList' :: Seq a -> [a]
toList' = convert
|
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 | {-# LANGUAGE TypeOperators, MultiParamTypeClasses, FlexibleInstances, ViewPatterns, FunctionalDependencies #-}
import Prelude hiding (map)
import qualified Data.Sequence as Seq
import Data.Sequence(Seq)
data a :< as = a :< as | NoViewL
data a :> as = as :> a | NoViewR
data End = End | NoEnd
class ViewL a as | as -> a where
viewL :: as -> a :< as
class (ViewL a as) => EndR a as | as -> a where
endR :: as -> End
instance ViewL a [a] where
viewL (x:xs) = x :< xs
viewL _ = NoViewL
instance EndR a [a] where
endR [] = End
endR _ = NoEnd
instance ViewL a (Seq a) where
viewL (Seq.viewl -> x Seq.:< xs) = x :< xs
viewL _ = NoViewL
instance EndR a (Seq a) where
endR (Seq.viewl -> Seq.EmptyL) = End
endR _ = NoEnd
class Nil as where
nil :: as
class Cons a as | as -> a where
(<:) :: a -> as -> as
instance Cons a [a] where
x <: xs = x:xs
instance Nil [a] where
nil = []
instance Cons a (Seq a) where
x <: xs = x Seq.<| xs
instance Nil (Seq a) where
nil = Seq.empty
map :: (ViewL a as, EndR a as, Cons b bs, Nil bs) => (a -> b) -> as -> bs
map _ (endR -> End) = nil
map f (viewL -> x :< xs) = f x <: map f xs
map' :: (ViewL a as, Cons b bs) => (a -> b) -> as -> bs
map' f (viewL -> x :< xs) = f x <: map' f xs
convert :: (ViewL a as, EndR a as, Cons a bs, Nil bs) => as -> bs
convert = map id
convert' :: (ViewL a as, Cons a bs) => as -> bs
convert' = map' id
toList :: (ViewL a as, EndR a as) => as -> [a]
toList = convert
toList' :: (ViewL a as) => as -> [a]
toList' = convert'
fromList :: (Cons a as, Nil as) => [a] -> as
fromList = convert
fromList' :: (Cons a as) => [a] -> as
fromList' = convert'
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | -- Default views could be specified with an inbuilt magic class, like this:
class View a av where
view :: a -> av
instance (ViewL a as) => View as (a :< as) where
view = viewL
-- ...or, for less complex cases,
instance View [a] (a :< as) where
view (x:xs) = x :< xs
-- the matched type specifies the expected type.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | -- Default views could be specified with an inbuilt magic class, like this:
class View a av where
view :: a -> av
instance (ViewL a as) => View as (a :< as) where
view = viewL
-- ...or, for less complex cases,
instance View [a] (a :< as) where
view (x:xs) = x :< xs
-- the matched type specifies the expected type.
|
1 2 3 4 5 6 7 8 9 | map' :: (ViewL a as, Cons b bs) => (a -> b) -> as -> bs
map' f (viewL -> x :< xs) = f x <: map' f xs
map' f (viewL -> NoViewL = error "attempt to map' a finite structure"
map' :: (ViewL a as, Cons b bs) => (a -> b) -> as -> bs
map' f (x :< xs) = f x <: map' f xs
map' f NoViewL = error "attempt to map' a finite structure"
|