Initial commit; working library
Getty Ritter
11 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⏎ |