Dynamic.hs 7.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262
  1. {-# LANGUAGE OverloadedStrings #-}
  2. {-|
  3. Module : Codec.ActivityStream.Dynamic
  4. Description : A (more dynamic) interface to Activity Streams
  5. Copyright : (c) Getty Ritter, 2014
  6. Maintainer : gdritter@galois.com
  7. This is an interface to ActivityStreams that simply wraps an underlying
  8. @aeson@ Object, and exposes a set of (convenient) lenses to access the
  9. values inside. If an @aeson@ object is wrapped in the respective wrapper,
  10. it will contain the obligatory values for that type (e.g. an @Activity@
  11. is guaranteed to have a @published@ date.)
  12. -}
  13. module Codec.ActivityStream.Dynamic
  14. ( Lens'
  15. -- * MediaLink
  16. , MediaLink
  17. , mlDuration
  18. , mlHeight
  19. , mlWidth
  20. , mlURL
  21. , mlRest
  22. , makeMediaLink
  23. -- * Object
  24. , Object
  25. , oAttachments
  26. , oAuthor
  27. , oContent
  28. , oDisplayName
  29. , oDownstreamDuplicates
  30. , oId
  31. , oImage
  32. , oObjectType
  33. , oPublished
  34. , oSummary
  35. , oUpdated
  36. , oUpstreamDuplicates
  37. , oURL
  38. , oRest
  39. , emptyObject
  40. -- * Activity
  41. , Activity
  42. , acActor
  43. , acContent
  44. , acGenerator
  45. , acIcon
  46. , acId
  47. , acPublished
  48. , acProvider
  49. , acTarget
  50. , acTitle
  51. , acUpdated
  52. , acURL
  53. , acVerb
  54. , acRest
  55. , makeActivity
  56. -- * Collection
  57. , Collection
  58. , cTotalItems
  59. , cItems
  60. , cURL
  61. , cRest
  62. , makeCollection
  63. ) where
  64. import Data.Aeson ( FromJSON(..)
  65. , ToJSON(..)
  66. , Result(..)
  67. , fromJSON
  68. )
  69. import qualified Data.Aeson as A
  70. import Data.DateTime (DateTime)
  71. import qualified Data.HashMap.Strict as HM
  72. import Data.Text (Text)
  73. import Codec.ActivityStream.LensInternal ( Lens'
  74. , makeLens
  75. , makeAesonLens
  76. , makeAesonLensMb
  77. )
  78. data MediaLink = MediaLink { fromMediaLink :: A.Object } deriving (Eq, Show)
  79. instance FromJSON MediaLink where
  80. parseJSON (A.Object o) | HM.member "url" o = return (MediaLink o)
  81. | otherwise = fail "..."
  82. parseJSON _ = fail "..."
  83. instance ToJSON MediaLink where
  84. toJSON (MediaLink o) = A.Object o
  85. mlRest :: Lens' MediaLink A.Object
  86. mlRest = makeLens fromMediaLink (\ o' m -> m { fromMediaLink = o' })
  87. mlDuration :: Lens' MediaLink (Maybe Int)
  88. mlDuration = makeAesonLensMb "duration" mlRest
  89. mlHeight :: Lens' MediaLink (Maybe Int)
  90. mlHeight = makeAesonLensMb "height" mlRest
  91. mlWidth :: Lens' MediaLink (Maybe Int)
  92. mlWidth = makeAesonLensMb "width" mlRest
  93. mlURL :: Lens' MediaLink Text
  94. mlURL = makeAesonLens "url" mlRest
  95. -- | Create a @MediaLink@ with just a @url@ property.
  96. makeMediaLink :: Text -> MediaLink
  97. makeMediaLink url = MediaLink (HM.insert "url" (toJSON url) HM.empty)
  98. -- | Object
  99. data Object = Object { fromObject :: A.Object } deriving (Eq, Show)
  100. instance FromJSON Object where
  101. parseJSON (A.Object o) = return (Object o)
  102. parseJSON _ = fail "..."
  103. instance ToJSON Object where
  104. toJSON (Object o) = A.Object o
  105. oRest :: Lens' Object A.Object
  106. oRest = makeLens fromObject (\ o' m -> m { fromObject = o' })
  107. oAttachments :: Lens' Object (Maybe [Object])
  108. oAttachments = makeAesonLensMb "attachments" oRest
  109. oAuthor :: Lens' Object (Maybe Object)
  110. oAuthor = makeAesonLensMb "author" oRest
  111. oContent :: Lens' Object (Maybe Text)
  112. oContent = makeAesonLensMb "content" oRest
  113. oDisplayName :: Lens' Object (Maybe Text)
  114. oDisplayName = makeAesonLensMb "displayName" oRest
  115. oDownstreamDuplicates :: Lens' Object (Maybe [Text])
  116. oDownstreamDuplicates = makeAesonLensMb "downstreamDuplicates" oRest
  117. oId :: Lens' Object (Maybe Text)
  118. oId = makeAesonLensMb "id" oRest
  119. oImage :: Lens' Object (Maybe MediaLink)
  120. oImage = makeAesonLensMb "image" oRest
  121. oObjectType :: (FromJSON o, ToJSON o) => Lens' Object (Maybe o)
  122. oObjectType = makeAesonLensMb "objectType" oRest
  123. oPublished :: Lens' Object (Maybe DateTime)
  124. oPublished = makeAesonLensMb "published" oRest
  125. oSummary :: Lens' Object (Maybe Text)
  126. oSummary = makeAesonLensMb "summary" oRest
  127. oUpdated :: Lens' Object (Maybe DateTime)
  128. oUpdated = makeAesonLensMb "updated" oRest
  129. oUpstreamDuplicates :: Lens' Object (Maybe [Text])
  130. oUpstreamDuplicates = makeAesonLensMb "upstreamDuplicates" oRest
  131. oURL :: Lens' Object (Maybe Text)
  132. oURL = makeAesonLensMb "url" oRest
  133. -- | Create an @Object@ with no fields.
  134. emptyObject :: Object
  135. emptyObject = Object HM.empty
  136. -- | Activity
  137. data Activity = Activity { fromActivity :: A.Object } deriving (Eq, Show)
  138. instance FromJSON Activity where
  139. parseJSON (A.Object o)
  140. | HM.member "published" o && HM.member "provider" o = return (Activity o)
  141. | otherwise = fail "..."
  142. parseJSON _ = fail "..."
  143. instance ToJSON Activity where
  144. toJSON (Activity o) = A.Object o
  145. acRest :: Lens' Activity A.Object
  146. acRest = makeLens fromActivity (\ o' m -> m { fromActivity = o' })
  147. acActor :: Lens' Activity Object
  148. acActor = makeAesonLens "actor" acRest
  149. acContent :: Lens' Activity (Maybe Text)
  150. acContent = makeAesonLensMb "content" acRest
  151. acGenerator :: Lens' Activity (Maybe Object)
  152. acGenerator = makeAesonLens "generator" acRest
  153. acIcon :: Lens' Activity (Maybe MediaLink)
  154. acIcon = makeAesonLensMb "icon" acRest
  155. acId :: Lens' Activity (Maybe Text)
  156. acId = makeAesonLensMb "id" acRest
  157. acPublished :: Lens' Activity DateTime
  158. acPublished = makeAesonLens "published" acRest
  159. acProvider :: Lens' Activity (Maybe Object)
  160. acProvider = makeAesonLensMb "provider" acRest
  161. acTarget :: Lens' Activity (Maybe Object)
  162. acTarget = makeAesonLensMb "target" acRest
  163. acTitle :: Lens' Activity (Maybe Text)
  164. acTitle = makeAesonLensMb "title" acRest
  165. acUpdated :: Lens' Activity (Maybe DateTime)
  166. acUpdated = makeAesonLensMb "updated" acRest
  167. acURL :: Lens' Activity (Maybe Text)
  168. acURL = makeAesonLensMb "url" acRest
  169. acVerb :: (FromJSON v, ToJSON v) => Lens' Activity (Maybe v)
  170. acVerb = makeAesonLensMb "verb" acRest
  171. -- | Create an @Activity@ with an @actor@, @published@, and
  172. -- @provider@ property.
  173. makeActivity :: Object -> DateTime -> Object -> Activity
  174. makeActivity actor published provider = Activity
  175. $ HM.insert "actor" (toJSON actor)
  176. $ HM.insert "published" (toJSON published)
  177. $ HM.insert "provider" (toJSON provider)
  178. $ HM.empty
  179. -- | Collection
  180. data Collection = Collection { fromCollection :: A.Object } deriving (Eq, Show)
  181. instance FromJSON Collection where
  182. parseJSON (A.Object o) = return (Collection o)
  183. parseJSON _ = fail "..."
  184. instance ToJSON Collection where
  185. toJSON (Collection o) = A.Object o
  186. cRest :: Lens' Collection A.Object
  187. cRest = makeLens fromCollection (\ o' m -> m { fromCollection = o' })
  188. cTotalItems :: Lens' Collection (Maybe Int)
  189. cTotalItems = makeAesonLensMb "totalItems" cRest
  190. cItems :: Lens' Collection (Maybe [Object])
  191. cItems = makeAesonLensMb "items" cRest
  192. cURL :: Lens' Collection (Maybe Text)
  193. cURL = makeAesonLensMb "url" cRest
  194. -- | Create a @Collection@ with an @items@ and a @url@ property
  195. -- and fill in the corresponding @totalItems@ field with the
  196. -- length of the @items@ array.
  197. makeCollection :: [Object] -> Text -> Collection
  198. makeCollection objs url = Collection
  199. $ HM.insert "totalItems" (toJSON (length objs))
  200. $ HM.insert "items" (toJSON objs)
  201. $ HM.insert "url" (toJSON url)
  202. $ HM.empty