Browse Source

Ticked version; removed non-Dynamic version of library

Getty Ritter 9 years ago
parent
commit
f67a82a01b

+ 19 - 0
Codec/ActivityStream.hs

@@ -1,5 +1,24 @@
 {-# LANGUAGE TemplateHaskell #-}
 
+{-|
+Module      : Codec.ActivityStream
+Description : The basic Activity Streams structures
+Copyright   : (c) Getty Ritter, 2014
+Maintainer  : gdritter@galois.com
+
+This is an interface to ActivityStreams that simply wraps an underlying
+@aeson@ Object, and exposes a set of convenient lenses to access the
+values inside. If an @aeson@ object appears wrapped in some respective wrapper,
+it will necessarily contain the obligatory values for that type
+(e.g. an 'Activity' is guaranteed to have a @published@ date.)
+
+Most of the inline documentation is drawn directly from the
+<http://activitystrea.ms/specs/json/1.0/ JSON Activity Streams 1.0>
+specification, with minor modifications
+to refer to the corresponding data types in this module and to clarify
+certain aspects.
+-}
+
 module Codec.ActivityStream
   ( module Codec.ActivityStream.Representation
   ) where

+ 0 - 270
Codec/ActivityStream/DynamicSchema.hs

@@ -1,405 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-{-|
-Module      : Codec.ActivityStream.DynamicSchema
-Description : A (more dynamic) interface to the Activity Streams Base Schema
-Copyright   : (c) Getty Ritter, 2014
-Maintainer  : gdritter@galois.com
-
-This is an interface to the extended ActivityStreams schema which defines
-an extensive set of @verb@ values, additional @objectType@ values, and a
-set of extended properties for 'Object's.
-
-Most of the inline documentation is drawn directly from the
-<https://github.com/activitystreams/activity-schema/blob/master/activity-schema.md Activity Base Schema draft>
-specification, with minor modifications
-to refer to the corresponding data types in this module and to clarify
-certain aspects. This is not an approved draft, and as such may be
-subject to changes which will be reflected in this module. In contrast to
-"Codec.ActivityStream", the API in this module makes __no guarantees about
-long-term stability__.
--}
-
-module Codec.ActivityStream.DynamicSchema
-  ( module Codec.ActivityStream.Dynamic
-  -- * Verbs
-  , SchemaVerb(..)
-  -- * Object Types
-  , SchemaObjectType(..)
-  -- ** Audio/Video
-  , avEmbedCode
-  , avStream
-  -- ** Binary
-  , bnCompression
-  , bnData
-  , bnFileUrl
-  , bnLength
-  , bnMd5
-  , bnMimeType
-  -- ** Event
-  , evAttendedBy
-  , evAttending
-  , evEndTime
-  , evInvited
-  , evMaybeAttending
-  , evNotAttendedBy
-  , evNotAttending
-  , evStartTime
-  -- ** Issue
-  , isTypes
-  -- ** Permission
-  , pmScope
-  , pmActions
-  -- ** Place
-  , plPosition
-  , plAddress
-  -- *** PlacePosition
-  , PlacePosition
-  -- *** PlaceAddress
-  , PlaceAddress
-  -- ** Role/Group
-  , rlMembers
-  -- ** Task
-  , tsActor
-  , tsBy
-  , tsObject
-  , tsPrerequisites
-  , tsRequired
-  , tsSupersedes
-  , tsVerb
-  -- * Basic Extension Properties
-  , acContext
-  , getLocation
-  , oMood
-  , oRating
-  , acResult
-  , getSource
-  , getStartTime
-  , getEndTime
-  , oTags
-    -- * Mood
-  , Mood
-  , moodRest
-  , moodDisplayName
-  , moodImage
-  ) where
-
-import qualified Data.Aeson as Aeson
-import           Data.DateTime (DateTime)
-import           Data.Aeson ( FromJSON(..), ToJSON(..) )
-import qualified Data.HashMap.Strict as HM
-import           Data.Text (Text)
-
-import Codec.ActivityStream.LensInternal
-import Codec.ActivityStream.Dynamic
-import Codec.ActivityStream.Schema (SchemaVerb(..), SchemaObjectType(..))
-
-
-avEmbedCode :: Lens' Object (Maybe Text)
-avEmbedCode = makeAesonLensMb "embedCode" oRest
-
-avStream :: Lens' Object (Maybe MediaLink)
-avStream = makeAesonLensMb "stream" oRest
-
-
-bnCompression :: Lens' Object (Maybe Text)
-bnCompression = makeAesonLensMb "compression" oRest
-
-bnData :: Lens' Object (Maybe Text)
-bnData = makeAesonLensMb "data" oRest
-bnFileUrl :: Lens' Object (Maybe Text)
-bnFileUrl = makeAesonLensMb "fileUrl" oRest
-
-bnLength :: Lens' Object (Maybe Text)
-bnLength = makeAesonLensMb "length" oRest
-
-bnMd5 :: Lens' Object (Maybe Text)
-bnMd5 = makeAesonLensMb "md5" oRest
-
-bnMimeType :: Lens' Object (Maybe Text)
-bnMimeType = makeAesonLensMb "mimeType" oRest
-
-
-evAttendedBy :: Lens' Object (Maybe Collection)
-evAttendedBy = makeAesonLensMb "attendedBy" oRest
-
-evAttending :: Lens' Object (Maybe Collection)
-evAttending = makeAesonLensMb "attending" oRest
-
-evEndTime :: Lens' Object (Maybe DateTime)
-evEndTime = makeAesonLensMb "endTime" oRest
-
-evInvited :: Lens' Object (Maybe Collection)
-evInvited = makeAesonLensMb "invited" oRest
-
-evMaybeAttending :: Lens' Object (Maybe Collection)
-evMaybeAttending = makeAesonLensMb "maybeAttending" oRest
-
-evNotAttendedBy :: Lens' Object (Maybe Collection)
-evNotAttendedBy = makeAesonLensMb "notAttendedBy" oRest
-
-evNotAttending :: Lens' Object (Maybe Collection)
-evNotAttending = makeAesonLensMb "notAttending" oRest
-
-evStartTime :: Lens' Object (Maybe DateTime)
-evStartTime = makeAesonLensMb "startTime" oRest
-
-
-isTypes :: Lens' Object (Maybe [Text])
-isTypes = makeAesonLensMb "types" oRest
-
-
-pmScope :: Lens' Object (Maybe Object)
-pmScope = makeAesonLensMb "scope" oRest
-
-pmActions :: Lens' Object (Maybe [Text])
-pmActions = makeAesonLensMb "actions" oRest
-
-
-plPosition :: Lens' Object (Maybe PlacePosition)
-plPosition = makeAesonLensMb "position" oRest
-
-plAddress :: Lens' Object (Maybe PlaceAddress)
-plAddress = makeAesonLensMb "address" oRest
-
-data PlacePosition = PPO { fromPPO :: Aeson.Object } deriving (Eq, Show)
-
-instance FromJSON PlacePosition where
-  parseJSON (Aeson.Object o)
-    |    HM.member "altitude" o
-      && HM.member "latitude" o
-      && HM.member "longitude" o = return (PPO o)
-    | otherwise = fail "..."
-  parseJSON _ = fail "..."
-
-instance ToJSON PlacePosition where
-  toJSON = Aeson.Object . fromPPO
-
-data PlaceAddress = PAO { fromPAO :: Aeson.Object } deriving (Eq, Show)
-
-instance FromJSON PlaceAddress where
-  parseJSON (Aeson.Object o)
-    |    HM.member "formatted" o
-      && HM.member "streetAddress" o
-      && HM.member "locality" o
-      && HM.member "region" o
-      && HM.member "postalCode" o
-      && HM.member "country" o = return (PAO o)
-    | otherwise = fail "..."
-  parseJSON _ = fail "..."
-
-instance ToJSON PlaceAddress where
-  toJSON = Aeson.Object . fromPAO
-
-
-rlMembers :: Lens' Object (Maybe [Object])
-rlMembers = makeAesonLensMb "members" oRest
-
-
-tsActor :: Lens' Object (Maybe Object)
-tsActor = makeAesonLensMb "actor" oRest
-
-tsBy :: Lens' Object (Maybe DateTime)
-tsBy = makeAesonLensMb "by" oRest
-
-tsObject :: Lens' Object (Maybe Object)
-tsObject = makeAesonLensMb "object" oRest
-
-tsPrerequisites :: Lens' Object (Maybe [Object])
-tsPrerequisites = makeAesonLensMb "prerequisites" oRest
-
-tsRequired :: Lens' Object (Maybe Bool)
-tsRequired = makeAesonLensMb "required" oRest
-
-tsSupersedes :: Lens' Object (Maybe [Object])
-tsSupersedes = makeAesonLensMb "supersedes" oRest
-
-tsVerb :: Lens' Object (Maybe SchemaVerb)
-tsVerb = makeAesonLensMb "verb" oRest
-
-
-acContext :: Lens' Activity (Maybe Object)
-acContext = makeAesonLensMb "context" acRest
-
-getLocation :: Lens' a Aeson.Object -> Lens' a (Maybe Object)
-getLocation = makeAesonLensMb "location"
-
-oMood :: Lens' Object (Maybe Mood)
-oMood = makeAesonLensMb "mood" oRest
-
-oRating :: Lens' Object (Maybe Double)
-oRating = makeAesonLensMb "rating" oRest
-
-acResult :: Lens' Activity (Maybe Object)
-acResult = makeAesonLensMb "result" acRest
-
---
-getSource :: Lens' a Aeson.Object -> Lens' a (Maybe Object)
-getSource = makeAesonLensMb "source"
-
-getStartTime :: Lens' a Aeson.Object -> Lens' a (Maybe Text)
-getStartTime = makeAesonLensMb "startTime"
-
-getEndTime :: Lens' a Aeson.Object -> Lens' a (Maybe Text)
-getEndTime = makeAesonLensMb "endTime"
-
-oTags :: Lens' Object (Maybe [Object])
-oTags = makeAesonLensMb "tags" oRest
-
-
-data Mood = Mood { fromMood :: Aeson.Object } deriving (Eq, Show)
-
-instance FromJSON Mood where
-  parseJSON (Aeson.Object o)
-    |    HM.member "displayName" o
-      && HM.member "image" o = return (Mood o)
-    | otherwise = fail "..."
-  parseJSON _ = fail "..."
-
-instance ToJSON Mood where
-  toJSON = Aeson.Object . fromMood
-
-moodRest :: Lens' Mood Aeson.Object
-moodRest = makeLens fromMood (\ o' m -> m { fromMood = o' })
-
-moodDisplayName :: Lens' Mood Text
-moodDisplayName = makeAesonLens "displayName" moodRest
-
-moodImage :: Lens' Mood MediaLink
-moodImage = makeAesonLens "image" moodRest

