gdritter repos activitystreams-aeson / 33cc5a7
Added DynamicSchema and started to add documentation Getty Ritter 10 years ago
5 changed file(s) with 431 addition(s) and 134 deletion(s). Collapse all Expand all
+5
-45
Codec/ActivityStream/Dynamic.hs less more
11 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE RankNTypes #-}
32
43 {-|
54 Module : Codec.ActivityStream.Dynamic
7473 import qualified Data.Aeson as A
7574 import Data.DateTime (DateTime)
7675 import qualified Data.HashMap.Strict as HM
77 import Data.Maybe (fromJust)
7876 import Data.Text (Text)
7977
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)
78 import Codec.ActivityStream.LensInternal ( Lens'
79 , makeLens
80 , makeAesonLens
81 , makeAesonLensMb
82 )
12383
12484 data MediaLink = MediaLink { fromMediaLink :: A.Object } deriving (Eq, Show)
12585
+268
-0
Codec/ActivityStream/DynamicSchema.hs less more
1 {-# LANGUAGE Rank2Types #-}
2 {-# LANGUAGE OverloadedStrings #-}
3
4 module Codec.ActivityStream.DynamicSchema
5 ( module Codec.ActivityStream.Dynamic
6 -- * Verbs
7 , SchemaVerb(..)
8 -- * Object Types
9 , SchemaObjectType(..)
10 -- ** Audio/Video
11 , avEmbedCode
12 , avStream
13 -- ** Binary
14 , bnCompression
15 , bnData
16 , bnFileUrl
17 , bnLength
18 , bnMd5
19 , bnMimeType
20 -- ** Event
21 , evAttended
22 , evAttending
23 , evEndTime
24 , evInvited
25 , evMaybeAttending
26 , evNotAttendedBy
27 , evNotAttending
28 , evStartTime
29 -- ** Issue
30 , isTypes
31 -- ** Permission
32 , pmScope
33 , pmActions
34 -- ** Place
35 , plPosition
36 , plAddress
37 -- *** PlacePosition
38 , PlacePosition
39 -- *** PlaceAddress
40 , PlaceAddress
41 -- ** Role/Group
42 , rlMembers
43 -- ** Task
44 , tsActor
45 , tsBy
46 , tsObject
47 , tsPrerequisites
48 , tsRequired
49 , tsSupersedes
50 , tsVerb
51 -- * Basic Extension Properties
52 , acContext
53 , getLocation
54 , oMood
55 , oRating
56 , acResult
57 , getSource
58 , getStartTime
59 , getEndTime
60 , Mood
61 , moodRest
62 , moodDisplayName
63 , moodImage
64 ) where
65
66 import qualified Data.Aeson as Aeson
67 import Data.DateTime (DateTime)
68 import Data.Aeson ( FromJSON(..), ToJSON(..) )
69 import qualified Data.HashMap.Strict as HM
70 import Data.Text (Text)
71
72 import Codec.ActivityStream.LensInternal
73 import Codec.ActivityStream.Dynamic
74 import Codec.ActivityStream.Schema (SchemaVerb(..), SchemaObjectType(..))
75
76 -- audio/video
77
78 -- | A fragment of HTML markup that, when embedded within another HTML
79 -- page, provides an interactive user-interface for viewing or listening
80 -- to the video or audio stream.
81 avEmbedCode :: Lens' Object (Maybe Text)
82 avEmbedCode = makeAesonLensMb "embedCode" oRest
83
84 -- | An Activity Streams Media Link to the video or audio content itself.
85 avStream :: Lens' Object (Maybe MediaLink)
86 avStream = makeAesonLensMb "stream" oRest
87
88 -- binary
89
90 -- | An optional token identifying a compression algorithm applied to
91 -- the binary data prior to Base64-encoding. Possible algorithms
92 -- are "deflate" and "gzip", respectively indicating the use of
93 -- the compression mechanisms defined by RFC 1951 and RFC 1952.
94 -- Additional compression algorithms MAY be used but are not defined
95 -- by this specification. Note that previous versions of this
96 -- specification allowed for multiple compression algorithms to be
97 -- applied and listed using a comma-separated format. The use of
98 -- multiple compressions is no longer permitted.
99 bnCompression :: Lens' Object (Maybe Text)
100 bnCompression = makeAesonLensMb "compression" oRest
101
102 bnData :: Lens' Object (Maybe Text)
103 bnData = makeAesonLensMb "data" oRest
104
105 bnFileUrl :: Lens' Object (Maybe Text)
106 bnFileUrl = makeAesonLensMb "fileUrl" oRest
107
108 bnLength :: Lens' Object (Maybe Text)
109 bnLength = makeAesonLensMb "length" oRest
110
111 bnMd5 :: Lens' Object (Maybe Text)
112 bnMd5 = makeAesonLensMb "md5" oRest
113
114 bnMimeType :: Lens' Object (Maybe Text)
115 bnMimeType = makeAesonLensMb "mimeType" oRest
116
117 -- event
118
119 evAttended :: Lens' Object (Maybe Collection)
120 evAttended = makeAesonLensMb "attended" oRest
121
122 evAttending :: Lens' Object (Maybe Collection)
123 evAttending = makeAesonLensMb "attending" oRest
124
125 evEndTime :: Lens' Object (Maybe DateTime)
126 evEndTime = makeAesonLensMb "endTime" oRest
127
128 evInvited :: Lens' Object (Maybe Collection)
129 evInvited = makeAesonLensMb "invited" oRest
130
131 evMaybeAttending :: Lens' Object (Maybe Collection)
132 evMaybeAttending = makeAesonLensMb "maybeAttending" oRest
133
134 evNotAttendedBy :: Lens' Object (Maybe Collection)
135 evNotAttendedBy = makeAesonLensMb "notAttendedBy" oRest
136
137 evNotAttending :: Lens' Object (Maybe Collection)
138 evNotAttending = makeAesonLensMb "notAttending" oRest
139
140 evStartTime :: Lens' Object (Maybe DateTime)
141 evStartTime = makeAesonLensMb "startTime" oRest
142
143 -- issue
144
145 isTypes :: Lens' Object (Maybe [Text])
146 isTypes = makeAesonLensMb "types" oRest
147
148 -- permission
149
150 pmScope :: Lens' Object (Maybe Object)
151 pmScope = makeAesonLensMb "scope" oRest
152
153 pmActions :: Lens' Object (Maybe [Text])
154 pmActions = makeAesonLensMb "actions" oRest
155
156 -- place
157
158 plPosition :: Lens' Object (Maybe PlacePosition)
159 plPosition = makeAesonLensMb "position" oRest
160
161 plAddress :: Lens' Object (Maybe PlaceAddress)
162 plAddress = makeAesonLensMb "address" oRest
163
164 data PlacePosition = PPO { fromPPO :: Aeson.Object } deriving (Eq, Show)
165
166 instance FromJSON PlacePosition where
167 parseJSON (Aeson.Object o)
168 | HM.member "altitude" o
169 && HM.member "latitude" o
170 && HM.member "longitude" o = return (PPO o)
171 | otherwise = fail "..."
172 parseJSON _ = fail "..."
173
174 instance ToJSON PlacePosition where
175 toJSON = Aeson.Object . fromPPO
176
177 data PlaceAddress = PAO { fromPAO :: Aeson.Object } deriving (Eq, Show)
178
179 instance FromJSON PlaceAddress where
180 parseJSON (Aeson.Object o)
181 | HM.member "formatted" o
182 && HM.member "streetAddress" o
183 && HM.member "locality" o
184 && HM.member "region" o
185 && HM.member "postalCode" o
186 && HM.member "country" o = return (PAO o)
187 | otherwise = fail "..."
188 parseJSON _ = fail "..."
189
190 instance ToJSON PlaceAddress where
191 toJSON = Aeson.Object . fromPAO
192
193 -- role/group
194
195 rlMembers :: Lens' Object (Maybe [Object])
196 rlMembers = makeAesonLensMb "members" oRest
197
198 -- Task
199
200 tsActor :: Lens' Object (Maybe Object)
201 tsActor = makeAesonLensMb "actor" oRest
202
203 tsBy :: Lens' Object (Maybe DateTime)
204 tsBy = makeAesonLensMb "by" oRest
205
206 tsObject :: Lens' Object (Maybe Object)
207 tsObject = makeAesonLensMb "object" oRest
208
209 tsPrerequisites :: Lens' Object (Maybe [Object])
210 tsPrerequisites = makeAesonLensMb "prerequisites" oRest
211
212 tsRequired :: Lens' Object (Maybe Bool)
213 tsRequired = makeAesonLensMb "required" oRest
214
215 tsSupersedes :: Lens' Object (Maybe [Object])
216 tsSupersedes = makeAesonLensMb "supersedes" oRest
217
218 tsVerb :: Lens' Object (Maybe SchemaVerb)
219 tsVerb = makeAesonLensMb "verb" oRest
220
221 -- extra properties
222
223 acContext :: Lens' Activity (Maybe Object)
224 acContext = makeAesonLensMb "context" acRest
225
226 getLocation :: Lens' a Aeson.Object -> Lens' a (Maybe Object)
227 getLocation = makeAesonLensMb "location"
228
229 oMood :: Lens' Object (Maybe Mood)
230 oMood = makeAesonLensMb "mood" oRest
231
232 oRating :: Lens' Object (Maybe Double)
233 oRating = makeAesonLensMb "rating" oRest
234
235 acResult :: Lens' Activity (Maybe Object)
236 acResult = makeAesonLensMb "result" acRest
237
238 getSource :: Lens' a Aeson.Object -> Lens' a (Maybe Object)
239 getSource = makeAesonLensMb "source"
240
241 getStartTime :: Lens' a Aeson.Object -> Lens' a (Maybe Text)
242 getStartTime = makeAesonLensMb "startTime"
243
244 getEndTime :: Lens' a Aeson.Object -> Lens' a (Maybe Text)
245 getEndTime = makeAesonLensMb "endTime"
246
247 -- mood
248
249 data Mood = Mood { fromMood :: Aeson.Object } deriving (Eq, Show)
250
251 instance FromJSON Mood where
252 parseJSON (Aeson.Object o)
253 | HM.member "displayName" o
254 && HM.member "image" o = return (Mood o)
255 | otherwise = fail "..."
256 parseJSON _ = fail "..."
257
258 instance ToJSON Mood where
259 toJSON = Aeson.Object . fromMood
260
261 moodRest :: Lens' Mood Aeson.Object
262 moodRest = makeLens fromMood (\ o' m -> m { fromMood = o' })
263
264 moodDisplayName :: Lens' Mood Text
265 moodDisplayName = makeAesonLens "displayName" moodRest
266
267 moodImage :: Lens' Mood MediaLink
268 moodImage = makeAesonLens "image" moodRest
+54
-0
Codec/ActivityStream/LensInternal.hs less more
1 {-# LANGUAGE RankNTypes #-}
2 {-# LANGUAGE LambdaCase #-}
3
4 module Codec.ActivityStream.LensInternal where
5
6 import Data.Aeson as Aeson
7 import qualified Data.HashMap.Strict as HM
8 import Data.Maybe (fromJust)
9 import Data.Text (Text)
10
11 -- This way, we don't have to import lens... but we can still export lenses!
12 newtype Const a b = Const { fromConst :: a }
13 instance Functor (Const a) where fmap f (Const x) = Const x
14
15 -- We need these to write get and set
16 newtype Id a = Id { fromId :: a }
17 instance Functor Id where fmap f (Id x) = Id (f x)
18
19 -- | This is the same type alias as in @Control.Lens@, and so can be used
20 -- anywhere lenses are needed.
21 type Lens' a b = forall f. Functor f => (b -> f b) -> (a -> f a)
22
23 get :: Lens' a b -> a -> b
24 get lens a = fromConst (lens Const a)
25
26 set :: Lens' a b -> b -> a -> a
27 set lens x a = fromId (lens (const Id x) a)
28
29 makeLens :: (a -> b) -> (b -> a -> a) -> Lens' a b
30 makeLens get set f a = (`set` a) `fmap` f (get a)
31
32 fromJSON' :: FromJSON a => Aeson.Value -> Maybe a
33 fromJSON' v = case fromJSON v of
34 Success a -> Just a
35 Error _ -> Nothing
36
37 -- Create a lens into an Aeson object wrapper that takes and
38 -- returns a Maybe value
39 makeAesonLensMb :: (FromJSON v, ToJSON v)
40 => Text -> Lens' c Aeson.Object -> Lens' c (Maybe v)
41 makeAesonLensMb key fromObj = fromObj . lens
42 where lens = makeLens
43 (\ o -> HM.lookup key o >>= fromJSON')
44 (\case Just v -> HM.insert key (toJSON v)
45 Nothing -> HM.delete key)
46
47
48 -- Create a lens into an Aeson object wrapper
49 makeAesonLens :: (FromJSON v, ToJSON v)
50 => Text -> Lens' c Aeson.Object -> Lens' c v
51 makeAesonLens key fromObj = fromObj . lens
52 where lens = makeLens
53 (\ o -> fromJust (HM.lookup key o >>= fromJSON'))
54 (\ v o -> HM.insert key (toJSON v) o)
+103
-89
Codec/ActivityStream/Schema.hs less more
1111 import Codec.ActivityStream.Representation
1212
1313 data SchemaVerb
14 = Accept
15 | Access
16 | Acknowledge
17 | Add
18 | Agree
19 | Append
20 | Approve
21 | Archive
22 | Assign
23 | At
24 | Attach
25 | Attend
26 | Author
27 | Authorize
28 | Borrow
29 | Build
30 | Cancel
31 | Close
32 | Complete
33 | Confirm
34 | Consume
35 | Checkin
36 | Create
37 | Delete
38 | Deliver
39 | Deny
40 | Disagree
41 | Dislike
42 | Experience
43 | Favorite
44 | Find
45 | FlagAsInappropriate
46 | Follow
47 | Give
48 | Host
49 | Ignore
50 | Insert
51 | Install
52 | Interact
53 | Invite
54 | Join
55 | Leave
56 | Like
57 | Listen
58 | Lose
59 | MakeFriend
60 | Open
61 | Play
62 | Post
63 | Present
64 | Purchase
65 | Qualify
66 | Read
67 | Receive
68 | Reject
69 | Remove
70 | RemoveFriend
71 | Replace
72 | Request
73 | RequestFriend
74 | Resolve
75 | Return
76 | Retract
77 | RsvpMaybe
78 | RsvpNo
79 | RsvpYes
80 | Satisfy
81 | Save
82 | Schedule
83 | Search
84 | Sell
85 | Send
86 | Share
87 | Sponsor
88 | Start
89 | StopFollowing
90 | Submit
91 | Tag
92 | Terminate
93 | Tie
94 | Unfavorite
95 | Unlike
96 | Unsatisfy
97 | Unsave
98 | Unshare
99 | Update
100 | Use
101 | Watch
102 | Win
14 = Accept -- ^ Indicates that that the actor has accepted the object.
15 -- For instance, a person accepting an award, or accepting
16 -- an assignment.
17 | Access -- ^ Indicates that the actor has accessed the object. For
18 -- instance, a person accessing a room, or accessing a file.
19 | Acknowledge -- ^ Indicates that the actor has acknowledged the object.
20 -- This effectively signals that the actor is aware of the
21 -- object's existence.
22 | Add -- ^ Indicates that the actor has added the object to the target.
23 -- For instance, adding a photo to an album.
24 | Agree -- ^ Indicates that the actor agrees with the object. For example,
25 -- a person agreeing with an argument, or expressing agreement
26 -- with a particular issue.
27 | Append -- ^ Indicates that the actor has appended the object to the
28 -- target. For instance, a person appending a new record
29 -- to a database.
30 | Approve -- ^ Indicates that the actor has approved the object. For
31 -- instance, a manager might approve a travel request.
32 | Archive -- ^ Indicates that the actor has archived the object.
33 | Assign -- ^ Indicates that the actor has assigned the object to the target.
34 | At -- ^ Indicates that the actor is currently located at the object.
35 -- For instance, a person being at a specific physical location.
36 | Attach -- ^ Indicates that the actor has attached the object to the
37 -- target. For instance, a person attaching a file to a wiki
38 -- page or an email.
39 | Attend -- ^
40 | Author -- ^
41 | Authorize -- ^
42 | Borrow -- ^
43 | Build -- ^
44 | Cancel -- ^
45 | Close -- ^
46 | Complete -- ^
47 | Confirm -- ^
48 | Consume -- ^
49 | Checkin -- ^
50 | Create -- ^
51 | Delete -- ^
52 | Deliver -- ^
53 | Deny -- ^
54 | Disagree -- ^
55 | Dislike -- ^
56 | Experience -- ^
57 | Favorite -- ^
58 | Find -- ^
59 | FlagAsInappropriate -- ^
60 | Follow -- ^
61 | Give -- ^
62 | Host -- ^
63 | Ignore -- ^
64 | Insert -- ^
65 | Install -- ^
66 | Interact -- ^
67 | Invite -- ^
68 | Join -- ^
69 | Leave -- ^
70 | Like -- ^
71 | Listen -- ^
72 | Lose -- ^
73 | MakeFriend -- ^
74 | Open -- ^
75 | Play -- ^
76 | Post -- ^
77 | Present -- ^
78 | Purchase -- ^
79 | Qualify -- ^
80 | Read -- ^
81 | Receive -- ^
82 | Reject -- ^
83 | Remove -- ^
84 | RemoveFriend -- ^
85 | Replace -- ^
86 | Request -- ^
87 | RequestFriend -- ^
88 | Resolve -- ^
89 | Return -- ^
90 | Retract -- ^
91 | RsvpMaybe -- ^
92 | RsvpNo -- ^
93 | RsvpYes -- ^
94 | Satisfy -- ^
95 | Save -- ^
96 | Schedule -- ^
97 | Search -- ^
98 | Sell -- ^
99 | Send -- ^
100 | Share -- ^
101 | Sponsor -- ^
102 | Start -- ^
103 | StopFollowing -- ^
104 | Submit -- ^
105 | Tag -- ^
106 | Terminate -- ^
107 | Tie -- ^
108 | Unfavorite -- ^
109 | Unlike -- ^
110 | Unsatisfy -- ^
111 | Unsave -- ^
112 | Unshare -- ^
113 | Update -- ^
114 | Use -- ^
115 | Watch -- ^
116 | Win -- ^ foo
103117 deriving (Eq, Show, Read)
104118
105119 deriveJSON (commonOptsCC "") ''SchemaVerb
+1
-0
activitystreams-aeson.cabal less more
1717
1818 library
1919 exposed-modules: Codec.ActivityStream.Dynamic,
20 Codec.ActivityStream.DynamicSchema,
2021 Codec.ActivityStream.Representation,
2122 Codec.ActivityStream.Schema,
2223 Codec.ActivityStream