gdritter repos activitystreams-aeson / 9f7a561
Initial commit; working library Getty Ritter 9 years ago
7 changed file(s) with 503 addition(s) and 0 deletion(s). Collapse all Expand all
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 import Distribution.Simple
2 main = defaultMain
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