/
Internal.purs
197 lines (157 loc) · 5.75 KB
/
Internal.purs
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
-- | A key has an associated type which is one of: number, date, string, or array.
-- |
-- | NOTE: Binary keys aren't supported yet.
module Database.IndexedDB.IDBKey.Internal
( Key
, class IDBKey, toKey , fromKey , unsafeFromKey
, none
) where
import Prelude
import Control.Alt ((<|>))
import Control.Monad.Except (ExceptT(..), runExceptT)
import Data.Date as Date
import Data.DateTime (DateTime(..), Time(..))
import Data.Either (Either(..), either, isRight)
import Data.Enum (fromEnum, toEnum)
import Data.Foreign as Foreign
import Data.Foreign (Foreign, F)
import Data.Function.Uncurried as Fn
import Data.Function.Uncurried (Fn2, Fn4, Fn7)
import Data.Identity (Identity(..))
import Data.List.NonEmpty (NonEmptyList(..))
import Data.List.Types (List(..))
import Data.Maybe (Maybe(..))
import Data.NonEmpty (NonEmpty(..))
import Data.Nullable (Nullable, toNullable)
import Data.Time as Time
import Data.Traversable (traverse)
newtype Key = Key Foreign
--------------------
-- INTERFACES
--
-- | Interface describing a key. Use the `unsafeFromKey` to convert a key
-- | to a known type (e.g if you only strings as keys, or perfectly knows the
-- | type of a given key).
class IDBKey a where
toKey :: a -> Key
fromKey :: Key -> F a
unsafeFromKey :: Key -> a
none :: Maybe Key
none =
Nothing
--------------------
-- INSTANCES
--
instance eqKey :: Eq Key where
eq a b = (runExceptT >>> runIdentity >>> isRight) $
eq <$> ((fromKey a) :: F Int) <*> fromKey b
<|>
eq <$> ((fromKey a) :: F Number) <*> fromKey b
<|>
eq <$> ((fromKey a) :: F String) <*> fromKey b
<|>
eq <$> ((fromKey a) :: F DateTime) <*> fromKey b
<|>
eq <$> ((fromKey a) :: F (Array Key)) <*> fromKey b
where
runIdentity :: forall a. Identity a -> a
runIdentity (Identity x) = x
instance ordKey :: Ord Key where
compare a b = (runExceptT >>> runIdentity >>> either (const LT) id) $
compare <$> ((fromKey a) :: F Int) <*> fromKey b
<|>
compare <$> ((fromKey a) :: F Number) <*> fromKey b
<|>
compare <$> ((fromKey a) :: F String) <*> fromKey b
<|>
compare <$> ((fromKey a) :: F DateTime) <*> fromKey b
<|>
compare <$> ((fromKey a) :: F (Array Key)) <*> fromKey b
where
runIdentity :: forall a. Identity a -> a
runIdentity (Identity x) = x
instance showKey :: Show Key where
show a = (runExceptT >>> format) $
(show <$> (fromKey a :: F Int))
<|>
(show <$> (fromKey a :: F Number))
<|>
(show <$> (fromKey a :: F String))
<|>
(show <$> (fromKey a :: F DateTime))
<|>
(show <$> (fromKey a :: F (Array Key)))
where
format :: forall a. Identity (Either a String) -> String
format (Identity x) =
either (const "(Key)") (\s -> "(Key " <> s <> ")") x
instance idbKeyKey :: IDBKey Key where
toKey = id
fromKey = pure
unsafeFromKey = id
instance idbKeyForeign :: IDBKey Foreign where
toKey = Key
fromKey (Key f) = pure f
unsafeFromKey (Key f) = f
instance idbKeyInt :: IDBKey Int where
toKey = Foreign.toForeign >>> Key
fromKey (Key f) = Foreign.readInt f
unsafeFromKey (Key f) = Foreign.unsafeFromForeign f
instance idbKeyNumber :: IDBKey Number where
toKey = Foreign.toForeign >>> Key
fromKey (Key f) = Foreign.readNumber f
unsafeFromKey (Key f) = Foreign.unsafeFromForeign f
instance idbKeyString :: IDBKey String where
toKey = Foreign.toForeign >>> Key
fromKey (Key f) = Foreign.readString f
unsafeFromKey (Key f) = Foreign.unsafeFromForeign f
instance idbKeyDate :: IDBKey DateTime where
toKey (DateTime d t) = Key $ Fn.runFn7 _dateTimeToForeign
(fromEnum $ Date.year d)
(fromEnum $ Date.month d)
(fromEnum $ Date.day d)
(fromEnum $ Time.hour t)
(fromEnum $ Time.minute t)
(fromEnum $ Time.second t)
(fromEnum $ Time.millisecond t)
fromKey (Key f) = Fn.runFn4 _readDateTime dateTime dateTimeF dateTimeE f
unsafeFromKey (Key f) = Fn.runFn2 _unsafeReadDateTime dateTime f
instance idbKeyArray :: IDBKey a => IDBKey (Array a) where
toKey = Foreign.toForeign >>> Key
fromKey (Key f) = Foreign.readArray f >>= traverse (Key >>> fromKey)
unsafeFromKey (Key f) = map unsafeFromKey (Foreign.unsafeFromForeign f)
-- FFI constructor to build a DateTime from years, months, days, hours, minutes, seconds and millis
dateTime
:: Int -- ^ years
-> Int -- ^ months
-> Int -- ^ days
-> Int -- ^ hours
-> Int -- ^ minutes
-> Int -- ^ seconds
-> Int -- ^ milliseconds
-> Nullable DateTime
dateTime y m d h mi s ms =
toNullable $ DateTime
<$> (Date.canonicalDate <$> toEnum y <*> toEnum m <*> toEnum d)
<*> (Time <$> toEnum h <*> toEnum mi <*> toEnum s <*> toEnum ms)
-- FFI constructor to convert a JS `Date` into a successful `F DateTime`
dateTimeF
:: DateTime
-> F DateTime
dateTimeF =
Right >>> Identity >>> ExceptT
-- FFI constructor to convert a string into an errored `F DateTime`
dateTimeE
:: String
-> F DateTime
dateTimeE =
Foreign.TypeMismatch "Date" >>> flip NonEmpty Nil >>> NonEmptyList >>> Left >>> Identity >>> ExceptT
--------------------
-- FFI
--
foreign import _dateTimeToForeign
:: Fn7 Int Int Int Int Int Int Int Foreign
foreign import _readDateTime
:: Fn4 (Int -> Int -> Int -> Int -> Int -> Int -> Int -> Nullable DateTime) (DateTime -> F DateTime) (String -> F DateTime) Foreign (F DateTime)
foreign import _unsafeReadDateTime
:: Fn2 (Int -> Int -> Int -> Int -> Int -> Int -> Int -> Nullable DateTime) Foreign DateTime