@@ -1,9 +1,11 @@
11{-# LANGUAGE BangPatterns #-}
22{-# LANGUAGE DataKinds #-}
33{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE FunctionalDependencies #-}
45{-# LANGUAGE GADTs #-}
56{-# LANGUAGE GeneralizedNewtypeDeriving #-}
67{-# LANGUAGE KindSignatures #-}
8+{-# LANGUAGE MultiParamTypeClasses #-}
79{-# LANGUAGE OverloadedStrings #-}
810{-# LANGUAGE PatternSynonyms #-}
911{-# LANGUAGE RankNTypes #-}
@@ -13,7 +15,7 @@
1315{-# LANGUAGE ViewPatterns #-}
1416
1517-- Module : Network.PagerDuty.Internal.Types
16−-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
18+-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
1719-- License : This Source Code Form is subject to the terms of
1820-- the Mozilla Public License, v. 2.0.
1921-- A copy of the MPL can be found in the LICENSE file or
@@ -25,35 +27,33 @@
2527module Network.PagerDuty.Internal.Types where
2628
2729import Control.Applicative
28−import Control.Lens hiding ((.=))
30+import Control.Lens hiding ((.=), Empty)
2931import Control.Monad.IO.Class
30−import Data.Aeson hiding (Error)
32+import Data.Aeson hiding (Error, Key)
33+import qualified Data.Aeson.KeyMap as Map
3134import Data.Aeson.Types (Parser)
3235import Data.ByteString (ByteString)
3336import qualified Data.ByteString.Char8 as BS
3437import Data.ByteString.Conversion hiding (List)
3538import Data.Default.Class
3639import Data.Function (on)
37−import qualified Data.HashMap.Strict as Map
3840import Data.List (deleteBy, intersperse)
3941import Data.Monoid
4042import Data.String
4143import Data.Text (Text)
4244import qualified Data.Text as Text
4345import qualified Data.Text.Encoding as Text
44−import Data.Time
46+import Data.Time (UTCTime, TimeZone, formatTime, utc, timeZoneName)
4547import GHC.TypeLits
4648import Network.HTTP.Client (Manager)
4749import Network.HTTP.Types
4850import Network.HTTP.Types.QueryLike
4951import Network.PagerDuty.Internal.Query
5052import Network.PagerDuty.Internal.TH
51−import System.Locale
52−
53−-- FIXME: Verify IncidentId/IncidentKey .. *Id/*Key are actually different or needed
53+import Data.Time.Locale.Compat
5454
5555newtype CSV a = CSV [a]
56− deriving (Eq, Show, Monoid)
56+ deriving (Eq, Show, Semigroup, Monoid)
5757
5858makePrisms ''CSV
5959
@@ -70,7 +70,7 @@ instance ToByteString a => ToJSON (CSV a) where
7070 toJSON = String . Text.decodeUtf8 . toByteString'
7171
7272newtype List a = L [a]
73− deriving (Eq, Show, Monoid)
73+ deriving (Eq, Show, Semigroup, Monoid)
7474
7575deriveJSON ''List
7676makePrisms ''List
@@ -106,7 +106,7 @@ instance ToJSON Date where
106106
107107instance ToByteString Date where
108108 builder (D d) = builder
109− (formatTime defaultTimeLocale (iso8601DateFormat $ Just "%XZ") d)
109+ (formatTime defaultTimeLocale ("%Y-%m-%dT%XZ") d)
110110
111111instance QueryValues Date
112112
@@ -133,14 +133,17 @@ data Security = Basic | Token
133133 deriving (Eq, Show)
134134
135135data Auth (a :: Security) where
136− AuthBasic :: ByteString -> ByteString -> Auth Basic
137− AuthToken :: ByteString -> Auth Token
136+ AuthBasic :: ByteString -> ByteString -> Auth 'Basic
137+ AuthToken :: ByteString -> Auth 'Token
138138
139139deriving instance Eq (Auth a)
140140deriving instance Show (Auth a)
141141
142142newtype SubDomain = SubDomain { subDomain :: ByteString }
143− deriving (Eq, Show, IsString)
143+ deriving (Eq, Show, IsString, ToByteString)
144+
145+mkSubDomain :: ByteString -> SubDomain
146+mkSubDomain = SubDomain
144147
145148domain :: SubDomain -> ByteString
146149domain (SubDomain s)
@@ -177,7 +180,7 @@ prod :: SubDomain -> Auth s -> Manager -> Env s
177180prod d a m = Env d a m None
178181
179182newtype Code = Code Integer
180− deriving (Eq, Show)
183+ deriving (Eq, Show, Num)
181184
182185deriveJSON ''Code
183186
@@ -199,6 +202,15 @@ description (Code c) =
199202 2012 -> "Your account is expired and cannot use the API"
200203 _ -> "Unrecognised error code"
201204
205+class HasMessage s a | s -> a where
206+ -- | A short human-readable message describing the error.
207+ message :: Lens' s a
208+
209+class HasErrors s a | s -> a where
210+ -- | A list of human-readable reasons for the error. These values,
211+ -- and even their format, are subject to change.
212+ errors :: Lens' s a
213+
202214data IntegrationError = IntegrationError
203215 { _ieStatus :: Text
204216 , _ieMessage :: Text
@@ -207,26 +219,53 @@ data IntegrationError = IntegrationError
207219
208220deriveRecord ''IntegrationError
209221
210−data RestError = RestError
222+instance HasMessage IntegrationError Text where message = ieMessage
223+instance HasErrors IntegrationError [Text] where errors = ieErrors
224+
225+status :: Lens' IntegrationError Text
226+status = ieStatus
227+
228+data RESTError = RESTError
211229 { _reCode :: Code
212230 , _reMessage :: Text
213231 , _reErrors :: [Text]
214232 } deriving (Eq, Show)
215233
216−deriveRecord ''RestError
234+deriveRecord ''RESTError
235+
236+instance HasMessage RESTError Text where message = reMessage
237+instance HasErrors RESTError [Text] where errors = reErrors
238+
239+-- | In the case of an error, the PagerDuty error code can give further details
240+-- on the nature of the error.
241+--
242+-- /See:/ 'description'
243+code :: Lens' RESTError Code
244+code = reCode
217245
218246data Error
219− = Internal String
247+ = Internal Text
220248 | Integration IntegrationError
221− | Rest RestError
249+ | REST RESTError
222250 deriving (Eq, Show)
223251
224252instance FromJSON Error where
225− parseJSON o = (Rest <$> parseJSON o)
253+ parseJSON o = (REST <$> parseJSON o)
226254 <|> (Integration <$> parseJSON o)
227255
228256makePrisms ''Error
229257
258+instance HasMessage Error Text where
259+ message = lens f g
260+ where
261+ f (Internal x) = x
262+ f (Integration s) = _ieMessage s
263+ f (REST s) = _reMessage s
264+
265+ g (Internal _) x = Internal x
266+ g (Integration s) x = Integration $ s { _ieMessage = x }
267+ g (REST s) x = REST $ s { _reMessage = x }
268+
230269data Pager = Pager
231270 { _pgOffset :: !Int
232271 -- ^ The offset used in the execution of the query.
@@ -240,8 +279,13 @@ data Pager = Pager
240279
241280makeLenses ''Pager
242281
243−instance FromJSON a => FromJSON (a, Maybe Pager) where
244− parseJSON = withObject "paginated" $ \o -> (,)
282+data Page a = Page
283+ { _pgItem :: a
284+ , _pgPager :: Maybe Pager
285+ }
286+
287+instance FromJSON a => FromJSON (Page a) where
288+ parseJSON = withObject "paginated" $ \o -> Page
245289 <$> parseJSON (Object o)
246290 <*> optional (parse o)
247291 where
@@ -266,11 +310,13 @@ data Path where
266310 Path :: Path
267311 Seg :: ToByteString a => a -> Path
268312
313+instance Semigroup Path where
314+ x <> Path = x
315+ Path <> y = y
316+ Seg x <> Seg y = Seg (builder x <> "/" <> builder y)
317+
269318instance Monoid Path where
270− mempty = Path
271− mappend x Path = x
272− mappend Path y = y
273− mappend (Seg x) (Seg y) = Seg (builder x <> "/" <> builder y)
319+ mempty = Path
274320
275321instance IsString Path where
276322 fromString = Seg
@@ -347,13 +393,13 @@ class Paginate a where
347393 next :: Request a s b -> Maybe Pager -> Maybe (Request a s b)
348394 next rq = maybe Nothing go
349395 where
350− go x | x^.pgTotal == 0 = Nothing
351− | otherwise = Just $
352− rq & pager ?~ (x & pgOffset +~ x^.pgTotal)
396+ go x | x ^. pgTotal == 0 = Nothing
397+ | otherwise = Just $
398+ rq & pager ?~ (x & pgOffset +~ x ^. pgTotal)
353399 & query %~ (add . clear)
354400 where
355401 add :: Query -> Query
356− add = maybe id ((:) . (k,) . Just . Text.encodeUtf8) (x^.pgQuery)
402+ add = maybe id ((:) . (k,) . Just . Text.encodeUtf8) (x ^. pgQuery)
357403
358404 clear :: Query -> Query
359405 clear = deleteBy ((==) `on` fst) (k, Nothing)
@@ -364,6 +410,9 @@ class Paginate a where
364410newtype Key (a :: Symbol) = Key Text
365411 deriving (Eq, Show, IsString)
366412
413+mkKey :: Text -> Key a
414+mkKey = Key
415+
367416instance FromJSON (Key a) where
368417 parseJSON = withText "key" (return . Key)
369418
@@ -384,6 +433,9 @@ type IncidentKey = Key "incident"
384433newtype Id (a :: Symbol) = Id Text
385434 deriving (Eq, Show, IsString)
386435
436+mkId :: Text -> Id a
437+mkId = Id
438+
387439instance FromJSON (Id a) where
388440 parseJSON = withText "id" (return . Id)
389441
@@ -431,7 +483,10 @@ instance QueryLike Empty where
431483 toQuery = const []
432484
433485newtype Address = Address Text
434− deriving (Eq, Show)
486+ deriving (Eq, Show, IsString)
487+
488+mkAddress :: Text -> Address
489+mkAddress = Address
435490
436491deriveJSON ''Address
437492makePrisms ''Address