+ 13 - 10
Codec/ActivityStream/Internal.hs

@@ -1,20 +1,22 @@
 {-# LANGUAGE ViewPatterns #-}
 
-module Codec.ActivityStream.Internal (commonOpts, commonOptsCC) where
+module Codec.ActivityStream.Internal (commonOpts, commonOptsCC, ensure) where
 
 import Control.Monad (mzero)
 import Data.Aeson
 import Data.Aeson.TH
 import Data.Char
-import Data.Text (pack, unpack)
-import Network.URI (URI, parseURI)
-
-instance FromJSON URI where
-  parseJSON (String ((parseURI . unpack) -> Just u)) = return u
-  parseJSON _ = mzero
-
-instance ToJSON URI where
-  toJSON = String . pack . show
+import Data.HashMap.Strict (HashMap, member)
+import Data.Monoid ((<>))
+import Data.Text (Text, pack, unpack)
+
+ensure :: Monad m => String -> HashMap Text Value -> [Text] -> m ()
+ensure objName obj keys = mapM_ go keys
+  where go k
+          | member k obj = return ()
+          | otherwise = fail ("Object \"" <> objName <>
+                              "\" does not contain property \"" <>
+                              unpack k <> "\"")
 
 toCamelCaseUpper :: String -> String
 toCamelCaseUpper = toCamelCase True
@@ -50,4 +52,5 @@ commonOptsCC prefix = defaultOptions
   { fieldLabelModifier     = fromCamelCase . drop (length prefix)
   , constructorTagModifier = fromCamelCase
   , omitNothingFields      = True
+
   }

+ 439 - 190
Codec/ActivityStream/Representation.hs

@@ -1,200 +1,449 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
 
-module Codec.ActivityStream.Representation where
 
-import           Control.Applicative
-import           Control.Lens hiding ((.=))
+{-|
+Module      : Codec.ActivityStream.Representation
+Description : A (more dynamic) interface to Activity Streams
+Copyright   : (c) Getty Ritter, 2014
+Maintainer  : gdritter@galois.com
+
+This is an interface to ActivityStreams that simply wraps an underlying
+@aeson@ Object, and exposes a set of (convenient) lenses to access the
+values inside. If an @aeson@ object is wrapped in the respective wrapper,
+it will contain the obligatory values for that type (e.g. an 'Activity'
+is guaranteed to have a @published@ date.)
+
+Most of the inline documentation is drawn directly from the
+<http://activitystrea.ms/specs/json/1.0/ JSON Activity Streams 1.0>
+specification, with minor modifications
+to refer to the corresponding data types in this module and to clarify
+certain aspects.
+-}
+
+module Codec.ActivityStream.Representation
+       ( Lens'
+         -- * Object
+       , Object
+       , emptyObject
+         -- ** Object Lenses
+       , oAttachments
+       , oAuthor
+       , oContent
+       , oDisplayName
+       , oDownstreamDuplicates
+       , oId
+       , oImage
+       , oObjectType
+       , oPublished
+       , oSummary
+       , oUpdated
+       , oUpstreamDuplicates
+       , oURL
+       , oRest
+         -- * Activity
+       , Activity
+       , makeActivity
+       , asObject
+         -- ** Activity Lenses
+       , acActor
+       , acContent
+       , acGenerator
+       , acIcon
+       , acId
+       , acObject
+       , acPublished
+       , acProvider
+       , acTarget
+       , acTitle
+       , acUpdated
+       , acURL
+       , acVerb
+       , acRest
+         -- * MediaLink
+       , MediaLink
+       , makeMediaLink
+         -- ** MediaLink Lenses
+       , mlDuration
+       , mlHeight
+       , mlWidth
+       , mlURL
+       , mlRest
+         -- * Collection
+       , Collection
+       , makeCollection
+         -- ** Collection Lenses
+       , cTotalItems
+       , cItems
+       , cURL
+       , cRest
+       ) where
+
 import           Data.Aeson ( FromJSON(..)
                             , ToJSON(..)
-                            , Value
+                            , Result(..)
                             , fromJSON
-                            , object
-                            , (.=)
-                            , (.:)
-                            , (.:?)
                             )
-import qualified Data.Aeson as Ae
-import           Data.Aeson.TH
-import           Data.DateTime
+import qualified Data.Aeson as A
+import           Data.DateTime (DateTime)
 import qualified Data.HashMap.Strict as HM
-import           Data.Maybe (catMaybes)
 import           Data.Text (Text)
-import           Network.URI
-
-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          :: [Object objType]
-  , _oAuthor               :: Maybe (Object objType)
-  , _oContent              :: Maybe Text
-  , _oDisplayName          :: Maybe Text
-  , _oDownstreamDuplicates :: [URI]
-  , _oId                   :: Maybe URI
-  , _oImage                :: Maybe MediaLink
-  , _oObjectType           :: Maybe objType
-  , _oPublished            :: Maybe DateTime
-  , _oSummary              :: Maybe Text
-  , _oUpdated              :: Maybe DateTime
-  , _oUpstreamDuplicates   :: [URI]
-  , _oURL                  :: Maybe URI
-  , _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 <$> fmap go (o .:? "attachments")
-           <*> o .:? "author"
-           <*> o .:? "content"
-           <*> o .:? "displayName"
-           <*> fmap go (o .:? "downstreamDuplicates")
-           <*> o .:? "id"
-           <*> o .:? "image"
-           <*> o .:? "objectType"
-           <*> o .:? "published"
-           <*> o .:? "summary"
-           <*> o .:? "updated"
-           <*> fmap go (o .:? "upstreamDuplicates")
-           <*> o .:? "url"
-           <*> pure rest
-    where rest = HM.toList (foldr HM.delete o objectFields)
-          go :: Maybe [a] -> [a]
-          go Nothing   = []
-          go (Just xs) = xs
-
-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 .=?
-          (.=!) :: ToJSON a => Text -> [a] -> Maybe (Text, Value)
-          _ .=! [] = Nothing
-          x .=! ys = Just (x, toJSON ys)
-          infix 1 .=!
-
-emptyObject :: Object objType
-emptyObject = Object
-  { _oAttachments          = []
-  , _oAuthor               = Nothing
-  , _oContent              = Nothing
-  , _oDisplayName          = Nothing
-  , _oDownstreamDuplicates = []
-  , _oId                   = Nothing
-  , _oImage                = Nothing
-  , _oObjectType           = Nothing
-  , _oPublished            = Nothing
-  , _oSummary              = Nothing
-  , _oUpdated              = Nothing
-  , _oUpstreamDuplicates   = []
-  , _oURL                  = Nothing
-  , _oRest                 = []
-  }
-
-data Activity verb objType = Activity
-  { _acActor     :: Object objType
-  , _acContent   :: Maybe Text
-  , _acGenerator :: Maybe (Object objType)
-  , _acIcon      :: Maybe MediaLink
-  , _acId        :: Maybe URI
-  , _acPublished :: DateTime
-  , _acProvider  :: Object objType
-  , _acTarget    :: Maybe (Object objType)
-  , _acTitle     :: Maybe Text
-  , _acUpdated   :: Maybe DateTime
-  , _acURL       :: Maybe URI
-  , _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      :: [Object objType]
-  , _cURL        :: Maybe URI
-  } deriving (Eq, Show)
-
-makeLenses ''Collection
-deriveJSON (commonOpts "_c") ''Collection
-
-makeCollection :: [Object objType] -> Maybe URI -> Collection objType
+
+import Codec.ActivityStream.Internal (ensure)
+import Codec.ActivityStream.LensInternal
+
+-- | Some types of objects may have an alternative visual representation in
+--   the form of an image, video or embedded HTML fragments. A 'MediaLink'
+--   represents a hyperlink to such resources.
+newtype MediaLink = MediaLink { fromMediaLink :: A.Object } deriving (Eq, Show)
+
+instance FromJSON MediaLink where
+  parseJSON (A.Object o) = do
+    ensure "MediaLink" o ["url"]
+    return (MediaLink o)
+  parseJSON _ = fail "MediaLink not an object"
+
+instance ToJSON MediaLink where
+  toJSON (MediaLink o) = A.Object o
+
+-- | Access the underlying JSON object that represents a Media Link
+mlRest :: Lens' MediaLink A.Object
+mlRest = makeLens fromMediaLink (\ o' m -> m { fromMediaLink = o' })
+
+-- | A hint to the consumer about the length, in seconds, of the media
+--   resource identified by the url property. A media link MAY contain
+--   a "duration" property when the target resource is a time-based
+--   media item such as an audio or video.
+mlDuration :: Lens' MediaLink (Maybe Int)
+mlDuration = makeAesonLensMb "duration" mlRest
+
+-- | A hint to the consumer about the height, in pixels, of the media
+--   resource identified by the url property. A media link MAY contain
+--   a @height@ property when the target resource is a visual media item
+--   such as an image, video or embeddable HTML page.
+mlHeight :: Lens' MediaLink (Maybe Int)
+mlHeight = makeAesonLensMb "height" mlRest
+
+-- | A hint to the consumer about the width, in pixels, of the media
+--   resource identified by the url property. A media link MAY contain
+--   a @width@ property when the target resource is a visual media item
+--   such as an image, video or embeddable HTML page.
+mlWidth :: Lens' MediaLink (Maybe Int)
+mlWidth = makeAesonLensMb "width" mlRest
+
+-- | The IRI of the media resource being linked. A media link MUST have a
+--   @url@ property.
+mlURL :: Lens' MediaLink Text
+mlURL = makeAesonLens "url" mlRest
+
+-- | Create a @MediaLink@ with just a @url@ property, and all other
+--   properties undefined.
+makeMediaLink :: Text -> MediaLink
+makeMediaLink url = MediaLink (HM.insert "url" (toJSON url) HM.empty)
+
+-- | Within the specification, an 'Object' is a thing, real or
+--   imaginary, which participates in an activity. It may be the
+--   entity performing the activity, or the entity on which the
+--   activity was performed. An object consists of properties
+--   defined below. Certain object types may
+--   further refine the meaning of these properties, or they may
+--   define additional properties.
+--
+--   To maintain this flexibility in the Haskell environment, an
+--   'Object' is an opaque wrapper over an underlying JSON value,
+--   and the 'oRest' accessor can be used to access that underlying
+--   value.
+
+newtype Object = Object { fromObject :: A.Object } deriving (Eq, Show)
+
+instance FromJSON Object where
+  parseJSON (A.Object o) = return (Object o)
+  parseJSON _            = fail "Object not an object"
+
+instance ToJSON Object where
+  toJSON (Object o) = A.Object o
+
+-- | Access the underlying JSON object that represents an 'Object'
+oRest :: Lens' Object A.Object
+oRest = makeLens fromObject (\ o' m -> m { fromObject = o' })
+
+-- | A collection of one or more additional, associated objects, similar
+--   to the concept of attached files in an email message. An object MAY
+--   have an attachments property whose value is a JSON Array of 'Object's.
+oAttachments :: Lens' Object (Maybe [Object])
+oAttachments = makeAesonLensMb "attachments" oRest
+
+-- | Describes the entity that created or authored the object. An object
+--   MAY contain a single author property whose value is an 'Object' of any
+--   type. Note that the author field identifies the entity that created
+--   the object and does not necessarily identify the entity that
+--   published the object. For instance, it may be the case that an
+--   object created by one person is posted and published to a system by
+--   an entirely different entity.
+oAuthor :: Lens' Object (Maybe Object)
+oAuthor = makeAesonLensMb "author" oRest
+
+-- | Natural-language description of the object encoded as a single JSON
+--   String containing HTML markup. Visual elements such as thumbnail
+--   images MAY be included. An object MAY contain a @content@ property.
+oContent :: Lens' Object (Maybe Text)
+oContent = makeAesonLensMb "content" oRest
+
+-- | A natural-language, human-readable and plain-text name for the
+--   object. HTML markup MUST NOT be included. An object MAY contain
+--   a @displayName@ property. If the object does not specify an @objectType@
+--   property, the object SHOULD specify a @displayName@.
+oDisplayName :: Lens' Object (Maybe Text)
+oDisplayName = makeAesonLensMb "displayName" oRest
+
+-- | A JSON Array of one or more absolute IRI's
+--   <http://www.ietf.org/rfc/rfc3987.txt [RFC3987]> identifying
+--   objects that duplicate this object's content. An object SHOULD
+--   contain a @downstreamDuplicates@ property when there are known objects,
+--   possibly in a different system, that duplicate the content in this
+--   object. This MAY be used as a hint for consumers to use when
+--   resolving duplicates between objects received from different sources.
+oDownstreamDuplicates :: Lens' Object (Maybe [Text])
+oDownstreamDuplicates = makeAesonLensMb "downstreamDuplicates" oRest
+
+-- | Provides a permanent, universally unique identifier for the object in
+--   the form of an absolute IRI
+--   <http://www.ietf.org/rfc/rfc3987.txt [RFC3987]>. An
+--   object SHOULD contain a single @id@ property. If an object does not
+--   contain an @id@ property, consumers MAY use the value of the @url@
+--   property as a less-reliable, non-unique identifier.
+
+oId :: Lens' Object (Maybe Text)
+oId = makeAesonLensMb "id" oRest
+
+-- | Description of a resource providing a visual representation of the
+--   object, intended for human consumption. An object MAY contain an
+--   @image@ property whose value is a 'MediaLink'.
+oImage :: Lens' Object (Maybe MediaLink)
+oImage = makeAesonLensMb "image" oRest
+
+-- | Identifies the type of object. An object MAY contain an @objectType@
+--   property whose value is a JSON String that is non-empty and matches
+--   either the "isegment-nz-nc" or the \"IRI\" production in
+--   <http://www.ietf.org/rfc/rfc3987.txt [RFC3987]>. Note
+--   that the use of a relative reference other than a simple name is
+--   not allowed. If no @objectType@ property is contained, the object has
+--   no specific type.
+oObjectType :: (FromJSON o, ToJSON o) => Lens' Object (Maybe o)
+oObjectType = makeAesonLensMb "objectType" oRest
+
+-- | The date and time at which the object was published. An object MAY
+--   contain a @published@ property.
+oPublished :: Lens' Object (Maybe DateTime)
+oPublished = makeAesonLensMb "published" oRest
+
+-- | Natural-language summarization of the object encoded as a single
+--   JSON String containing HTML markup. Visual elements such as thumbnail
+--   images MAY be included. An activity MAY contain a @summary@ property.
+oSummary :: Lens' Object (Maybe Text)
+oSummary = makeAesonLensMb "summary" oRest
+
+-- | The date and time at which a previously published object has been
+--   modified. An Object MAY contain an @updated@ property.
+oUpdated :: Lens' Object (Maybe DateTime)
+oUpdated = makeAesonLensMb "updated" oRest
+
+-- | A JSON Array of one or more absolute IRI's
+--   <http://www.ietf.org/rfc/rfc3987.txt [RFC3987]> identifying
+--   objects that duplicate this object's content. An object SHOULD contain
+--   an @upstreamDuplicates@ property when a publisher is knowingly
+--   duplicating with a new ID the content from another object. This MAY be
+--   used as a hint for consumers to use when resolving duplicates between
+--   objects received from different sources.
+oUpstreamDuplicates :: Lens' Object (Maybe [Text])
+oUpstreamDuplicates = makeAesonLensMb "upstreamDuplicates" oRest
+
+-- | An IRI <http://www.ietf.org/rfc/rfc3987.txt [RFC3987]>
+--   identifying a resource providing an HTML representation of the
+--   object. An object MAY contain a url property
+oURL :: Lens' Object (Maybe Text)
+oURL = makeAesonLensMb "url" oRest
+
+-- | Create an @Object@ with no fields.
+emptyObject :: Object
+emptyObject = Object HM.empty
+
+-- | In its simplest form, an 'Activity' consists of an @actor@, a @verb@, an
+--   @object@, and a @target@. It tells the story of a person performing an
+--   action on or with an object -- "Geraldine posted a photo to her
+--   album" or "John shared a video". In most cases these components
+--   will be explicit, but they may also be implied.
+
+newtype Activity = Activity { fromActivity :: A.Object } deriving (Eq, Show)
+
+instance FromJSON Activity where
+  parseJSON (A.Object o) = do
+    ensure "Activity" o ["published", "provider"]
+    return (Activity o)
+  parseJSON _ = fail "\"Activity\" not an object"
+
+instance ToJSON Activity where
+  toJSON (Activity o) = A.Object o
+
+-- | Access the underlying JSON object that represents an 'Activity'
+acRest :: Lens' Activity A.Object
+acRest = makeLens fromActivity (\ o' m -> m { fromActivity = o' })
+
+-- | Describes the entity that performed the activity. An activity MUST
+--   contain one @actor@ property whose value is a single 'Object'.
+acActor :: Lens' Activity Object
+acActor = makeAesonLens "actor" acRest
+
+-- | Natural-language description of the activity encoded as a single
+--   JSON String containing HTML markup. Visual elements such as
+--   thumbnail images MAY be included. An activity MAY contain a
+--   @content@ property.
+acContent :: Lens' Activity (Maybe Text)
+acContent = makeAesonLensMb "content" acRest
+
+-- | Describes the application that generated the activity. An activity
+--   MAY contain a @generator@ property whose value is a single 'Object'.
+acGenerator :: Lens' Activity (Maybe Object)
+acGenerator = makeAesonLens "generator" acRest
+
+-- | Description of a resource providing a visual representation of the
+--   object, intended for human consumption. The image SHOULD have an
+--   aspect ratio of one (horizontal) to one (vertical) and SHOULD be
+--   suitable for presentation at a small size. An activity MAY have
+--   an @icon@ property.
+acIcon :: Lens' Activity (Maybe MediaLink)
+acIcon = makeAesonLensMb "icon" acRest
+
+-- | Provides a permanent, universally unique identifier for the activity
+--   in the form of an absolute IRI
+--   <http://www.ietf.org/rfc/rfc3987.txt [RFC3987]>. An
+--   activity SHOULD contain a single @id@ property. If an activity does
+--   not contain an @id@ property, consumers MAY use the value of the
+--   @url@ property as a less-reliable, non-unique identifier.
+acId :: Lens' Activity (Maybe Text)
+acId = makeAesonLensMb "id" acRest
+
+-- | Describes the primary object of the activity. For instance, in the
+--   activity, "John saved a movie to his wishlist", the object of the
+--   activity is "movie". An activity SHOULD contain an @object@ property
+--   whose value is a single 'Object'. If the @object@ property is not
+--   contained, the primary object of the activity MAY be implied by
+--   context.
+acObject :: Lens' Activity (Maybe Object)
+acObject = makeAesonLensMb "object" acRest
+
+-- | The date and time at which the activity was published. An activity
+--   MUST contain a @published@ property.
+acPublished :: Lens' Activity DateTime
+acPublished = makeAesonLens "published" acRest
+
+-- | Describes the application that published the activity. Note that this
+--   is not necessarily the same entity that generated the activity. An
+--   activity MAY contain a @provider@ property whose value is a
+--   single 'Object'.
+acProvider :: Lens' Activity (Maybe Object)
+acProvider = makeAesonLensMb "provider" acRest
+
+-- | Describes the target of the activity. The precise meaning of the
+--   activity's target is dependent on the activities verb, but will
+--   often be the object the English preposition "to". For instance, in
+--   the activity, "John saved a movie to his wishlist", the target of
+--   the activity is "wishlist". The activity target MUST NOT be used
+--   to identity an indirect object that is not a target of the
+--   activity. An activity MAY contain a @target@ property whose value
+--   is a single 'Object'.
+acTarget :: Lens' Activity (Maybe Object)
+acTarget = makeAesonLensMb "target" acRest
+
+-- | Natural-language title or headline for the activity encoded as a
+--  single JSON String containing HTML markup. An activity MAY contain
+--  a @title@ property.
+acTitle :: Lens' Activity (Maybe Text)
+acTitle = makeAesonLensMb "title" acRest
+
+-- | The date and time at which a previously published activity has
+--   been modified. An Activity MAY contain an @updated@ property.
+acUpdated :: Lens' Activity (Maybe DateTime)
+acUpdated = makeAesonLensMb "updated" acRest
+
+-- | An IRI <http://www.ietf.org/rfc/rfc3987.txt RFC3987>
+--   identifying a resource providing an HTML representation of the
+--   activity. An activity MAY contain a @url@ property.
+acURL :: Lens' Activity (Maybe Text)
+acURL = makeAesonLensMb "url" acRest
+
+-- | Identifies the action that the activity describes. An activity SHOULD
+--   contain a verb property whose value is a JSON String that is
+--   non-empty and matches either the \"isegment-nz-nc\" or the
+--   \"IRI\" production in <http://www.ietf.org/rfc/rfc3987.txt [RFC3987]>.
+--   Note that the use of a relative
+--   reference other than a simple name is not allowed. If the @verb@ is
+--   not specified, or if the value is null, the @verb@ is
+--   assumed to be \"post\".
+acVerb :: (FromJSON v, ToJSON v) => Lens' Activity (Maybe v)
+acVerb = makeAesonLensMb "verb" acRest
+
+-- | Create an @Activity@ with an @actor@, @published@, and
+--   @provider@ property.
+makeActivity :: Object -> DateTime -> Activity
+makeActivity actor published = Activity
+  $ HM.insert "actor"     (toJSON actor)
+  $ HM.insert "published" (toJSON published)
+  $ HM.empty
+
+-- | JSON Activity Streams 1.0 specificies that an @Activity@ may be used as an
+--   @Object@. In such a case, the object may have fields permitted on either an
+--   @Activity@ or an @Object@
+asObject :: Activity -> Object
+asObject act = Object (fromActivity act)
+
+-- | A "collection" is a generic list of 'Object's of any object type.
+--   The @objectType@ of each item in the collection MAY be omitted if
+--   the type of object can be established through context. The collection
+--   is used primarily as the root of an Activity Streams document as described
+--   in Section 4,
+--   but can be used as the value of extension properties in a variety of
+--   situations.
+
+newtype Collection = Collection { fromCollection :: A.Object } deriving (Eq, Show)
+
+instance FromJSON Collection where
+  parseJSON (A.Object o) = return (Collection o)
+  parseJSON _            = fail "\"Collection\" not an object"
+
+instance ToJSON Collection where
+  toJSON (Collection o) = A.Object o
+
+-- | Access the underlying JSON object that represents a 'Collection'
+cRest :: Lens' Collection A.Object
+cRest = makeLens fromCollection (\ o' m -> m { fromCollection = o' })
+
+-- | Non-negative integer specifying the total number of activities
+--   within the stream. The Stream serialization MAY contain a
+--   @totalItems@ property. (NOTE: there is a typo in the original
+--   specification, in which it inconsistently refers to this as
+--   either @totalItems@ or @count@.)
+cTotalItems :: Lens' Collection (Maybe Int)
+cTotalItems = makeAesonLensMb "totalItems" cRest
+
+-- | An array containing a listing of 'Object's of any object type.
+--   If used in combination with the @url@ property, the @items@ array
+--   can be used to provide a subset of the objects that may be
+--   found in the resource identified by the @url@.
+cItems :: Lens' Collection (Maybe [Object])
+cItems = makeAesonLensMb "items" cRest
+
+-- | An IRI <http://activitystrea.ms/specs/json/1.0/#RFC3987 [RFC3987]>
+--   referencing a JSON document containing the full
+--   listing of objects in the collection.
+cURL :: Lens' Collection (Maybe Text)
+cURL = makeAesonLensMb "url" cRest
+
+-- | Create a @Collection@ with an @items@ and a @url@ property
+--   and fill in the corresponding @totalItems@ field with the
+--   length of the @items@ array.
+makeCollection :: [Object] -> Text -> Collection
 makeCollection objs url = Collection
