Initial commit; working library
Getty Ritter
10 years ago
1 | module Codec.ActivityStream.Internal (commonOpts, commonOptsCC) where | |
2 | ||
3 | import Data.Aeson.TH | |
4 | import Data.Char | |
5 | ||
6 | toCamelCaseUpper :: String -> String | |
7 | toCamelCaseUpper = toCamelCase True | |
8 | ||
9 | toCamelCaseLower :: String -> String | |
10 | toCamelCaseLower = toCamelCase False | |
11 | ||
12 | toCamelCase :: Bool -> String -> String | |
13 | toCamelCase = go | |
14 | where go _ "" = "" | |
15 | go _ ('-':cs) = go True cs | |
16 | go True (c:cs) = toUpper c : go False cs | |
17 | go False (c:cs) = c : go False cs | |
18 | ||
19 | fromCamelCase :: String -> String | |
20 | fromCamelCase (c:cs) | |
21 | | isUpper c = toLower c : go cs | |
22 | | otherwise = go (c:cs) | |
23 | where go "" = "" | |
24 | go (c:cs) | |
25 | | c == ' ' = go cs | |
26 | | isUpper c = '-' : toLower c : go cs | |
27 | | otherwise = c : go cs | |
28 | ||
29 | commonOpts :: String -> Options | |
30 | commonOpts prefix = defaultOptions | |
31 | { fieldLabelModifier = drop (length prefix) | |
32 | , omitNothingFields = True | |
33 | } | |
34 | ||
35 | commonOptsCC :: String -> Options | |
36 | commonOptsCC prefix = defaultOptions | |
37 | { fieldLabelModifier = fromCamelCase . drop (length prefix) | |
38 | , constructorTagModifier = fromCamelCase | |
39 | , omitNothingFields = True | |
40 | } |
1 | {-# LANGUAGE OverloadedStrings #-} | |
2 | {-# LANGUAGE TemplateHaskell #-} | |
3 | ||
4 | module Codec.ActivityStream.Representation where | |
5 | ||
6 | import Control.Applicative | |
7 | import Control.Lens hiding ((.=)) | |
8 | import Data.Aeson ( FromJSON(..) | |
9 | , ToJSON(..) | |
10 | , Value | |
11 | , fromJSON | |
12 | , object | |
13 | , (.=) | |
14 | , (.:) | |
15 | , (.:?) | |
16 | ) | |
17 | import qualified Data.Aeson as Ae | |
18 | import Data.Aeson.TH | |
19 | import Data.DateTime | |
20 | import qualified Data.HashMap.Strict as HM | |
21 | import Data.Maybe (catMaybes) | |
22 | import Data.Text (Text) | |
23 | ||
24 | import Codec.ActivityStream.Internal | |
25 | ||
26 | data Verb ext | |
27 | = Post | |
28 | | VerbExt ext | |
29 | deriving (Eq, Show) | |
30 | ||
31 | instance FromJSON ext => FromJSON (Verb ext) where | |
32 | parseJSON (Ae.String "post") = return Post | |
33 | parseJSON ext = VerbExt `fmap` parseJSON ext | |
34 | ||
35 | instance ToJSON ext => ToJSON (Verb ext) where | |
36 | toJSON Post = Ae.String "post" | |
37 | toJSON (VerbExt ext) = toJSON ext | |
38 | ||
39 | data MediaLink = MediaLink | |
40 | { _mlDuration :: Maybe Int | |
41 | , _mlHeight :: Maybe Int | |
42 | , _mlURL :: Text | |
43 | , _mlWidth :: Maybe Int | |
44 | } deriving (Eq, Show) | |
45 | ||
46 | makeLenses ''MediaLink | |
47 | deriveJSON (commonOpts "_ml") ''MediaLink | |
48 | ||
49 | data Object objType = Object | |
50 | { _oAttachments :: Maybe [Object objType] | |
51 | , _oAuthor :: Maybe (Object objType) | |
52 | , _oContent :: Maybe Text | |
53 | , _oDisplayName :: Maybe Text | |
54 | , _oDownstreamDuplicates :: Maybe [Text] | |
55 | , _oId :: Maybe Text | |
56 | , _oImage :: Maybe MediaLink | |
57 | , _oObjectType :: Maybe objType | |
58 | , _oPublished :: Maybe DateTime | |
59 | , _oSummary :: Maybe Text | |
60 | , _oUpdated :: Maybe DateTime | |
61 | , _oUpstreamDuplicates :: Maybe [Text] | |
62 | , _oURL :: Maybe Text | |
63 | , _oRest :: [(Text, Value)] | |
64 | } deriving (Eq, Show) | |
65 | ||
66 | makeLenses ''Object | |
67 | ||
68 | objectFields :: [Text] | |
69 | objectFields = | |
70 | [ "attachments" | |
71 | , "author" | |
72 | , "content" | |
73 | , "displayName" | |
74 | , "downstreamDuplicates" | |
75 | , "id" | |
76 | , "image" | |
77 | , "objectType" | |
78 | , "published" | |
79 | , "summary" | |
80 | , "updated" | |
81 | , "upstreamDuplicates" | |
82 | , "url" | |
83 | ] | |
84 | ||
85 | instance FromJSON objType => FromJSON (Object objType) where | |
86 | parseJSON (Ae.Object o) = | |
87 | Object <$> o .:? "attachments" | |
88 | <*> o .:? "author" | |
89 | <*> o .:? "content" | |
90 | <*> o .:? "displayName" | |
91 | <*> o .:? "downstreamDuplicates" | |
92 | <*> o .:? "id" | |
93 | <*> o .:? "image" | |
94 | <*> o .:? "objectType" | |
95 | <*> o .:? "published" | |
96 | <*> o .:? "summary" | |
97 | <*> o .:? "updated" | |
98 | <*> o .:? "upstreamDuplicates" | |
99 | <*> o .:? "url" | |
100 | <*> pure rest | |
101 | where rest = HM.toList (foldr HM.delete o objectFields) | |
102 | ||
103 | instance ToJSON objType => ToJSON (Object objType) where | |
104 | toJSON obj = object (attrs ++ _oRest obj) | |
105 | where attrs = catMaybes | |
106 | [ "attachments" .=? _oAttachments obj | |
107 | , "author" .=? _oAuthor obj | |
108 | , "content" .=? _oContent obj | |
109 | , "displayName" .=? _oDisplayName obj | |
110 | , "downstreamDuplicates" .=? _oDownstreamDuplicates obj | |
111 | , "id" .=? _oId obj | |
112 | , "image" .=? _oImage obj | |
113 | , "objectType" .=? _oObjectType obj | |
114 | , "published" .=? _oPublished obj | |
115 | , "summary" .=? _oSummary obj | |
116 | , "updated" .=? _oUpdated obj | |
117 | , "upstreamDuplicates" .=? _oUpstreamDuplicates obj | |
118 | , "url" .=? _oURL obj | |
119 | ] | |
120 | (.=?) :: ToJSON a => Text -> Maybe a -> Maybe (Text, Value) | |
121 | x .=? Just y = Just (x, toJSON y) | |
122 | _ .=? Nothing = Nothing | |
123 | infix 1 .=? | |
124 | ||
125 | emptyObject :: Object objType | |
126 | emptyObject = Object | |
127 | { _oAttachments = Nothing | |
128 | , _oAuthor = Nothing | |
129 | , _oContent = Nothing | |
130 | , _oDisplayName = Nothing | |
131 | , _oDownstreamDuplicates = Nothing | |
132 | , _oId = Nothing | |
133 | , _oImage = Nothing | |
134 | , _oObjectType = Nothing | |
135 | , _oPublished = Nothing | |
136 | , _oSummary = Nothing | |
137 | , _oUpdated = Nothing | |
138 | , _oUpstreamDuplicates = Nothing | |
139 | , _oURL = Nothing | |
140 | , _oRest = [] | |
141 | } | |
142 | ||
143 | data Activity verb objType = Activity | |
144 | { _acActor :: Object objType | |
145 | , _acContent :: Maybe Text | |
146 | , _acGenerator :: Maybe (Object objType) | |
147 | , _acIcon :: Maybe MediaLink | |
148 | , _acId :: Maybe Text | |
149 | , _acPublished :: DateTime | |
150 | , _acProvider :: Object objType | |
151 | , _acTarget :: Maybe (Object objType) | |
152 | , _acTitle :: Maybe Text | |
153 | , _acUpdated :: Maybe DateTime | |
154 | , _acURL :: Maybe Text | |
155 | , _acVerb :: Maybe verb | |
156 | } deriving (Eq, Show) | |
157 | ||
158 | makeLenses ''Activity | |
159 | deriveJSON (commonOpts "_ac") ''Activity | |
160 | ||
161 | makeMinimalActivity :: Object objType -> DateTime -> Object objType | |
162 | -> Activity verb objType | |
163 | makeMinimalActivity actor published provider = Activity | |
164 | { _acActor = actor | |
165 | , _acContent = Nothing | |
166 | , _acGenerator = Nothing | |
167 | , _acIcon = Nothing | |
168 | , _acId = Nothing | |
169 | , _acPublished = published | |
170 | , _acProvider = provider | |
171 | , _acTarget = Nothing | |
172 | , _acTitle = Nothing | |
173 | , _acUpdated = Nothing | |
174 | , _acURL = Nothing | |
175 | , _acVerb = Nothing | |
176 | } | |
177 | ||
178 | data Collection objType = Collection | |
179 | { _cTotalItems :: Maybe Int | |
180 | , _cItems :: Maybe [Object objType] | |
181 | , _cURL :: Maybe Text | |
182 | } deriving (Eq, Show) | |
183 | ||
184 | makeLenses ''Collection | |
185 | deriveJSON (commonOpts "_c") ''Collection | |
186 | ||
187 | makeCollection :: Maybe [Object objType] -> Maybe Text -> Collection objType | |
188 | makeCollection objs url = Collection | |
189 | { _cTotalItems = fmap length objs | |
190 | , _cItems = objs | |
191 | , _cURL = url | |
192 | } |
1 | {-# LANGUAGE TemplateHaskell #-} | |
2 | ||
3 | module Codec.ActivityStream.Schema where | |
4 | ||
5 | import Data.Aeson hiding (Object) | |
6 | import Data.Aeson.TH | |
7 | import Data.DateTime | |
8 | import Data.Text (Text) | |
9 | ||
10 | import Codec.ActivityStream.Internal | |
11 | import Codec.ActivityStream.Representation | |
12 | ||
13 | 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 | |
103 | deriving (Eq, Show, Read) | |
104 | ||
105 | deriveJSON (commonOptsCC "") ''SchemaVerb | |
106 | ||
107 | data SchemaObjectType | |
108 | = Alert | |
109 | | Application | |
110 | | Article | |
111 | | Audio | |
112 | | Badge | |
113 | | Binary | |
114 | | Bookmark | |
115 | | Collection | |
116 | | Comment | |
117 | | Device | |
118 | | Event | |
119 | | File | |
120 | | Game | |
121 | | Group | |
122 | | Image | |
123 | | Issue | |
124 | | Job | |
125 | | Note | |
126 | | Offer | |
127 | | Organization | |
128 | | Page | |
129 | | Person | |
130 | | Place | |
131 | | Process | |
132 | | Product | |
133 | | Question | |
134 | | Review | |
135 | | Service | |
136 | | Task | |
137 | | Video | |
138 | deriving (Eq, Show, Read) | |
139 | ||
140 | deriveJSON (commonOptsCC "") ''SchemaObjectType | |
141 | ||
142 | type SchemaObject = Object SchemaObjectType | |
143 | type SchemaCollection = Collection SchemaObjectType | |
144 | ||
145 | data AVObj = AVObj | |
146 | { avEmbedCode :: Maybe Text | |
147 | , avStream :: Maybe MediaLink | |
148 | , avRest :: SchemaObject | |
149 | } deriving (Eq, Show) | |
150 | ||
151 | data BinaryObj = BinaryObj | |
152 | { bnCompression :: Maybe Text | |
153 | , bnData :: Maybe Text | |
154 | , bnFileUrl :: Maybe Text | |
155 | , bnLength :: Maybe Int | |
156 | , bnMd5 :: Maybe Text | |
157 | , bnMimeType :: Maybe Text | |
158 | , bnRest :: SchemaObject | |
159 | } deriving (Eq, Show) | |
160 | ||
161 | data EventObj = EventObj | |
162 | { evAttendedBy :: Maybe SchemaCollection | |
163 | , evAttending :: Maybe SchemaCollection | |
164 | , evEndTime :: Maybe DateTime | |
165 | , evInvited :: Maybe SchemaCollection | |
166 | , evMaybeAttending :: Maybe SchemaCollection | |
167 | , evNotAttendedBy :: Maybe SchemaCollection | |
168 | , evNotAttending :: Maybe SchemaCollection | |
169 | , evStartTime :: Maybe DateTime | |
170 | , evRest :: SchemaObject | |
171 | } deriving (Eq, Show) | |
172 | ||
173 | data IssueObj = IssueObj | |
174 | { isTypes :: Maybe [Text] | |
175 | , isRest :: SchemaObject | |
176 | } deriving (Eq, Show) | |
177 | ||
178 | data PlaceObj = PlaceObj | |
179 | { plPosition :: Maybe PlacePositionObj | |
180 | , plAddress :: Maybe PlaceAddressObj | |
181 | , plRest :: SchemaObject | |
182 | } deriving (Eq, Show) | |
183 | ||
184 | data PlacePositionObj = PlacePositionObj | |
185 | { ppAltitude :: Integer | |
186 | , ppLatitude :: Integer | |
187 | , ppLongitude :: Integer | |
188 | } deriving (Eq, Show) | |
189 | ||
190 | data PlaceAddressObj = PlaceAddressObj | |
191 | { paFormatted :: Text | |
192 | , paStreetAddress :: Text | |
193 | , paLocality :: Text | |
194 | , paRegion :: Text | |
195 | , paPostalCode :: Text | |
196 | , paCountry :: Text | |
197 | } deriving (Eq, Show) | |
198 | ||
199 | data TaskObj = TaskObj | |
200 | { tsActor :: Maybe SchemaObject | |
201 | , tsBy :: Maybe DateTime | |
202 | , tsObject :: Maybe SchemaObject | |
203 | , tsPrerequisites :: Maybe [TaskObj] | |
204 | , tsRequired :: Maybe Bool | |
205 | , tsSupersedes :: Maybe [TaskObj] | |
206 | , tsVerb :: Maybe SchemaVerb | |
207 | , tsRest :: SchemaObject | |
208 | } deriving (Eq, Show) |
1 | {-# LANGUAGE TemplateHaskell #-} | |
2 | ||
3 | module Codec.ActivityStream | |
4 | ( module Codec.ActivityStream.Representation | |
5 | ) where | |
6 | ||
7 | import Codec.ActivityStream.Representation |
1 | Copyright (c) 2014, Getty Ritter | |
2 | ||
3 | All rights reserved. | |
4 | ||
5 | Redistribution and use in source and binary forms, with or without | |
6 | modification, are permitted provided that the following conditions are met: | |
7 | ||
8 | * Redistributions of source code must retain the above copyright | |
9 | notice, this list of conditions and the following disclaimer. | |
10 | ||
11 | * Redistributions in binary form must reproduce the above | |
12 | copyright notice, this list of conditions and the following | |
13 | disclaimer in the documentation and/or other materials provided | |
14 | with the distribution. | |
15 | ||
16 | * Neither the name of Getty Ritter nor the names of other | |
17 | contributors may be used to endorse or promote products derived | |
18 | from this software without specific prior written permission. | |
19 | ||
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | |
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | |
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | |
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | |
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | |
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | |
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | |
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
1 | -- Initial activitystreams-aeson.cabal generated by cabal init. For | |
2 | -- further documentation, see http://haskell.org/cabal/users-guide/ | |
3 | ||
4 | name: activitystreams-aeson | |
5 | version: 0.1.0.0 | |
6 | -- synopsis: | |
7 | -- description: | |
8 | license: BSD3 | |
9 | license-file: LICENSE | |
10 | author: Getty Ritter | |
11 | maintainer: gettylefou@gmail.com | |
12 | -- copyright: | |
13 | category: Codec | |
14 | build-type: Simple | |
15 | -- extra-source-files: | |
16 | cabal-version: >=1.10 | |
17 | ||
18 | library | |
19 | exposed-modules: Codec.ActivityStream.Representation, | |
20 | Codec.ActivityStream.Schema, | |
21 | Codec.ActivityStream | |
22 | other-modules: Codec.ActivityStream.Internal | |
23 | build-depends: base >=4.7 && <4.8, aeson, text, url, lens, datetime, unordered-containers | |
24 | default-language: Haskell2010⏎ |