gdritter repos activitystreams-aeson / 947fc03
Swapped Text for URI and removed the Maybe around arrays Getty Ritter 10 years ago
3 changed file(s) with 49 addition(s) and 21 deletion(s). Collapse all Expand all
1 {-# LANGUAGE ViewPatterns #-}
2
13 module Codec.ActivityStream.Internal (commonOpts, commonOptsCC) where
24
5 import Control.Monad (mzero)
6 import Data.Aeson
37 import Data.Aeson.TH
48 import Data.Char
9 import Data.Text (pack, unpack)
10 import Network.URI (URI, parseURI)
11
12 instance FromJSON URI where
13 parseJSON (String ((parseURI . unpack) -> Just u)) = return u
14 parseJSON _ = mzero
15
16 instance ToJSON URI where
17 toJSON = String . pack . show
518
619 toCamelCaseUpper :: String -> String
720 toCamelCaseUpper = toCamelCase True
2020 import qualified Data.HashMap.Strict as HM
2121 import Data.Maybe (catMaybes)
2222 import Data.Text (Text)
23 import Network.URI
2324
2425 import Codec.ActivityStream.Internal
2526
4748 deriveJSON (commonOpts "_ml") ''MediaLink
4849
4950 data Object objType = Object
50 { _oAttachments :: Maybe [Object objType]
51 { _oAttachments :: [Object objType]
5152 , _oAuthor :: Maybe (Object objType)
5253 , _oContent :: Maybe Text
5354 , _oDisplayName :: Maybe Text
54 , _oDownstreamDuplicates :: Maybe [Text]
55 , _oId :: Maybe Text
55 , _oDownstreamDuplicates :: [URI]
56 , _oId :: Maybe URI
5657 , _oImage :: Maybe MediaLink
5758 , _oObjectType :: Maybe objType
5859 , _oPublished :: Maybe DateTime
5960 , _oSummary :: Maybe Text
6061 , _oUpdated :: Maybe DateTime
61 , _oUpstreamDuplicates :: Maybe [Text]
62 , _oURL :: Maybe Text
62 , _oUpstreamDuplicates :: [URI]
63 , _oURL :: Maybe URI
6364 , _oRest :: [(Text, Value)]
6465 } deriving (Eq, Show)
6566
8485
8586 instance FromJSON objType => FromJSON (Object objType) where
8687 parseJSON (Ae.Object o) =
87 Object <$> o .:? "attachments"
88 Object <$> fmap go (o .:? "attachments")
8889 <*> o .:? "author"
8990 <*> o .:? "content"
9091 <*> o .:? "displayName"
91 <*> o .:? "downstreamDuplicates"
92 <*> fmap go (o .:? "downstreamDuplicates")
9293 <*> o .:? "id"
9394 <*> o .:? "image"
9495 <*> o .:? "objectType"
9596 <*> o .:? "published"
9697 <*> o .:? "summary"
9798 <*> o .:? "updated"
98 <*> o .:? "upstreamDuplicates"
99 <*> fmap go (o .:? "upstreamDuplicates")
99100 <*> o .:? "url"
100101 <*> pure rest
101102 where rest = HM.toList (foldr HM.delete o objectFields)
103 go :: Maybe [a] -> [a]
104 go Nothing = []
105 go (Just xs) = xs
102106
103107 instance ToJSON objType => ToJSON (Object objType) where
104108 toJSON obj = object (attrs ++ _oRest obj)
105109 where attrs = catMaybes
106 [ "attachments" .=? _oAttachments obj
110 [ "attachments" .=! _oAttachments obj
107111 , "author" .=? _oAuthor obj
108112 , "content" .=? _oContent obj
109113 , "displayName" .=? _oDisplayName obj
110 , "downstreamDuplicates" .=? _oDownstreamDuplicates obj
114 , "downstreamDuplicates" .=! _oDownstreamDuplicates obj
111115 , "id" .=? _oId obj
112116 , "image" .=? _oImage obj
113117 , "objectType" .=? _oObjectType obj
114118 , "published" .=? _oPublished obj
115119 , "summary" .=? _oSummary obj
116120 , "updated" .=? _oUpdated obj
117 , "upstreamDuplicates" .=? _oUpstreamDuplicates obj
121 , "upstreamDuplicates" .=! _oUpstreamDuplicates obj
118122 , "url" .=? _oURL obj
119123 ]
120124 (.=?) :: ToJSON a => Text -> Maybe a -> Maybe (Text, Value)
121125 x .=? Just y = Just (x, toJSON y)
122126 _ .=? Nothing = Nothing
123127 infix 1 .=?
128 (.=!) :: ToJSON a => Text -> [a] -> Maybe (Text, Value)
129 _ .=! [] = Nothing
130 x .=! ys = Just (x, toJSON ys)
131 infix 1 .=!
124132
125133 emptyObject :: Object objType
126134 emptyObject = Object
127 { _oAttachments = Nothing
135 { _oAttachments = []
128136 , _oAuthor = Nothing
129137 , _oContent = Nothing
130138 , _oDisplayName = Nothing
131 , _oDownstreamDuplicates = Nothing
139 , _oDownstreamDuplicates = []
132140 , _oId = Nothing
133141 , _oImage = Nothing
134142 , _oObjectType = Nothing
135143 , _oPublished = Nothing
136144 , _oSummary = Nothing
137145 , _oUpdated = Nothing
138 , _oUpstreamDuplicates = Nothing
146 , _oUpstreamDuplicates = []
139147 , _oURL = Nothing
140148 , _oRest = []
141149 }
145153 , _acContent :: Maybe Text
146154 , _acGenerator :: Maybe (Object objType)
147155 , _acIcon :: Maybe MediaLink
148 , _acId :: Maybe Text
156 , _acId :: Maybe URI
149157 , _acPublished :: DateTime
150158 , _acProvider :: Object objType
151159 , _acTarget :: Maybe (Object objType)
152160 , _acTitle :: Maybe Text
153161 , _acUpdated :: Maybe DateTime
154 , _acURL :: Maybe Text
162 , _acURL :: Maybe URI
155163 , _acVerb :: Maybe verb
156164 } deriving (Eq, Show)
157165
177185
178186 data Collection objType = Collection
179187 { _cTotalItems :: Maybe Int
180 , _cItems :: Maybe [Object objType]
181 , _cURL :: Maybe Text
188 , _cItems :: [Object objType]
189 , _cURL :: Maybe URI
182190 } deriving (Eq, Show)
183191
184192 makeLenses ''Collection
185193 deriveJSON (commonOpts "_c") ''Collection
186194
187 makeCollection :: Maybe [Object objType] -> Maybe Text -> Collection objType
195 makeCollection :: [Object objType] -> Maybe URI -> Collection objType
188196 makeCollection objs url = Collection
189 { _cTotalItems = fmap length objs
197 { _cTotalItems = Just (length objs)
190198 , _cItems = objs
191199 , _cURL = url
192200 }
2020 Codec.ActivityStream.Schema,
2121 Codec.ActivityStream
2222 other-modules: Codec.ActivityStream.Internal
23 build-depends: base >=4.7 && <4.8, aeson, text, url, lens, datetime, unordered-containers
23 build-depends: base >=4.7 && <4.8,
24 aeson,
25 text,
26 url,
27 lens,
28 datetime,
29 unordered-containers,
30 network-uri
2431 default-language: Haskell2010