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 |
}
|