| 20 | 20 |
import qualified Data.HashMap.Strict as HM
|
| 21 | 21 |
import Data.Maybe (catMaybes)
|
| 22 | 22 |
import Data.Text (Text)
|
| 23 |
import Network.URI
|
| 23 | 24 |
|
| 24 | 25 |
import Codec.ActivityStream.Internal
|
| 25 | 26 |
|
|
| 47 | 48 |
deriveJSON (commonOpts "_ml") ''MediaLink
|
| 48 | 49 |
|
| 49 | 50 |
data Object objType = Object
|
| 50 | |
{ _oAttachments :: Maybe [Object objType]
|
| 51 |
{ _oAttachments :: [Object objType]
|
| 51 | 52 |
, _oAuthor :: Maybe (Object objType)
|
| 52 | 53 |
, _oContent :: Maybe Text
|
| 53 | 54 |
, _oDisplayName :: Maybe Text
|
| 54 | |
, _oDownstreamDuplicates :: Maybe [Text]
|
| 55 | |
, _oId :: Maybe Text
|
| 55 |
, _oDownstreamDuplicates :: [URI]
|
| 56 |
, _oId :: Maybe URI
|
| 56 | 57 |
, _oImage :: Maybe MediaLink
|
| 57 | 58 |
, _oObjectType :: Maybe objType
|
| 58 | 59 |
, _oPublished :: Maybe DateTime
|
| 59 | 60 |
, _oSummary :: Maybe Text
|
| 60 | 61 |
, _oUpdated :: Maybe DateTime
|
| 61 | |
, _oUpstreamDuplicates :: Maybe [Text]
|
| 62 | |
, _oURL :: Maybe Text
|
| 62 |
, _oUpstreamDuplicates :: [URI]
|
| 63 |
, _oURL :: Maybe URI
|
| 63 | 64 |
, _oRest :: [(Text, Value)]
|
| 64 | 65 |
} deriving (Eq, Show)
|
| 65 | 66 |
|
|
| 84 | 85 |
|
| 85 | 86 |
instance FromJSON objType => FromJSON (Object objType) where
|
| 86 | 87 |
parseJSON (Ae.Object o) =
|
| 87 | |
Object <$> o .:? "attachments"
|
| 88 |
Object <$> fmap go (o .:? "attachments")
|
| 88 | 89 |
<*> o .:? "author"
|
| 89 | 90 |
<*> o .:? "content"
|
| 90 | 91 |
<*> o .:? "displayName"
|
| 91 | |
<*> o .:? "downstreamDuplicates"
|
| 92 |
<*> fmap go (o .:? "downstreamDuplicates")
|
| 92 | 93 |
<*> o .:? "id"
|
| 93 | 94 |
<*> o .:? "image"
|
| 94 | 95 |
<*> o .:? "objectType"
|
| 95 | 96 |
<*> o .:? "published"
|
| 96 | 97 |
<*> o .:? "summary"
|
| 97 | 98 |
<*> o .:? "updated"
|
| 98 | |
<*> o .:? "upstreamDuplicates"
|
| 99 |
<*> fmap go (o .:? "upstreamDuplicates")
|
| 99 | 100 |
<*> o .:? "url"
|
| 100 | 101 |
<*> pure rest
|
| 101 | 102 |
where rest = HM.toList (foldr HM.delete o objectFields)
|
| 103 |
go :: Maybe [a] -> [a]
|
| 104 |
go Nothing = []
|
| 105 |
go (Just xs) = xs
|
| 102 | 106 |
|
| 103 | 107 |
instance ToJSON objType => ToJSON (Object objType) where
|
| 104 | 108 |
toJSON obj = object (attrs ++ _oRest obj)
|
| 105 | 109 |
where attrs = catMaybes
|
| 106 | |
[ "attachments" .=? _oAttachments obj
|
| 110 |
[ "attachments" .=! _oAttachments obj
|
| 107 | 111 |
, "author" .=? _oAuthor obj
|
| 108 | 112 |
, "content" .=? _oContent obj
|
| 109 | 113 |
, "displayName" .=? _oDisplayName obj
|
| 110 | |
, "downstreamDuplicates" .=? _oDownstreamDuplicates obj
|
| 114 |
, "downstreamDuplicates" .=! _oDownstreamDuplicates obj
|
| 111 | 115 |
, "id" .=? _oId obj
|
| 112 | 116 |
, "image" .=? _oImage obj
|
| 113 | 117 |
, "objectType" .=? _oObjectType obj
|
| 114 | 118 |
, "published" .=? _oPublished obj
|
| 115 | 119 |
, "summary" .=? _oSummary obj
|
| 116 | 120 |
, "updated" .=? _oUpdated obj
|
| 117 | |
, "upstreamDuplicates" .=? _oUpstreamDuplicates obj
|
| 121 |
, "upstreamDuplicates" .=! _oUpstreamDuplicates obj
|
| 118 | 122 |
, "url" .=? _oURL obj
|
| 119 | 123 |
]
|
| 120 | 124 |
(.=?) :: ToJSON a => Text -> Maybe a -> Maybe (Text, Value)
|
| 121 | 125 |
x .=? Just y = Just (x, toJSON y)
|
| 122 | 126 |
_ .=? Nothing = Nothing
|
| 123 | 127 |
infix 1 .=?
|
| 128 |
(.=!) :: ToJSON a => Text -> [a] -> Maybe (Text, Value)
|
| 129 |
_ .=! [] = Nothing
|
| 130 |
x .=! ys = Just (x, toJSON ys)
|
| 131 |
infix 1 .=!
|
| 124 | 132 |
|
| 125 | 133 |
emptyObject :: Object objType
|
| 126 | 134 |
emptyObject = Object
|
| 127 | |
{ _oAttachments = Nothing
|
| 135 |
{ _oAttachments = []
|
| 128 | 136 |
, _oAuthor = Nothing
|
| 129 | 137 |
, _oContent = Nothing
|
| 130 | 138 |
, _oDisplayName = Nothing
|
| 131 | |
, _oDownstreamDuplicates = Nothing
|
| 139 |
, _oDownstreamDuplicates = []
|
| 132 | 140 |
, _oId = Nothing
|
| 133 | 141 |
, _oImage = Nothing
|
| 134 | 142 |
, _oObjectType = Nothing
|
| 135 | 143 |
, _oPublished = Nothing
|
| 136 | 144 |
, _oSummary = Nothing
|
| 137 | 145 |
, _oUpdated = Nothing
|
| 138 | |
, _oUpstreamDuplicates = Nothing
|
| 146 |
, _oUpstreamDuplicates = []
|
| 139 | 147 |
, _oURL = Nothing
|
| 140 | 148 |
, _oRest = []
|
| 141 | 149 |
}
|
|
| 145 | 153 |
, _acContent :: Maybe Text
|
| 146 | 154 |
, _acGenerator :: Maybe (Object objType)
|
| 147 | 155 |
, _acIcon :: Maybe MediaLink
|
| 148 | |
, _acId :: Maybe Text
|
| 156 |
, _acId :: Maybe URI
|
| 149 | 157 |
, _acPublished :: DateTime
|
| 150 | 158 |
, _acProvider :: Object objType
|
| 151 | 159 |
, _acTarget :: Maybe (Object objType)
|
| 152 | 160 |
, _acTitle :: Maybe Text
|
| 153 | 161 |
, _acUpdated :: Maybe DateTime
|
| 154 | |
, _acURL :: Maybe Text
|
| 162 |
, _acURL :: Maybe URI
|
| 155 | 163 |
, _acVerb :: Maybe verb
|
| 156 | 164 |
} deriving (Eq, Show)
|
| 157 | 165 |
|
|
| 177 | 185 |
|
| 178 | 186 |
data Collection objType = Collection
|
| 179 | 187 |
{ _cTotalItems :: Maybe Int
|
| 180 | |
, _cItems :: Maybe [Object objType]
|
| 181 | |
, _cURL :: Maybe Text
|
| 188 |
, _cItems :: [Object objType]
|
| 189 |
, _cURL :: Maybe URI
|
| 182 | 190 |
} deriving (Eq, Show)
|
| 183 | 191 |
|
| 184 | 192 |
makeLenses ''Collection
|
| 185 | 193 |
deriveJSON (commonOpts "_c") ''Collection
|
| 186 | 194 |
|
| 187 | |
makeCollection :: Maybe [Object objType] -> Maybe Text -> Collection objType
|
| 195 |
makeCollection :: [Object objType] -> Maybe URI -> Collection objType
|
| 188 | 196 |
makeCollection objs url = Collection
|
| 189 | |
{ _cTotalItems = fmap length objs
|
| 197 |
{ _cTotalItems = Just (length objs)
|
| 190 | 198 |
, _cItems = objs
|
| 191 | 199 |
, _cURL = url
|
| 192 | 200 |
}
|