Initial commit; working library

Codec/ActivityStream.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Codec.ActivityStream
+  ( module Codec.ActivityStream.Representation
+  ) where
+
+import Codec.ActivityStream.Representation

Codec/ActivityStream/Internal.hs

@@ -0,0 +1,40 @@
+module Codec.ActivityStream.Internal (commonOpts, commonOptsCC) where
+
+import Data.Aeson.TH
+import Data.Char
+
+toCamelCaseUpper :: String -> String
+toCamelCaseUpper = toCamelCase True
+
+toCamelCaseLower :: String -> String
+toCamelCaseLower = toCamelCase False
+
+toCamelCase :: Bool -> String -> String
+toCamelCase = go
+  where go _ ""    = ""
+        go _ ('-':cs)   = go True cs
+        go True (c:cs)  = toUpper c : go False cs
+        go False (c:cs) = c : go False cs
+
+fromCamelCase :: String -> String
+fromCamelCase (c:cs)
+  | isUpper c = toLower c : go cs
+  | otherwise = go (c:cs)
+  where go "" = ""
+        go (c:cs)
+          | c == ' '  = go cs
+          | isUpper c = '-' : toLower c : go cs
+          | otherwise = c : go cs
+
+commonOpts :: String -> Options
+commonOpts prefix = defaultOptions
+  { fieldLabelModifier = drop (length prefix)
+  , omitNothingFields  = True
+  }
+
+commonOptsCC :: String -> Options
+commonOptsCC prefix = defaultOptions
+  { fieldLabelModifier     = fromCamelCase . drop (length prefix)
+  , constructorTagModifier = fromCamelCase
+  , omitNothingFields      = True
+  }

Codec/ActivityStream/Representation.hs