-  { _cTotalItems = Just (length objs)
-  , _cItems      = objs
-  , _cURL        = url
-  }
+  $ HM.insert "totalItems" (toJSON (length objs))
+  $ HM.insert "items"      (toJSON objs)
+  $ HM.insert "url"        (toJSON url)
+  $ HM.empty

+ 401 - 73
Codec/ActivityStream/Schema.hs

@@ -1,14 +1,101 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Codec.ActivityStream.Schema where
+{-|
+Module      : Codec.ActivityStream.Schema
+Description : An interface to the Activity Streams Base Schema
+Copyright   : (c) Getty Ritter, 2014
+Maintainer  : gdritter@galois.com
 
-import Data.Aeson hiding (Object)
-import Data.Aeson.TH
-import Data.DateTime
-import Data.Text (Text)
+This is an interface to the extended ActivityStreams schema which defines
+an extensive set of @verb@ values, additional @objectType@ values, and a
+set of extended properties for 'Object's.
+
+Most of the inline documentation is drawn directly from the
+<https://github.com/activitystreams/activity-schema/blob/master/activity-schema.md Activity Base Schema draft>
+specification, with minor modifications
+to refer to the corresponding data types in this module and to clarify
+certain aspects. This is not an approved draft, and as such may be
+subject to changes which will be reflected in this module. In contrast to
+"Codec.ActivityStream", the API in this module makes
+__no guarantees about long-term stability__.
+-}
+
+module Codec.ActivityStream.Schema
+  ( module Codec.ActivityStream
+  -- * Verbs
+  , SchemaVerb(..)
+  -- * Object Types
+  , SchemaObjectType(..)
+  -- ** Audio/Video
+  , avEmbedCode
+  , avStream
+  -- ** Binary
+  , bnCompression
+  , bnData
+  , bnFileUrl
+  , bnLength
+  , bnMd5
+  , bnMimeType
+  -- ** Event
+  , evAttendedBy
+  , evAttending
+  , evEndTime
+  , evInvited
+  , evMaybeAttending
+  , evNotAttendedBy
+  , evNotAttending
+  , evStartTime
+  -- ** Issue
+  , isTypes
+  -- ** Permission
+  , pmScope
+  , pmActions
+  -- ** Place
+  , plPosition
+  , plAddress
+  -- *** PlacePosition
+  , PlacePosition
+  -- *** PlaceAddress
+  , PlaceAddress
+  -- ** Role/Group
+  , rlMembers
+  -- ** Task
+  , tsActor
+  , tsBy
+  , tsObject
+  , tsPrerequisites
+  , tsRequired
+  , tsSupersedes
+  , tsVerb
+  -- * Basic Extension Properties
+  , acContext
+  , getLocation
+  , oMood
+  , oRating
+  , acResult
+  , getSource
+  , getStartTime
+  , getEndTime
+  , oTags
+    -- * Mood
+  , Mood
+  , moodRest
+  , moodDisplayName
+  , moodImage
+  ) where
+
+import qualified Data.Aeson as Aeson
+import           Data.Aeson.TH (deriveJSON)
+import           Data.DateTime (DateTime)
+import           Data.Aeson ( FromJSON(..), ToJSON(..) )
+import qualified Data.HashMap.Strict as HM
+import           Data.Text (Text)
 
 import Codec.ActivityStream.Internal
