gdritter repos activitystreams-aeson / 31226fb
Added experimental Dynamic representation Getty Ritter 9 years ago
2 changed file(s) with 305 addition(s) and 2 deletion(s). Collapse all Expand all
+302
-0
Codec/ActivityStream/Dynamic.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE RankNTypes #-}
3
4 {-|
5 Module : Codec.ActivityStream.Dynamic
6 Description : A (more dynamic) interface to Activity Streams
7 Copyright : (c) Getty Ritter, 2014
8 Maintainer : gdritter@galois.com
9
10 This is an interface to ActivityStreams that simply wraps an underlying
11 @aeson@ Object, and exposes a set of (convenient) lenses to access the
12 values inside. If an @aeson@ object is wrapped in the respective wrapper,
13 it will contain the obligatory values for that type (e.g. an @Activity@
14 is guaranteed to have a @published@ date.)
15 -}
16
17 module Codec.ActivityStream.Dynamic
18 ( Lens'
19 -- * MediaLink
20 , MediaLink
21 , mlDuration
22 , mlHeight
23 , mlWidth
24 , mlURL
25 , mlRest
26 , makeMediaLink
27 -- * Object
28 , Object
29 , oAttachments
30 , oAuthor
31 , oContent
32 , oDisplayName
33 , oDownstreamDuplicates
34 , oId
35 , oImage
36 , oObjectType
37 , oPublished
38 , oSummary
39 , oUpdated
40 , oUpstreamDuplicates
41 , oURL
42 , oRest
43 , emptyObject
44 -- * Activity
45 , Activity
46 , acActor
47 , acContent
48 , acGenerator
49 , acIcon
50 , acId
51 , acPublished
52 , acProvider
53 , acTarget
54 , acTitle
55 , acUpdated
56 , acURL
57 , acVerb
58 , acRest
59 , makeActivity
60 -- * Collection
61 , Collection
62 , cTotalItems
63 , cItems
64 , cURL
65 , cRest
66 , makeCollection
67 ) where
68
69 import Data.Aeson ( FromJSON(..)
70 , ToJSON(..)
71 , Result(..)
72 , fromJSON
73 )
74 import qualified Data.Aeson as A
75 import Data.DateTime (DateTime)
76 import qualified Data.HashMap.Strict as HM
77 import Data.Maybe (fromJust)
78 import Data.Text (Text)
79
80 -- This way, we don't have to import lens... but we can still export lenses!
81
82 newtype Const a b = Const { fromConst :: a }
83 instance Functor (Const a) where fmap f (Const x) = Const x
84
85 -- We need these to write get and set
86 newtype Id a = Id { fromId :: a }
87 instance Functor Id where fmap f (Id x) = Id (f x)
88
89 -- | This is the same type alias as in @Control.Lens@, and so can be used
90 -- anywhere lenses are needed.
91 type Lens' a b = forall f. Functor f => (b -> f b) -> (a -> f a)
92
93 get :: Lens' a b -> a -> b
94 get lens a = fromConst (lens Const a)
95
96 set :: Lens' a b -> b -> a -> a
97 set lens x a = fromId (lens (const Id x) a)
98
99 makeLens :: (a -> b) -> (b -> a -> a) -> Lens' a b
100 makeLens get set f a = (`set` a) `fmap` f (get a)
101
102 fromJSON' :: FromJSON a => A.Value -> Maybe a
103 fromJSON' v = case fromJSON v of
104 Success a -> Just a
105 Error _ -> Nothing
106
107 -- Create a lens into an Aeson object wrapper that takes and
108 -- returns a Maybe value
109 makeAesonLensMb :: (FromJSON v, ToJSON v)
110 => Text -> Lens' c A.Object -> Lens' c (Maybe v)
111 makeAesonLensMb key fromObj = fromObj . lens
112 where lens = makeLens
113 (\ o -> HM.lookup key o >>= fromJSON')
114 (\ v o -> HM.insert key (toJSON (Just v)) o)
115
116
117 -- Create a lens into an Aeson object wrapper
118 makeAesonLens :: (FromJSON v, ToJSON v) => Text -> Lens' c A.Object -> Lens' c v
119 makeAesonLens key fromObj = fromObj . lens
120 where lens = makeLens
121 (\ o -> fromJust (HM.lookup key o >>= fromJSON'))
122 (\ v o -> HM.insert key (toJSON v) o)
123
124 data MediaLink = MediaLink { fromMediaLink :: A.Object } deriving (Eq, Show)
125
126 instance FromJSON MediaLink where
127 parseJSON (A.Object o) | HM.member "url" o = return (MediaLink o)
128 | otherwise = fail "..."
129 parseJSON _ = fail "..."
130
131 instance ToJSON MediaLink where
132 toJSON (MediaLink o) = A.Object o
133
134 mlRest :: Lens' MediaLink A.Object
135 mlRest = makeLens fromMediaLink (\ o' m -> m { fromMediaLink = o' })
136
137 mlDuration :: Lens' MediaLink (Maybe Int)
138 mlDuration = makeAesonLensMb "duration" mlRest
139
140 mlHeight :: Lens' MediaLink (Maybe Int)
141 mlHeight = makeAesonLensMb "height" mlRest
142
143 mlWidth :: Lens' MediaLink (Maybe Int)
144 mlWidth = makeAesonLensMb "width" mlRest
145
146 mlURL :: Lens' MediaLink Text
147 mlURL = makeAesonLens "url" mlRest
148
149 -- | Create a @MediaLink@ with just a @url@ property.
150 makeMediaLink :: Text -> MediaLink
151 makeMediaLink url = MediaLink (HM.insert "url" (toJSON url) HM.empty)
152
153 -- | Object
154
155 data Object = Object { fromObject :: A.Object } deriving (Eq, Show)
156
157 instance FromJSON Object where
158 parseJSON (A.Object o) = return (Object o)
159 parseJSON _ = fail "..."
160
161 instance ToJSON Object where
162 toJSON (Object o) = A.Object o
163
164 oRest :: Lens' Object A.Object
165 oRest = makeLens fromObject (\ o' m -> m { fromObject = o' })
166
167 oAttachments :: Lens' Object (Maybe [Object])
168 oAttachments = makeAesonLensMb "attachments" oRest
169
170 oAuthor :: Lens' Object (Maybe Object)
171 oAuthor = makeAesonLensMb "author" oRest
172
173 oContent :: Lens' Object (Maybe Text)
174 oContent = makeAesonLensMb "content" oRest
175
176 oDisplayName :: Lens' Object (Maybe Text)
177 oDisplayName = makeAesonLensMb "displayName" oRest
178
179 oDownstreamDuplicates :: Lens' Object (Maybe [Text])
180 oDownstreamDuplicates = makeAesonLensMb "downstreamDuplicates" oRest
181
182 oId :: Lens' Object (Maybe Text)
183 oId = makeAesonLensMb "id" oRest
184
185 oImage :: Lens' Object (Maybe MediaLink)
186 oImage = makeAesonLensMb "image" oRest
187
188 oObjectType :: (FromJSON o, ToJSON o) => Lens' Object (Maybe o)
189 oObjectType = makeAesonLensMb "objectType" oRest
190
191 oPublished :: Lens' Object (Maybe DateTime)
192 oPublished = makeAesonLensMb "published" oRest
193
194 oSummary :: Lens' Object (Maybe Text)
195 oSummary = makeAesonLensMb "summary" oRest
196
197 oUpdated :: Lens' Object (Maybe DateTime)
198 oUpdated = makeAesonLensMb "updated" oRest
199
200 oUpstreamDuplicates :: Lens' Object (Maybe [Text])
201 oUpstreamDuplicates = makeAesonLensMb "upstreamDuplicates" oRest
202
203 oURL :: Lens' Object (Maybe Text)
204 oURL = makeAesonLensMb "url" oRest
205
206 -- | Create an @Object@ with no fields.
207 emptyObject :: Object
208 emptyObject = Object HM.empty
209
210 -- | Activity
211
212 data Activity = Activity { fromActivity :: A.Object } deriving (Eq, Show)
213
214 instance FromJSON Activity where
215 parseJSON (A.Object o)
216 | HM.member "published" o && HM.member "provider" o = return (Activity o)
217 | otherwise = fail "..."
218 parseJSON _ = fail "..."
219
220 instance ToJSON Activity where
221 toJSON (Activity o) = A.Object o
222
223 acRest :: Lens' Activity A.Object
224 acRest = makeLens fromActivity (\ o' m -> m { fromActivity = o' })
225
226 acActor :: Lens' Activity Object
227 acActor = makeAesonLens "actor" acRest
228
229 acContent :: Lens' Activity (Maybe Text)
230 acContent = makeAesonLensMb "content" acRest
231
232 acGenerator :: Lens' Activity (Maybe Object)
233 acGenerator = makeAesonLens "generator" acRest
234
235 acIcon :: Lens' Activity (Maybe MediaLink)
236 acIcon = makeAesonLensMb "icon" acRest
237
238 acId :: Lens' Activity (Maybe Text)
239 acId = makeAesonLensMb "id" acRest
240
241 acPublished :: Lens' Activity DateTime
242 acPublished = makeAesonLens "published" acRest
243
244 acProvider :: Lens' Activity (Maybe Object)
245 acProvider = makeAesonLensMb "provider" acRest
246
247 acTarget :: Lens' Activity (Maybe Object)
248 acTarget = makeAesonLensMb "target" acRest
249
250 acTitle :: Lens' Activity (Maybe Text)
251 acTitle = makeAesonLensMb "title" acRest
252
253 acUpdated :: Lens' Activity (Maybe DateTime)
254 acUpdated = makeAesonLensMb "updated" acRest
255
256 acURL :: Lens' Activity (Maybe Text)
257 acURL = makeAesonLensMb "url" acRest
258
259 acVerb :: (FromJSON v, ToJSON v) => Lens' Activity (Maybe v)
260 acVerb = makeAesonLensMb "verb" acRest
261
262 -- | Create an @Activity@ with an @actor@, @published@, and
263 -- @provider@ property.
264 makeActivity :: Object -> DateTime -> Object -> Activity
265 makeActivity actor published provider = Activity
266 $ HM.insert "actor" (toJSON actor)
267 $ HM.insert "published" (toJSON published)
268 $ HM.insert "provider" (toJSON provider)
269 $ HM.empty
270
271 -- | Collection
272
273 data Collection = Collection { fromCollection :: A.Object } deriving (Eq, Show)
274
275 instance FromJSON Collection where
276 parseJSON (A.Object o) = return (Collection o)
277 parseJSON _ = fail "..."
278
279 instance ToJSON Collection where
280 toJSON (Collection o) = A.Object o
281
282 cRest :: Lens' Collection A.Object
283 cRest = makeLens fromCollection (\ o' m -> m { fromCollection = o' })
284
285 cTotalItems :: Lens' Collection (Maybe Int)
286 cTotalItems = makeAesonLensMb "totalItems" cRest
287
288 cItems :: Lens' Collection (Maybe [Object])
289 cItems = makeAesonLensMb "items" cRest
290
291 cURL :: Lens' Collection (Maybe Text)
292 cURL = makeAesonLensMb "url" cRest
293
294 -- | Create a @Collection@ with an @items@ and a @url@ property
295 -- and fill in the corresponding @totalItems@ field with the
296 -- length of the @items@ array.
297 makeCollection :: [Object] -> Text -> Collection
298 makeCollection objs url = Collection
299 $ HM.insert "totalItems" (toJSON (length objs))
300 $ HM.insert "items" (toJSON objs)
301 $ HM.insert "url" (toJSON url)
302 $ HM.empty
+3
-2
activitystreams-aeson.cabal less more
1616 cabal-version: >=1.10
1717
1818 library
19 exposed-modules: Codec.ActivityStream.Representation,
19 exposed-modules: Codec.ActivityStream.Dynamic,
20 Codec.ActivityStream.Representation,
2021 Codec.ActivityStream.Schema,
2122 Codec.ActivityStream
2223 other-modules: Codec.ActivityStream.Internal
2324 build-depends: base >=4.7 && <4.8, aeson, text, url, lens, datetime, unordered-containers
24 default-language: Haskell2010⏎
25 default-language: Haskell2010