@@ -0,0 +1,192 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Codec.ActivityStream.Representation where
+
+import           Control.Applicative
+import           Control.Lens hiding ((.=))
+import           Data.Aeson ( FromJSON(..)
+                            , ToJSON(..)
+                            , Value
+                            , fromJSON
+                            , object
+                            , (.=)
+                            , (.:)
+                            , (.:?)
+                            )
+import qualified Data.Aeson as Ae
+import           Data.Aeson.TH
+import           Data.DateTime
+import qualified Data.HashMap.Strict as HM
+import           Data.Maybe (catMaybes)
+import           Data.Text (Text)
+
+import Codec.ActivityStream.Internal
+
+data Verb ext
+  = Post
+  | VerbExt ext
+    deriving (Eq, Show)
+
+instance FromJSON ext => FromJSON (Verb ext) where
+  parseJSON (Ae.String "post") = return Post
+  parseJSON ext                = VerbExt `fmap` parseJSON ext
+
+instance ToJSON ext => ToJSON (Verb ext) where
+  toJSON Post          = Ae.String "post"
+  toJSON (VerbExt ext) = toJSON ext
+
+data MediaLink = MediaLink
+  { _mlDuration :: Maybe Int
+  , _mlHeight   :: Maybe Int
+  , _mlURL      :: Text
+  , _mlWidth    :: Maybe Int
+  } deriving (Eq, Show)
+
+makeLenses ''MediaLink
+deriveJSON (commonOpts "_ml") ''MediaLink
+
+data Object objType = Object
+  { _oAttachments          :: Maybe [Object objType]
+  , _oAuthor               :: Maybe (Object objType)
+  , _oContent              :: Maybe Text
+  , _oDisplayName          :: Maybe Text
+  , _oDownstreamDuplicates :: Maybe [Text]
+  , _oId                   :: Maybe Text
+  , _oImage                :: Maybe MediaLink
+  , _oObjectType           :: Maybe objType
+  , _oPublished            :: Maybe DateTime
+  , _oSummary              :: Maybe Text
+  , _oUpdated              :: Maybe DateTime
+  , _oUpstreamDuplicates   :: Maybe [Text]
+  , _oURL                  :: Maybe Text
+  , _oRest                 :: [(Text, Value)]
+  } deriving (Eq, Show)
+
+makeLenses ''Object
+
+objectFields :: [Text]
+objectFields =
+  [ "attachments"
+  , "author"
+  , "content"
+  , "displayName"
+  , "downstreamDuplicates"
+  , "id"
+  , "image"
+  , "objectType"
+  , "published"
+  , "summary"
+  , "updated"
+  , "upstreamDuplicates"
+  , "url"
+  ]
+
+instance FromJSON objType => FromJSON (Object objType) where
+  parseJSON (Ae.Object o) =
+    Object <$> o .:? "attachments"
+           <*> o .:? "author"
+           <*> o .:? "content"
+           <*> o .:? "displayName"
+           <*> o .:? "downstreamDuplicates"
+           <*> o .:? "id"
+           <*> o .:? "image"
+           <*> o .:? "objectType"
+           <*> o .:? "published"
+           <*> o .:? "summary"
+           <*> o .:? "updated"
+           <*> o .:? "upstreamDuplicates"
+           <*> o .:? "url"
+           <*> pure rest
+    where rest = HM.toList (foldr HM.delete o objectFields)
+
+instance ToJSON objType => ToJSON (Object objType) where
+  toJSON obj = object (attrs ++ _oRest obj)
+    where attrs = catMaybes
+            [ "attachments"          .=? _oAttachments obj
+            , "author"               .=? _oAuthor obj
+            , "content"              .=? _oContent obj
+            , "displayName"          .=? _oDisplayName obj
+            , "downstreamDuplicates" .=? _oDownstreamDuplicates obj
+            , "id"                   .=? _oId obj
+            , "image"                .=? _oImage obj
+            , "objectType"           .=? _oObjectType obj
+            , "published"            .=? _oPublished obj
+            , "summary"              .=? _oSummary obj
+            , "updated"              .=? _oUpdated obj
+            , "upstreamDuplicates"   .=? _oUpstreamDuplicates obj
+            , "url"                  .=? _oURL obj
+            ]
+          (.=?) :: ToJSON a => Text -> Maybe a -> Maybe (Text, Value)
+          x .=? Just y  = Just (x, toJSON y)
+          _ .=? Nothing = Nothing
+          infix 1 .=?
+
+emptyObject :: Object objType
+emptyObject = Object
+  { _oAttachments          = Nothing
+  , _oAuthor               = Nothing
+  , _oContent              = Nothing
+  , _oDisplayName          = Nothing
+  , _oDownstreamDuplicates = Nothing
+  , _oId                   = Nothing
+  , _oImage                = Nothing
+  , _oObjectType           = Nothing
+  , _oPublished            = Nothing
+  , _oSummary              = Nothing
+  , _oUpdated              = Nothing
+  , _oUpstreamDuplicates   = Nothing
+  , _oURL                  = Nothing
+  , _oRest                 = []
+  }
+
+data Activity verb objType = Activity
+  { _acActor     :: Object objType
+  , _acContent   :: Maybe Text
+  , _acGenerator :: Maybe (Object objType)
+  , _acIcon      :: Maybe MediaLink
+  , _acId        :: Maybe Text
+  , _acPublished :: DateTime
+  , _acProvider  :: Object objType
+  , _acTarget    :: Maybe (Object objType)
+  , _acTitle     :: Maybe Text
+  , _acUpdated   :: Maybe DateTime
+  , _acURL       :: Maybe Text
+  , _acVerb      :: Maybe verb
+  } deriving (Eq, Show)
+
+makeLenses ''Activity
+deriveJSON (commonOpts "_ac") ''Activity
+
+makeMinimalActivity :: Object objType -> DateTime -> Object objType
+                       -> Activity verb objType
+makeMinimalActivity actor published provider = Activity
+  { _acActor     = actor
+  , _acContent   = Nothing
+  , _acGenerator = Nothing
+  , _acIcon      = Nothing
+  , _acId        = Nothing
+  , _acPublished = published
+  , _acProvider  = provider
+  , _acTarget    = Nothing
+  , _acTitle     = Nothing
+  , _acUpdated   = Nothing
+  , _acURL       = Nothing
+  , _acVerb      = Nothing
+  }
+
+data Collection objType = Collection
+  { _cTotalItems :: Maybe Int
+  , _cItems      :: Maybe [Object objType]
+  , _cURL        :: Maybe Text
+  } deriving (Eq, Show)
+
+makeLenses ''Collection
+deriveJSON (commonOpts "_c") ''Collection
+
+makeCollection :: Maybe [Object objType] -> Maybe Text -> Collection objType
+makeCollection objs url = Collection
+  { _cTotalItems = fmap length objs
+  , _cItems      = objs
+  , _cURL        = url
+  }

Codec/ActivityStream/Schema.hs