-import Codec.ActivityStream.Representation
+import Codec.ActivityStream.LensInternal
+import Codec.ActivityStream
 
 -- | The ActivityStreams Base Schema specification defines the
 -- following core verbs in addition to the default post verb that is
@@ -547,70 +634,311 @@ data SchemaObjectType
 
 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)
+
+-- audio/video
+
+-- | A fragment of HTML markup that, when embedded within another HTML
+--   page, provides an interactive user-interface for viewing or listening
+--   to the video or audio stream.
+avEmbedCode :: Lens' Object (Maybe Text)
+avEmbedCode = makeAesonLensMb "embedCode" oRest
+
+-- | An Activity Streams Media Link to the video or audio content itself.
+avStream :: Lens' Object (Maybe MediaLink)
+avStream = makeAesonLensMb "stream" oRest
+
+-- binary
+
+-- | An optional token identifying a compression algorithm applied to
+--   the binary data prior to Base64-encoding. Possible algorithms
+--   are "deflate" and "gzip", respectively indicating the use of
+--   the compression mechanisms defined by RFC 1951 and RFC 1952.
+--   Additional compression algorithms MAY be used but are not defined
+--   by this specification. Note that previous versions of this
+--   specification allowed for multiple compression algorithms to be
+--   applied and listed using a comma-separated format. The use of
+--   multiple compressions is no longer permitted.
+bnCompression :: Lens' Object (Maybe Text)
+bnCompression = makeAesonLensMb "compression" oRest
+
+-- | The URL-Safe Base64-encoded representation of the binary data
+bnData :: Lens' Object (Maybe Text)
+bnData = makeAesonLensMb "data" oRest
+-- | An optional IRI for the binary data described by this object.
+bnFileUrl :: Lens' Object (Maybe Text)
+bnFileUrl = makeAesonLensMb "fileUrl" oRest
+
+-- | The total number of unencoded, uncompressed octets contained
+-- within the "data" field.
+bnLength :: Lens' Object (Maybe Text)
+bnLength = makeAesonLensMb "length" oRest
+
+-- | An optional MD5 checksum calculated over the unencoded,
+-- uncompressed octets contained within the "data" field
+bnMd5 :: Lens' Object (Maybe Text)
+bnMd5 = makeAesonLensMb "md5" oRest
+
+-- | The MIME Media Type of the binary data contained within the object.
+bnMimeType :: Lens' Object (Maybe Text)
+bnMimeType = makeAesonLensMb "mimeType" oRest
+
+-- event
+
+-- | A collection object as defined in Section 3.5 of the JSON
+-- Activity Streams specification that provides information about
+-- entities that attended the event.
+evAttendedBy :: Lens' Object (Maybe Collection)
+evAttendedBy = makeAesonLensMb "attendedBy" oRest
+
+-- | A collection object as defined in Section 3.5 of the JSON
+-- Activity Streams specification that provides information about
+-- entities that intend to attend the event.
+evAttending :: Lens' Object (Maybe Collection)
+evAttending = makeAesonLensMb "attending" oRest
+
+-- | The date and time that the event ends represented as a String
+-- conforming to the "date-time" production in [RFC3339].
+evEndTime :: Lens' Object (Maybe DateTime)
+evEndTime = makeAesonLensMb "endTime" oRest
+
+-- | A collection object as defined in Section 3.5 of the JSON
+-- Activity Streams specification that provides information about
+-- entities that have been invited to the event.
+evInvited :: Lens' Object (Maybe Collection)
+evInvited = makeAesonLensMb "invited" oRest
+
+-- | A collection object as defined in Section 3.5 of the JSON
+-- Activity Streams specification that provides information about
+-- entities that possibly may attend the event.
+evMaybeAttending :: Lens' Object (Maybe Collection)
+evMaybeAttending = makeAesonLensMb "maybeAttending" oRest
+
+-- | A collection object as defined in Section 3.5 of the JSON
+-- Activity Streams specification that provides information about
+-- entities that did not attend the event.
+evNotAttendedBy :: Lens' Object (Maybe Collection)
+evNotAttendedBy = makeAesonLensMb "notAttendedBy" oRest
+
+-- | A collection object as defined in Section 3.5 of the JSON
+-- Activity Streams specification that provides information about
+-- entities that do not intend to attend the event.
+evNotAttending :: Lens' Object (Maybe Collection)
+evNotAttending = makeAesonLensMb "notAttending" oRest
+
+-- | The date and time that the event begins represented as a String
+-- confirming to the "date-time" production in RFC 3339.
+evStartTime :: Lens' Object (Maybe DateTime)
+evStartTime = makeAesonLensMb "startTime" oRest
+
+-- issue
+
+-- | An array of one or more absolute IRI's that describe the type of
+-- issue represented by the object. Note that the IRI's are intended
+-- for use as identifiers and MAY or MAY NOT be dereferenceable.
+isTypes :: Lens' Object (Maybe [Text])
+isTypes = makeAesonLensMb "types" oRest
+
+-- permission
+
+-- | A single Activity Streams Object, of any objectType, that
+-- identifies the scope of the permission. For example, if the
+-- permission objects describes write permissions for a given file,
+-- the scope property would be a file object describing that file.
+pmScope :: Lens' Object (Maybe Object)
+pmScope = makeAesonLensMb "scope" oRest
+
+-- | An array of Strings that identify the specific actions associated
+-- with the permission. The actions are application and scope
+-- specific. No common, core set of actions is defined by this
+-- specification.
+pmActions :: Lens' Object (Maybe [Text])
+pmActions = makeAesonLensMb "actions" oRest
+
+-- place
+
+-- | The latitude, longitude and altitude of the place as a point on
+-- Earth. Represented as a JSON Object as described below.
+plPosition :: Lens' Object (Maybe PlacePosition)
+plPosition = makeAesonLensMb "position" oRest
+
+-- | A physical address represented as a JSON object as described below.
+plAddress :: Lens' Object (Maybe PlaceAddress)
+plAddress = makeAesonLensMb "address" oRest
+
+newtype PlacePosition = PPO { fromPPO :: Aeson.Object } deriving (Eq, Show)
+
+instance FromJSON PlacePosition where
+  parseJSON (Aeson.Object o) = do
+    ensure "Position" o
+      ["altitude", "latitude", "longitude"]
+    return (PPO o)
+  parseJSON _ = fail "\"Position\" not an object"
+
+instance ToJSON PlacePosition where
+  toJSON = Aeson.Object . fromPPO
+
+newtype PlaceAddress = PAO { fromPAO :: Aeson.Object } deriving (Eq, Show)
+
+instance FromJSON PlaceAddress where
+  parseJSON (Aeson.Object o) = do
+    ensure "Address" o
+      [ "formatted"
+      , "streetAddress"
+      , "locality"
+      , "postalCode"
+      , "country"
+      ]
+    return (PAO o)
+  parseJSON _ = fail "Address not an object"
+
+instance ToJSON PlaceAddress where
+  toJSON = Aeson.Object . fromPAO
+
+-- role/group
+
+-- | An optional Activity Streams Collection object listing the
+-- members of a group, or listing the entities assigned to a
+-- particular role.
+rlMembers :: Lens' Object (Maybe [Object])
+rlMembers = makeAesonLensMb "members" oRest
+
+-- Task
+
+-- | An Activity Streams Object that provides information about the
+-- actor that is expected to complete the task.
+tsActor :: Lens' Object (Maybe Object)
+tsActor = makeAesonLensMb "actor" oRest
+
+-- | A RFC 3339 date-time specifying the date and time by which the
+-- task is to be completed.
+tsBy :: Lens' Object (Maybe DateTime)
+tsBy = makeAesonLensMb "by" oRest
+
+-- | An Activity Streams object describing the object of the task.
+tsObject :: Lens' Object (Maybe Object)
+tsObject = makeAesonLensMb "object" oRest
+
+-- | An Array of other Task objects that are to be completed before
+-- this task can be completed.
+tsPrerequisites :: Lens' Object (Maybe [Object])
+tsPrerequisites = makeAesonLensMb "prerequisites" oRest
+
+-- | A boolean value indicating whether completion of this task is
+-- considered to be mandatory.
+tsRequired :: Lens' Object (Maybe Bool)
+tsRequired = makeAesonLensMb "required" oRest
+
+-- | An Array of other Task objects that are superseded by this task object.
+tsSupersedes :: Lens' Object (Maybe [Object])
+tsSupersedes = makeAesonLensMb "supersedes" oRest
+
+-- | A string indicating the verb for this task as defined in Section
+-- 3.2 of [activitystreams].
+tsVerb :: Lens' Object (Maybe SchemaVerb)
+tsVerb = makeAesonLensMb "verb" oRest
+
+-- extra properties
+
+-- | The additional @context@ property allows an 'Activity' to further
+-- include information about why a particular action occurred by
+-- providing details about the context within which a particular
+-- Activity was performed. The value of the @context@ property is an
+-- 'Object' of any @objectType@. The meaning of the @context@ property is
+-- only defined when used within an 'Activity' object.
+acContext :: Lens' Activity (Maybe Object)
+acContext = makeAesonLensMb "context" acRest
+
+-- | When appearing within an activity, the location data indicates
+-- the location where the activity occurred. When appearing within an
+-- object, the location data indicates the location of that object at
+-- the time the activity occurred.
+getLocation :: Lens' a Aeson.Object -> Lens' a (Maybe Object)
+getLocation = makeAesonLensMb "location"
+
+-- | Mood describes the mood of the user when the activity was
+-- performed. This is usually collected via an extra field in the user
+-- interface used to perform the activity. For the purpose of the
+-- schema, a mood is a freeform, short mood keyword or phrase along
+-- with an optional mood icon image.
+oMood :: Lens' Object (Maybe Mood)
+oMood = makeAesonLensMb "mood" oRest
+
+-- | A rating given as a number between 1.0 and 5.0 inclusive with one
+-- decimal place of precision. Represented in JSON as a property
+-- called @rating@ whose value is a JSON number giving the rating.
+oRating :: Lens' Object (Maybe Double)
+oRating = makeAesonLensMb "rating" oRest
+
+-- | The @result@ provides a description of the result of any particular
+-- activity. The value of the @result@ property is an Object of any
+-- objectType. The meaning of the @result@ property is only defined when
+-- used within an 'Activity' object.
+acResult :: Lens' Activity (Maybe Object)
+acResult = makeAesonLensMb "result" acRest
+
+-- | The @source@ property provides a reference to the original source of
+-- an object or activity. The value of the @source@ property is an
+-- Object of any objectType.
+--
+-- The @source@ property is closely related to
+-- the @generator@ and @provider@ properties but serves the distinct
+-- purpose of identifying where the activity or object was originally
+-- published as opposed to identifying the applications that generated
+-- or published it.
+getSource :: Lens' a Aeson.Object -> Lens' a (Maybe Object)
+getSource = makeAesonLensMb "source"
+
+-- | When an long running Activity occurs over a distinct period of
+-- time, or when an Object represents a long-running process or event,
+-- the @startTime@ propertiy can be used to specify the
+-- date and time at which the activity or object begins.
+-- The values for each are represented as JSON Strings
+-- conforming to the "date-time" production in RFC3339.
+getStartTime :: Lens' a Aeson.Object -> Lens' a (Maybe Text)
+getStartTime = makeAesonLensMb "startTime"
+
+-- | When an long running Activity occurs over a distinct period of
+-- time, or when an Object represents a long-running process or event,
+-- the @endTime@ propertiy can be used to specify the
+-- date and time at which the activity or object concludes.
+-- The values for each are represented as JSON Strings
+-- conforming to the "date-time" production in RFC3339.
+getEndTime :: Lens' a Aeson.Object -> Lens' a (Maybe Text)
+getEndTime = makeAesonLensMb "endTime"
+
+-- | A listing of the objects that have been associated with a
+-- particular object. Represented in JSON using a property named @tags@
+-- whose value is an Array of objects.
+oTags :: Lens' Object (Maybe [Object])
+oTags = makeAesonLensMb "tags" oRest
+
+-- mood
+
+-- | Mood describes the mood of the user when the activity was
+-- performed. This is usually collected via an extra field in the user
+-- interface used to perform the activity. For the purpose of this
+-- schema, a mood is a freeform, short mood keyword or phrase along
+-- with an optional mood icon image.
+newtype Mood = Mood { fromMood :: Aeson.Object } deriving (Eq, Show)
+
+instance FromJSON Mood where
+  parseJSON (Aeson.Object o) = do
+    ensure "Mood" o ["displayname", "image"]
+    return (Mood o)
+  parseJSON _ = fail "Mood not an object"
+
+instance ToJSON Mood where
+  toJSON = Aeson.Object . fromMood
+
+-- | Access to the underlying JSON object of a 'Mood'
+moodRest :: Lens' Mood Aeson.Object
+moodRest = makeLens fromMood (\ o' m -> m { fromMood = o' })
+
+-- | The natural-language, human-readable and plain-text keyword or
+-- phrase describing the mood. HTML markup MUST NOT be included.
+moodDisplayName :: Lens' Mood Text
+moodDisplayName = makeAesonLens "displayName" moodRest
+
+-- | An optional image that provides a visual representation of the mood.
+moodImage :: Lens' Mood MediaLink
+moodImage = makeAesonLens "image" moodRest

