@@ -15,7 +15,7 @@
1515{-# LANGUAGE ViewPatterns #-}
1616
1717-- Module : Network.PagerDuty.Internal.Types
18−-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
18+-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
1919-- License : This Source Code Form is subject to the terms of
2020-- the Mozilla Public License, v. 2.0.
2121-- A copy of the MPL can be found in the LICENSE file or
@@ -27,35 +27,33 @@
2727module Network.PagerDuty.Internal.Types where
2828
2929import Control.Applicative
30−import Control.Lens hiding ((.=))
30+import Control.Lens hiding ((.=), Empty)
3131import Control.Monad.IO.Class
32−import Data.Aeson hiding (Error)
32+import Data.Aeson hiding (Error, Key)
33+import qualified Data.Aeson.KeyMap as Map
3334import Data.Aeson.Types (Parser)
3435import Data.ByteString (ByteString)
3536import qualified Data.ByteString.Char8 as BS
3637import Data.ByteString.Conversion hiding (List)
3738import Data.Default.Class
3839import Data.Function (on)
39−import qualified Data.HashMap.Strict as Map
4040import Data.List (deleteBy, intersperse)
4141import Data.Monoid
4242import Data.String
4343import Data.Text (Text)
4444import qualified Data.Text as Text
4545import qualified Data.Text.Encoding as Text
46−import Data.Time
46+import Data.Time (UTCTime, TimeZone, formatTime, utc, timeZoneName)
4747import GHC.TypeLits
4848import Network.HTTP.Client (Manager)
4949import Network.HTTP.Types
5050import Network.HTTP.Types.QueryLike
5151import Network.PagerDuty.Internal.Query
5252import Network.PagerDuty.Internal.TH
53−import System.Locale
54−
55−-- FIXME: Verify IncidentId/IncidentKey .. *Id/*Key are actually different or needed
53+import Data.Time.Locale.Compat
5654
5755newtype CSV a = CSV [a]
58− deriving (Eq, Show, Monoid)
56+ deriving (Eq, Show, Semigroup, Monoid)
5957
6058makePrisms ''CSV
6159
@@ -72,7 +70,7 @@ instance ToByteString a => ToJSON (CSV a) where
7270 toJSON = String . Text.decodeUtf8 . toByteString'
7371
7472newtype List a = L [a]
75− deriving (Eq, Show, Monoid)
73+ deriving (Eq, Show, Semigroup, Monoid)
7674
7775deriveJSON ''List
7876makePrisms ''List
@@ -108,7 +106,7 @@ instance ToJSON Date where
108106
109107instance ToByteString Date where
110108 builder (D d) = builder
111− (formatTime defaultTimeLocale (iso8601DateFormat $ Just "%XZ") d)
109+ (formatTime defaultTimeLocale ("%Y-%m-%dT%XZ") d)
112110
113111instance QueryValues Date
114112
@@ -135,14 +133,17 @@ data Security = Basic | Token
135133 deriving (Eq, Show)
136134
137135data Auth (a :: Security) where
138− AuthBasic :: ByteString -> ByteString -> Auth Basic
139− AuthToken :: ByteString -> Auth Token
136+ AuthBasic :: ByteString -> ByteString -> Auth 'Basic
137+ AuthToken :: ByteString -> Auth 'Token
140138
141139deriving instance Eq (Auth a)
142140deriving instance Show (Auth a)
143141
144142newtype SubDomain = SubDomain { subDomain :: ByteString }
145− deriving (Eq, Show, IsString)
143+ deriving (Eq, Show, IsString, ToByteString)
144+
145+mkSubDomain :: ByteString -> SubDomain
146+mkSubDomain = SubDomain
146147
147148domain :: SubDomain -> ByteString
148149domain (SubDomain s)
@@ -179,7 +180,7 @@ prod :: SubDomain -> Auth s -> Manager -> Env s
179180prod d a m = Env d a m None
180181
181182newtype Code = Code Integer
182− deriving (Eq, Show)
183+ deriving (Eq, Show, Num)
183184
184185deriveJSON ''Code
185186
@@ -278,8 +279,13 @@ data Pager = Pager
278279
279280makeLenses ''Pager
280281
281−instance FromJSON a => FromJSON (a, Maybe Pager) where
282− 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
283289 <$> parseJSON (Object o)
284290 <*> optional (parse o)
285291 where
@@ -304,11 +310,13 @@ data Path where
304310 Path :: Path
305311 Seg :: ToByteString a => a -> Path
306312
313+instance Semigroup Path where
314+ x <> Path = x
315+ Path <> y = y
316+ Seg x <> Seg y = Seg (builder x <> "/" <> builder y)
317+
307318instance Monoid Path where
308− mempty = Path
309− mappend x Path = x
310− mappend Path y = y
311− mappend (Seg x) (Seg y) = Seg (builder x <> "/" <> builder y)
319+ mempty = Path
312320
313321instance IsString Path where
314322 fromString = Seg
@@ -385,13 +393,13 @@ class Paginate a where
385393 next :: Request a s b -> Maybe Pager -> Maybe (Request a s b)
386394 next rq = maybe Nothing go
387395 where
388− go x | x^.pgTotal == 0 = Nothing
389− | otherwise = Just $
390− rq & pager ?~ (x & pgOffset +~ x^.pgTotal)
396+ go x | x ^. pgTotal == 0 = Nothing
397+ | otherwise = Just $
398+ rq & pager ?~ (x & pgOffset +~ x ^. pgTotal)
391399 & query %~ (add . clear)
392400 where
393401 add :: Query -> Query
394− add = maybe id ((:) . (k,) . Just . Text.encodeUtf8) (x^.pgQuery)
402+ add = maybe id ((:) . (k,) . Just . Text.encodeUtf8) (x ^. pgQuery)
395403
396404 clear :: Query -> Query
397405 clear = deleteBy ((==) `on` fst) (k, Nothing)
@@ -402,6 +410,9 @@ class Paginate a where
402410newtype Key (a :: Symbol) = Key Text
403411 deriving (Eq, Show, IsString)
404412
413+mkKey :: Text -> Key a
414+mkKey = Key
415+
405416instance FromJSON (Key a) where
406417 parseJSON = withText "key" (return . Key)
407418
@@ -422,6 +433,9 @@ type IncidentKey = Key "incident"
422433newtype Id (a :: Symbol) = Id Text
423434 deriving (Eq, Show, IsString)
424435
436+mkId :: Text -> Id a
437+mkId = Id
438+
425439instance FromJSON (Id a) where
426440 parseJSON = withText "id" (return . Id)
427441
@@ -469,7 +483,10 @@ instance QueryLike Empty where
469483 toQuery = const []
470484
471485newtype Address = Address Text
472− deriving (Eq, Show)
486+ deriving (Eq, Show, IsString)
487+
488+mkAddress :: Text -> Address
489+mkAddress = Address
473490
474491deriveJSON ''Address
475492makePrisms ''Address