/
Maybe.hs
125 lines (101 loc) · 3.49 KB
/
Maybe.hs
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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverlappingInstances #-}
{-# OPTIONS -fno-warn-orphans #-}
{- OPTIONS -ddump-splices -}
-----------------------------------------------------------------------------
-- |
-- Module : Generics.EMGM.Data.Maybe
-- Copyright : (c) 2008, 2009 Universiteit Utrecht
-- License : BSD3
--
-- Maintainer : generics@haskell.org
-- Stability : experimental
-- Portability : non-portable
--
-- Summary: Generic representation and instances for 'Maybe'.
-----------------------------------------------------------------------------
module Generics.EMGM.Data.Maybe (
epMaybe,
conNothing,
conJust,
repMaybe,
frepMaybe,
frep2Maybe,
frep3Maybe,
bifrep2Maybe,
) where
import Generics.EMGM.Common
import Generics.EMGM.Functions.Collect
import Generics.EMGM.Functions.Everywhere
-----------------------------------------------------------------------------
-- Embedding-projection pair
-----------------------------------------------------------------------------
fromMaybe :: Maybe a -> Unit :+: a
fromMaybe Nothing = L Unit
fromMaybe (Just a) = R a
toMaybe :: Unit :+: a -> Maybe a
toMaybe (L Unit) = Nothing
toMaybe (R a) = Just a
-- | Embedding-projection pair for 'Maybe'.
epMaybe :: EP (Maybe a) (Unit :+: a)
epMaybe = EP fromMaybe toMaybe
-----------------------------------------------------------------------------
-- Representation values
-----------------------------------------------------------------------------
-- | Constructor description for 'Nothing'.
conNothing :: ConDescr
conNothing = ConDescr "Nothing" 0 [] Nonfix
-- | Constructor description for 'Just'.
conJust :: ConDescr
conJust = ConDescr "Just" 1 [] Nonfix
-- | Representation of 'Maybe' for 'frep'.
frepMaybe :: (Generic g) => g a -> g (Maybe a)
frepMaybe ra =
rtype
epMaybe
(rcon conNothing runit `rsum` rcon conJust ra)
-- | Representation of 'Maybe' for 'rep'.
repMaybe :: (Generic g, Rep g a) => g (Maybe a)
repMaybe =
frepMaybe rep
-- | Representation of 'Maybe' for 'frep2'.
frep2Maybe :: (Generic2 g) => g a b -> g (Maybe a) (Maybe b)
frep2Maybe ra =
rtype2
epMaybe epMaybe
(rcon2 conNothing runit2 `rsum2` rcon2 conJust ra)
-- | Representation of 'Maybe' for 'bifrep2'.
bifrep2Maybe :: (Generic2 g) => g a b -> g (Maybe a) (Maybe b)
bifrep2Maybe =
frep2Maybe
-- | Representation of 'Maybe' for 'frep3'.
frep3Maybe :: (Generic3 g) => g a b c -> g (Maybe a) (Maybe b) (Maybe c)
frep3Maybe ra =
rtype3
epMaybe epMaybe epMaybe
(rcon3 conNothing runit3 `rsum3` rcon3 conJust ra)
-----------------------------------------------------------------------------
-- Instance declarations
-----------------------------------------------------------------------------
instance (Generic g, Rep g a) => Rep g (Maybe a) where
rep = repMaybe
instance (Generic g) => FRep g Maybe where
frep = frepMaybe
instance (Generic2 g) => FRep2 g Maybe where
frep2 = frep2Maybe
instance (Generic3 g) => FRep3 g Maybe where
frep3 = frep3Maybe
instance Rep (Collect (Maybe a)) (Maybe a) where
rep = Collect (:[])
instance (Rep (Everywhere (Maybe a)) a) => Rep (Everywhere (Maybe a)) (Maybe a) where
rep = Everywhere app
where
app f x =
case x of
Nothing -> f Nothing
Just v1 -> f (Just (selEverywhere rep f v1))
instance Rep (Everywhere' (Maybe a)) (Maybe a) where
rep = Everywhere' ($)