+ 24 - 15
activitystreams-aeson.cabal

@@ -1,34 +1,37 @@
-
 name:                activitystreams-aeson
-version:             0.1.0.0
+version:             0.2.0.0
+synopsis:            An interface to the ActivityStreams specification
+description:         An interface to the
+                     <http://activitystrea.ms/ Activity Streams>
+                     specifications, using an @aeson@-based representation
+                     of the underlying ActivityStream structures.
+
+                     An ActivityStream is a representation of social
+                     activities in JSON format, using a standard set of
+                     structures. The specification is very flexible in
+                     allowing most fields to be omitted, while also
+                     allowing arbitrary new fields to be created when
+                     necessary. This library attempts to maximize
+                     type safety while retaining the flexibility present
+                     in the specification.
 license:             BSD3
 license-file:        LICENSE
 author:              Getty Ritter
 maintainer:          gettylefou@gmail.com
+copyright:           (c) 2014 Getty Ritter
 category:            Codec
 build-type:          Simple
 cabal-version:       >=1.10
 
 library
-  exposed-modules:     Codec.ActivityStream.Dynamic,
-                       Codec.ActivityStream.DynamicSchema,
-                       Codec.ActivityStream.Representation,
-                       Codec.ActivityStream.Schema,
-                       Codec.ActivityStream
+  exposed-modules:     Codec.ActivityStream
+                       Codec.ActivityStream.Schema
   other-modules:       Codec.ActivityStream.Internal,
+                       Codec.ActivityStream.Representation,
                        Codec.ActivityStream.LensInternal
-  build-depends:       base >=4.7 && <4.8,
-                       aeson,
-                       text,
-                       url,
-                       lens,
-                       datetime,
-                       unordered-containers,
-                       network-uri
+  build-depends:       base                 >=4.7 && <4.8,
+                       aeson                ==0.8.*,
+                       text                 >=1.1,
+                       datetime             ==0.2.*,
+                       unordered-containers >=0.2.5
   default-language:    Haskell2010