@@ -0,0 +1,208 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Codec.ActivityStream.Schema where
+
+import Data.Aeson hiding (Object)
+import Data.Aeson.TH
+import Data.DateTime
+import Data.Text (Text)
+
+import Codec.ActivityStream.Internal
+import Codec.ActivityStream.Representation
+
+data SchemaVerb
+  = Accept
+  | Access
+  | Acknowledge
+  | Add
+  | Agree
+  | Append
+  | Approve
+  | Archive
+  | Assign
+  | At
+  | Attach
+  | Attend
+  | Author
+  | Authorize
+  | Borrow
+  | Build
+  | Cancel
+  | Close
+  | Complete
+  | Confirm
+  | Consume
+  | Checkin
+  | Create
+  | Delete
+  | Deliver
+  | Deny
+  | Disagree
+  | Dislike
+  | Experience
+  | Favorite
+  | Find
+  | FlagAsInappropriate
+  | Follow
+  | Give
+  | Host
+  | Ignore
+  | Insert
+  | Install
+  | Interact
+  | Invite
+  | Join
+  | Leave
+  | Like
+  | Listen
+  | Lose
+  | MakeFriend
+  | Open
+  | Play
+  | Post
+  | Present
+  | Purchase
+  | Qualify
+  | Read
+  | Receive
+  | Reject
+  | Remove
+  | RemoveFriend
+  | Replace
+  | Request
+  | RequestFriend
+  | Resolve
+  | Return
+  | Retract
+  | RsvpMaybe
+  | RsvpNo
+  | RsvpYes
+  | Satisfy
+  | Save
+  | Schedule
+  | Search
+  | Sell
+  | Send
+  | Share
+  | Sponsor
+  | Start
+  | StopFollowing
+  | Submit
+  | Tag
+  | Terminate
+  | Tie
+  | Unfavorite
+  | Unlike
+  | Unsatisfy
+  | Unsave
+  | Unshare
+  | Update
+  | Use
+  | Watch
+  | Win
+    deriving (Eq, Show, Read)
+
+deriveJSON (commonOptsCC "") ''SchemaVerb
+
+data SchemaObjectType
+  = Alert
+  | Application
+  | Article
+  | Audio
+  | Badge
+  | Binary
+  | Bookmark
+  | Collection
+  | Comment
+  | Device
+  | Event
+  | File
+  | Game
+  | Group
+  | Image
+  | Issue
+  | Job
+  | Note
+  | Offer
+  | Organization
+  | Page
+  | Person
+  | Place
+  | Process
+  | Product
+  | Question
+  | Review
+  | Service
+  | Task
+  | Video
+    deriving (Eq, Show, Read)
+
+deriveJSON (commonOptsCC "") ''SchemaObjectType
+
+type SchemaObject = Object SchemaObjectType
+type SchemaCollection = Collection SchemaObjectType
+
+data AVObj = AVObj
+  { avEmbedCode :: Maybe Text
+  , avStream    :: Maybe MediaLink
+  , avRest      :: SchemaObject
+  } deriving (Eq, Show)
+
+data BinaryObj = BinaryObj
+  { bnCompression :: Maybe Text
+  , bnData        :: Maybe Text
+  , bnFileUrl     :: Maybe Text
+  , bnLength      :: Maybe Int
+  , bnMd5         :: Maybe Text
+  , bnMimeType    :: Maybe Text
+  , bnRest        :: SchemaObject
+  } deriving (Eq, Show)
+
+data EventObj = EventObj
+  { evAttendedBy     :: Maybe SchemaCollection
+  , evAttending      :: Maybe SchemaCollection
+  , evEndTime        :: Maybe DateTime
+  , evInvited        :: Maybe SchemaCollection
+  , evMaybeAttending :: Maybe SchemaCollection
+  , evNotAttendedBy  :: Maybe SchemaCollection
+  , evNotAttending   :: Maybe SchemaCollection
+  , evStartTime      :: Maybe DateTime
+  , evRest           :: SchemaObject
+  } deriving (Eq, Show)
+
+data IssueObj = IssueObj
+  { isTypes  :: Maybe [Text]
+  , isRest   :: SchemaObject
+  } deriving (Eq, Show)
+
+data PlaceObj = PlaceObj
+  { plPosition :: Maybe PlacePositionObj
+  , plAddress  :: Maybe PlaceAddressObj
+  , plRest     :: SchemaObject
+  } deriving (Eq, Show)
+
+data PlacePositionObj = PlacePositionObj
+  { ppAltitude  :: Integer
+  , ppLatitude  :: Integer
+  , ppLongitude :: Integer
+  } deriving (Eq, Show)
+
+data PlaceAddressObj = PlaceAddressObj
+  { paFormatted     :: Text
+  , paStreetAddress :: Text
+  , paLocality      :: Text
+  , paRegion        :: Text
+  , paPostalCode    :: Text
+  , paCountry       :: Text
+  } deriving (Eq, Show)
+
+data TaskObj = TaskObj
+  { tsActor         :: Maybe SchemaObject
+  , tsBy            :: Maybe DateTime
+  , tsObject        :: Maybe SchemaObject
+  , tsPrerequisites :: Maybe [TaskObj]
+  , tsRequired      :: Maybe Bool
+  , tsSupersedes    :: Maybe [TaskObj]
+  , tsVerb          :: Maybe SchemaVerb
+  , tsRest          :: SchemaObject
+  } deriving (Eq, Show)

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2014, Getty Ritter
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Getty Ritter nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

activitystreams-aeson.cabal

@@ -0,0 +1,24 @@
+-- Initial activitystreams-aeson.cabal generated by cabal init.  For
+-- further documentation, see http://haskell.org/cabal/users-guide/
+
+name:                activitystreams-aeson
+version:             0.1.0.0
+-- synopsis:
+-- description:
+license:             BSD3
+license-file:        LICENSE
+author:              Getty Ritter
+maintainer:          gettylefou@gmail.com
+-- copyright:
+category:            Codec
+build-type:          Simple
+-- extra-source-files:
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Codec.ActivityStream.Representation,
+                       Codec.ActivityStream.Schema,
+                       Codec.ActivityStream
+  other-modules:       Codec.ActivityStream.Internal
+  build-depends:       base >=4.7 && <4.8, aeson, text, url, lens, datetime, unordered-containers
+  default-language:    Haskell2010