From 63b9a3e228675470873c56f80b293ed8c41d8c5e Mon Sep 17 00:00:00 2001 From: Andrew McMiddlin Date: Fri, 31 May 2019 12:39:44 +1000 Subject: [PATCH 01/18] Sketch data types for traffic. --- src/GitHub/Data/Traffic.hs | 53 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 src/GitHub/Data/Traffic.hs diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs new file mode 100644 index 00000000..ee05caa2 --- /dev/null +++ b/src/GitHub/Data/Traffic.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE KindSignatures #-} + +-- | Data types used in the traffic API +module GitHub.Data.Traffic where + +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Vector (Vector) + +import GitHub (Name) + +data Referrer = Referrer + { referrer :: !(Name Referrer) + , referrerCount :: !Int + , referrerUniques :: !Int + } + deriving (Eq, Show) + +data Path = Path + { path :: !Text + , pathTitle :: !Text + , pathCount :: !Int + , pathUniques :: !Int + } + deriving (Eq, Show) + +data Period = + Day + | Week + deriving (Eq, Show) + +data Event = + View + | Clone + deriving (Eq, Show) + +data Count (e :: Event) (p :: Period) = Count + { countTimestamp :: !UTCTime + , count :: !Int + , countUniques :: !Int + } + +data Views p = Views + { viewsCount :: !Int + , viewsUniques :: !Int + , viewsPer :: Vector (Count 'View p) + } + +data Clones p = Clones + { clonesCount :: !Int + , clonesUniques :: !Int + , clonesPer :: Vector (Count 'Clone p) + } From 018c8bd2385a9f9bc146938356cd6ba88e67186b Mon Sep 17 00:00:00 2001 From: Andrew McMiddlin Date: Fri, 31 May 2019 13:05:13 +1000 Subject: [PATCH 02/18] Start traffic endpoint. --- src/GitHub/Endpoints/Repos/Traffic.hs | 49 +++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 src/GitHub/Endpoints/Repos/Traffic.hs diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs new file mode 100644 index 00000000..4aaebfd0 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -0,0 +1,49 @@ +-- | The traffic API, as described at +module GitHub.Endpoints.Repos.Traffic () where + +import Data.Vector (Vector) + +import GitHub.Data (Referrer, Name, Repo) + +-- | The top 10 referrers for the past 14 days. +-- +-- > popularReferrers "qfpl" "tasty-hedgehog" +popularReferrers :: Name Owner -> Name Repo -> IO (Either Error (Vector Referrer)) +popularReferrers = + popularReferrers' Nothing + +-- | The top 10 referrers for the past 14 days. +-- | With authentication. +-- +-- > popularReferrers' (Just $ BasicAuth "github-username" "github-password") "qfpl" "tasty-hedgehog" +popularReferrers' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Referrer)) +popularReferrers' auth user repo = + executeRequestMaybe auth $ popularReferrersR user repo + +popularReferrersR :: Name Owner -> Name Repo -> Request k (Vector Referrer) +popularReferrersR user repo = + query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "referrers"] [] + +popularPaths :: Name Owner -> Name Repo -> IO (Either Error (Vector Path)) +popularPaths = + undefined + +popularPaths' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Path)) +popularPaths' = + undefined + +views :: Name Owner -> Name Repo -> Period -> IO (Either Error Views) +views = + undefined + +views' :: Maybe Auth -> Name Owner -> Name Repo -> Period -> IO (Either Error Views) +views' = + undefined + +clones :: Name Owner -> Name Repo -> Period -> IO (Either Error Clones) +clones = + undefined + +clones' :: Maybe Auth -> Name Owner -> Name Repo -> Period -> IO (Either Error Clones) +clones' = + undefined \ No newline at end of file From cb0ba8335665cccba98b1886a655bd5d5fb5c104 Mon Sep 17 00:00:00 2001 From: Andrew McMiddlin Date: Fri, 31 May 2019 13:05:31 +1000 Subject: [PATCH 03/18] Fix name collisions and export Data.Traffic. --- src/GitHub/Data.hs | 2 ++ src/GitHub/Data/Traffic.hs | 16 ++++++++-------- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index e6fbd4a0..9bdb3fdb 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -57,6 +57,7 @@ module GitHub.Data ( module GitHub.Data.Search, module GitHub.Data.Statuses, module GitHub.Data.Teams, + module GitHub.Data.Traffic, module GitHub.Data.URL, module GitHub.Data.Webhooks ) where @@ -90,6 +91,7 @@ import GitHub.Data.Reviews import GitHub.Data.Search import GitHub.Data.Statuses import GitHub.Data.Teams +import GitHub.Data.Traffic import GitHub.Data.URL import GitHub.Data.Webhooks diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs index ee05caa2..9830834e 100644 --- a/src/GitHub/Data/Traffic.hs +++ b/src/GitHub/Data/Traffic.hs @@ -7,7 +7,7 @@ import Data.Text (Text) import Data.Time (UTCTime) import Data.Vector (Vector) -import GitHub (Name) +import GitHub.Data.Name (Name) data Referrer = Referrer { referrer :: !(Name Referrer) @@ -29,25 +29,25 @@ data Period = | Week deriving (Eq, Show) -data Event = +data TrafficEvent = View | Clone deriving (Eq, Show) -data Count (e :: Event) (p :: Period) = Count - { countTimestamp :: !UTCTime - , count :: !Int - , countUniques :: !Int +data TrafficCount (e :: TrafficEvent) (p :: Period) = TrafficCount + { trafficCountTimestamp :: !UTCTime + , trafficCount :: !Int + , trafficCountUniques :: !Int } data Views p = Views { viewsCount :: !Int , viewsUniques :: !Int - , viewsPer :: Vector (Count 'View p) + , viewsPer :: Vector (TrafficCount 'View p) } data Clones p = Clones { clonesCount :: !Int , clonesUniques :: !Int - , clonesPer :: Vector (Count 'Clone p) + , clonesPer :: Vector (TrafficCount 'Clone p) } From 208497006f382c91af05f218310bb8eabd352052 Mon Sep 17 00:00:00 2001 From: Andrew McMiddlin Date: Fri, 31 May 2019 13:05:51 +1000 Subject: [PATCH 04/18] Add Traffic modules to exports in cabal file. --- github.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/github.cabal b/github.cabal index 7b6724f1..e394fa32 100644 --- a/github.cabal +++ b/github.cabal @@ -96,6 +96,7 @@ library GitHub.Data.Search GitHub.Data.Statuses GitHub.Data.Teams + GitHub.Data.Traffic GitHub.Data.URL GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate @@ -131,6 +132,7 @@ library GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Statuses + GitHub.Endpoints.Repos.Traffic GitHub.Endpoints.Repos.Webhooks GitHub.Endpoints.Search GitHub.Endpoints.Users From 5910d123071c7b891e8ef3257ddb981df5bc1586 Mon Sep 17 00:00:00 2001 From: Andrew McMiddlin Date: Fri, 31 May 2019 14:18:37 +1000 Subject: [PATCH 05/18] Get popularReferrers working. --- src/GitHub/Data/Traffic.hs | 11 ++++++++++- src/GitHub/Endpoints/Repos/Traffic.hs | 10 ++++++++-- 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs index 9830834e..72b37660 100644 --- a/src/GitHub/Data/Traffic.hs +++ b/src/GitHub/Data/Traffic.hs @@ -8,13 +8,22 @@ import Data.Time (UTCTime) import Data.Vector (Vector) import GitHub.Data.Name (Name) +import GitHub.Internal.Prelude +import Prelude () data Referrer = Referrer { referrer :: !(Name Referrer) , referrerCount :: !Int , referrerUniques :: !Int } - deriving (Eq, Show) + deriving (Eq, Show, Generic) + +instance FromJSON Referrer where + parseJSON = withObject "Referrer" $ \o -> + Referrer + <$> o .: "referrer" + <*> o .: "count" + <*> o .: "uniques" data Path = Path { path :: !Text diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs index 4aaebfd0..52363d3f 100644 --- a/src/GitHub/Endpoints/Repos/Traffic.hs +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -1,9 +1,15 @@ -- | The traffic API, as described at -module GitHub.Endpoints.Repos.Traffic () where +module GitHub.Endpoints.Repos.Traffic ( + popularReferrers, + popularReferrers', + popularReferrersR + ) where import Data.Vector (Vector) -import GitHub.Data (Referrer, Name, Repo) +import GitHub.Data (Referrer, Name, Repo, Owner, Auth, Error, Clones, Path, Period, Views) +import GitHub.Data.Request (query, toPathPart) +import GitHub.Request (Request, executeRequestMaybe) -- | The top 10 referrers for the past 14 days. -- From 086137d8e295883b120eec35d04884cc49903f85 Mon Sep 17 00:00:00 2001 From: Andrew McMiddlin Date: Fri, 31 May 2019 14:21:06 +1000 Subject: [PATCH 06/18] Get popularPaths working. --- src/GitHub/Data/Traffic.hs | 8 ++++++++ src/GitHub/Endpoints/Repos/Traffic.hs | 19 +++++++++++++------ 2 files changed, 21 insertions(+), 6 deletions(-) diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs index 72b37660..20845488 100644 --- a/src/GitHub/Data/Traffic.hs +++ b/src/GitHub/Data/Traffic.hs @@ -33,6 +33,14 @@ data Path = Path } deriving (Eq, Show) +instance FromJSON Path where + parseJSON = withObject "Path" $ \o -> + Path + <$> o .: "path" + <*> o .: "title" + <*> o .: "count" + <*> o .: "uniques" + data Period = Day | Week diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs index 52363d3f..00512a5f 100644 --- a/src/GitHub/Endpoints/Repos/Traffic.hs +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -2,7 +2,10 @@ module GitHub.Endpoints.Repos.Traffic ( popularReferrers, popularReferrers', - popularReferrersR + popularReferrersR, + popularPaths, + popularPaths', + popularPathsR, ) where import Data.Vector (Vector) @@ -23,8 +26,8 @@ popularReferrers = -- -- > popularReferrers' (Just $ BasicAuth "github-username" "github-password") "qfpl" "tasty-hedgehog" popularReferrers' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Referrer)) -popularReferrers' auth user repo = - executeRequestMaybe auth $ popularReferrersR user repo +popularReferrers' auth user = + executeRequestMaybe auth . popularReferrersR user popularReferrersR :: Name Owner -> Name Repo -> Request k (Vector Referrer) popularReferrersR user repo = @@ -32,11 +35,15 @@ popularReferrersR user repo = popularPaths :: Name Owner -> Name Repo -> IO (Either Error (Vector Path)) popularPaths = - undefined + popularPaths' Nothing popularPaths' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Path)) -popularPaths' = - undefined +popularPaths' auth user = + executeRequestMaybe auth . popularPathsR user + +popularPathsR :: Name Owner -> Name Repo -> Request k (Vector Path) +popularPathsR user repo = + query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "paths"] [] views :: Name Owner -> Name Repo -> Period -> IO (Either Error Views) views = From 3660d6ee32604981aa91d19b0a907050fc8a7290 Mon Sep 17 00:00:00 2001 From: Andrew McMiddlin Date: Fri, 31 May 2019 15:31:42 +1000 Subject: [PATCH 07/18] Get clones working. --- src/GitHub/Data/Traffic.hs | 62 ++++++++++++++++++++++----- src/GitHub/Endpoints/Repos/Traffic.hs | 36 +++++++++++----- 2 files changed, 76 insertions(+), 22 deletions(-) diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs index 20845488..b3191959 100644 --- a/src/GitHub/Data/Traffic.hs +++ b/src/GitHub/Data/Traffic.hs @@ -1,13 +1,17 @@ -{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE StandaloneDeriving #-} -- | Data types used in the traffic API module GitHub.Data.Traffic where -import Data.Text (Text) -import Data.Time (UTCTime) +import Data.Text (Text) +import Data.Time (UTCTime) import Data.Vector (Vector) -import GitHub.Data.Name (Name) +import GitHub.Data.Name (Name) import GitHub.Internal.Prelude import Prelude () @@ -41,30 +45,66 @@ instance FromJSON Path where <*> o .: "count" <*> o .: "uniques" -data Period = - Day - | Week - deriving (Eq, Show) +data Period' = + Day' + | Week' + deriving (Eq, Show) + +data Period p where + Day :: Period 'Day' + Week :: Period 'Week' + +deriving instance Eq (Period p) +deriving instance Show (Period p) + +prettyPeriod :: IsString a => Period p -> a +prettyPeriod = \case + Day -> "day" + Week -> "week" data TrafficEvent = View | Clone deriving (Eq, Show) -data TrafficCount (e :: TrafficEvent) (p :: Period) = TrafficCount +data TrafficCount (e :: TrafficEvent) (p :: Period') = TrafficCount { trafficCountTimestamp :: !UTCTime , trafficCount :: !Int , trafficCountUniques :: !Int } + deriving (Eq, Show) + +instance FromJSON (TrafficCount e p) where + parseJSON = withObject "TrafficCount" $ \o -> + TrafficCount + <$> o .: "timestamp" + <*> o .: "count" + <*> o .: "uniques" data Views p = Views { viewsCount :: !Int , viewsUniques :: !Int - , viewsPer :: Vector (TrafficCount 'View p) + , views :: !(Vector (TrafficCount 'View p)) } + deriving (Eq, Show) + +instance FromJSON (Views p) where + parseJSON = withObject "Views" $ \o -> + Views + <$> o .: "count" + <*> o .: "uniques" + <*> o .: "views" data Clones p = Clones { clonesCount :: !Int , clonesUniques :: !Int - , clonesPer :: Vector (TrafficCount 'Clone p) + , clones :: !(Vector (TrafficCount 'Clone p)) } + deriving (Eq, Show) + +instance FromJSON (Clones p) where + parseJSON = withObject "Clones" $ \o -> + Clones + <$> o .: "count" + <*> o .: "uniques" + <*> o .: "clones" diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs index 00512a5f..b6749b40 100644 --- a/src/GitHub/Endpoints/Repos/Traffic.hs +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -6,11 +6,17 @@ module GitHub.Endpoints.Repos.Traffic ( popularPaths, popularPaths', popularPathsR, + views, + views', + viewsR, + clones, + clones', + clonesR ) where import Data.Vector (Vector) -import GitHub.Data (Referrer, Name, Repo, Owner, Auth, Error, Clones, Path, Period, Views) +import GitHub.Data (Referrer, Name, Repo, Owner, Auth, Error, Clones, Path, Period, Views, prettyPeriod) import GitHub.Data.Request (query, toPathPart) import GitHub.Request (Request, executeRequestMaybe) @@ -45,18 +51,26 @@ popularPathsR :: Name Owner -> Name Repo -> Request k (Vector Path) popularPathsR user repo = query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "paths"] [] -views :: Name Owner -> Name Repo -> Period -> IO (Either Error Views) +views :: Name Owner -> Name Repo -> Period p -> IO (Either Error (Views p)) views = - undefined + views' Nothing -views' :: Maybe Auth -> Name Owner -> Name Repo -> Period -> IO (Either Error Views) -views' = - undefined +views' :: Maybe Auth -> Name Owner -> Name Repo -> Period p -> IO (Either Error (Views p)) +views' auth user repo = + executeRequestMaybe auth . viewsR user repo -clones :: Name Owner -> Name Repo -> Period -> IO (Either Error Clones) +viewsR :: Name Owner -> Name Repo -> Period p -> Request k (Views p) +viewsR user repo period = + query ["repos", toPathPart user, toPathPart repo, "traffic", "views"] [("per", Just $ prettyPeriod period)] + +clones :: Name Owner -> Name Repo -> Period p -> IO (Either Error (Clones p)) clones = - undefined + clones' Nothing + +clones' :: Maybe Auth -> Name Owner -> Name Repo -> Period p -> IO (Either Error (Clones p)) +clones' auth user repo = + executeRequestMaybe auth . clonesR user repo -clones' :: Maybe Auth -> Name Owner -> Name Repo -> Period -> IO (Either Error Clones) -clones' = - undefined \ No newline at end of file +clonesR :: Name Owner -> Name Repo -> Period p -> Request k (Clones p) +clonesR user repo period = + query ["repos", toPathPart user, toPathPart repo, "traffic", "clones"] [("per", Just $ prettyPeriod period)] \ No newline at end of file From 8a34263eea071034b82cc73592933d86e8992511 Mon Sep 17 00:00:00 2001 From: Andrew McMiddlin Date: Fri, 31 May 2019 15:43:40 +1000 Subject: [PATCH 08/18] s/Path/PopularPath/ to avoid collisions. --- src/GitHub/Data/Traffic.hs | 14 +++++++------- src/GitHub/Endpoints/Repos/Traffic.hs | 8 ++++---- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs index b3191959..a972195e 100644 --- a/src/GitHub/Data/Traffic.hs +++ b/src/GitHub/Data/Traffic.hs @@ -29,17 +29,17 @@ instance FromJSON Referrer where <*> o .: "count" <*> o .: "uniques" -data Path = Path - { path :: !Text - , pathTitle :: !Text - , pathCount :: !Int - , pathUniques :: !Int +data PopularPath = PopularPath + { popularPath :: !Text + , popularPathTitle :: !Text + , popularPathCount :: !Int + , popularPathUniques :: !Int } deriving (Eq, Show) -instance FromJSON Path where +instance FromJSON PopularPath where parseJSON = withObject "Path" $ \o -> - Path + PopularPath <$> o .: "path" <*> o .: "title" <*> o .: "count" diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs index b6749b40..0de7de50 100644 --- a/src/GitHub/Endpoints/Repos/Traffic.hs +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -16,7 +16,7 @@ module GitHub.Endpoints.Repos.Traffic ( import Data.Vector (Vector) -import GitHub.Data (Referrer, Name, Repo, Owner, Auth, Error, Clones, Path, Period, Views, prettyPeriod) +import GitHub.Data (Referrer, Name, Repo, Owner, Auth, Error, Clones, PopularPath, Period, Views, prettyPeriod) import GitHub.Data.Request (query, toPathPart) import GitHub.Request (Request, executeRequestMaybe) @@ -39,15 +39,15 @@ popularReferrersR :: Name Owner -> Name Repo -> Request k (Vector Referrer) popularReferrersR user repo = query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "referrers"] [] -popularPaths :: Name Owner -> Name Repo -> IO (Either Error (Vector Path)) +popularPaths :: Name Owner -> Name Repo -> IO (Either Error (Vector PopularPath)) popularPaths = popularPaths' Nothing -popularPaths' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Path)) +popularPaths' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector PopularPath)) popularPaths' auth user = executeRequestMaybe auth . popularPathsR user -popularPathsR :: Name Owner -> Name Repo -> Request k (Vector Path) +popularPathsR :: Name Owner -> Name Repo -> Request k (Vector PopularPath) popularPathsR user repo = query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "paths"] [] From 78f80122b848190934d3609b8b4cd2f82bd2c364 Mon Sep 17 00:00:00 2001 From: Andrew McMiddlin Date: Mon, 3 Jun 2019 07:53:59 +1000 Subject: [PATCH 09/18] Remove functions that don't take auth. Traffic API requires auth, so remove the functions that don't do auth. The ones you cargo culted from some other module when getting started... --- src/GitHub/Endpoints/Repos/Traffic.hs | 43 +++++++-------------------- 1 file changed, 10 insertions(+), 33 deletions(-) diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs index 0de7de50..78c4eadf 100644 --- a/src/GitHub/Endpoints/Repos/Traffic.hs +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -1,15 +1,11 @@ -- | The traffic API, as described at module GitHub.Endpoints.Repos.Traffic ( - popularReferrers, popularReferrers', popularReferrersR, - popularPaths, popularPaths', popularPathsR, - views, views', viewsR, - clones, clones', clonesR ) where @@ -18,59 +14,40 @@ import Data.Vector (Vector) import GitHub.Data (Referrer, Name, Repo, Owner, Auth, Error, Clones, PopularPath, Period, Views, prettyPeriod) import GitHub.Data.Request (query, toPathPart) -import GitHub.Request (Request, executeRequestMaybe) - --- | The top 10 referrers for the past 14 days. --- --- > popularReferrers "qfpl" "tasty-hedgehog" -popularReferrers :: Name Owner -> Name Repo -> IO (Either Error (Vector Referrer)) -popularReferrers = - popularReferrers' Nothing +import GitHub.Request (Request, executeRequest) -- | The top 10 referrers for the past 14 days. -- | With authentication. -- -- > popularReferrers' (Just $ BasicAuth "github-username" "github-password") "qfpl" "tasty-hedgehog" -popularReferrers' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Referrer)) +popularReferrers' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Referrer)) popularReferrers' auth user = - executeRequestMaybe auth . popularReferrersR user + executeRequest auth . popularReferrersR user popularReferrersR :: Name Owner -> Name Repo -> Request k (Vector Referrer) popularReferrersR user repo = query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "referrers"] [] -popularPaths :: Name Owner -> Name Repo -> IO (Either Error (Vector PopularPath)) -popularPaths = - popularPaths' Nothing - -popularPaths' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector PopularPath)) +popularPaths' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector PopularPath)) popularPaths' auth user = - executeRequestMaybe auth . popularPathsR user + executeRequest auth . popularPathsR user popularPathsR :: Name Owner -> Name Repo -> Request k (Vector PopularPath) popularPathsR user repo = query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "paths"] [] -views :: Name Owner -> Name Repo -> Period p -> IO (Either Error (Views p)) -views = - views' Nothing - -views' :: Maybe Auth -> Name Owner -> Name Repo -> Period p -> IO (Either Error (Views p)) +views' :: Auth -> Name Owner -> Name Repo -> Period p -> IO (Either Error (Views p)) views' auth user repo = - executeRequestMaybe auth . viewsR user repo + executeRequest auth . viewsR user repo viewsR :: Name Owner -> Name Repo -> Period p -> Request k (Views p) viewsR user repo period = query ["repos", toPathPart user, toPathPart repo, "traffic", "views"] [("per", Just $ prettyPeriod period)] -clones :: Name Owner -> Name Repo -> Period p -> IO (Either Error (Clones p)) -clones = - clones' Nothing - -clones' :: Maybe Auth -> Name Owner -> Name Repo -> Period p -> IO (Either Error (Clones p)) +clones' :: Auth -> Name Owner -> Name Repo -> Period p -> IO (Either Error (Clones p)) clones' auth user repo = - executeRequestMaybe auth . clonesR user repo + executeRequest auth . clonesR user repo clonesR :: Name Owner -> Name Repo -> Period p -> Request k (Clones p) clonesR user repo period = - query ["repos", toPathPart user, toPathPart repo, "traffic", "clones"] [("per", Just $ prettyPeriod period)] \ No newline at end of file + query ["repos", toPathPart user, toPathPart repo, "traffic", "clones"] [("per", Just $ prettyPeriod period)] From 199f13d2c4e360806f18ea26679d547fa695f5c6 Mon Sep 17 00:00:00 2001 From: Andrew McCluskey Date: Mon, 3 Jun 2019 14:14:15 +1000 Subject: [PATCH 10/18] Add haddocks and format Endpoints/Repos/Traffic.hs. --- src/GitHub/Endpoints/Repos/Traffic.hs | 42 +++++++++++++++++++-------- 1 file changed, 30 insertions(+), 12 deletions(-) diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs index 78c4eadf..dd83aeb3 100644 --- a/src/GitHub/Endpoints/Repos/Traffic.hs +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -12,42 +12,60 @@ module GitHub.Endpoints.Repos.Traffic ( import Data.Vector (Vector) -import GitHub.Data (Referrer, Name, Repo, Owner, Auth, Error, Clones, PopularPath, Period, Views, prettyPeriod) +import GitHub.Data + (Auth, Clones, Error, Name, Owner, Period, PopularPath, Referrer, Repo, + Views, prettyPeriod) import GitHub.Data.Request (query, toPathPart) -import GitHub.Request (Request, executeRequest) +import GitHub.Request (Request, executeRequest) -- | The top 10 referrers for the past 14 days. --- | With authentication. -- --- > popularReferrers' (Just $ BasicAuth "github-username" "github-password") "qfpl" "tasty-hedgehog" +-- > popularReferrers' (BasicAuth "github-username" "github-password") "qfpl" "tasty-hedgehog" popularReferrers' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Referrer)) popularReferrers' auth user = - executeRequest auth . popularReferrersR user + executeRequest auth . popularReferrersR user +-- | The top 10 referrers for the past 14 days. +-- See popularReferrersR :: Name Owner -> Name Repo -> Request k (Vector Referrer) popularReferrersR user repo = - query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "referrers"] [] + query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "referrers"] [] +-- | The 10 most popular paths based on visits over the last 14 days. +-- +-- > popularPaths' (OAuth "supersecrettoken") "qfpl" "tasty-hedgehog" popularPaths' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector PopularPath)) popularPaths' auth user = - executeRequest auth . popularPathsR user + executeRequest auth . popularPathsR user +-- | The 10 most popular paths based on visits over the last 14 days. +-- See popularPathsR :: Name Owner -> Name Repo -> Request k (Vector PopularPath) popularPathsR user repo = - query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "paths"] [] + query ["repos", toPathPart user, toPathPart repo, "traffic", "popular", "paths"] [] +-- | The total number of views over the last 14 days, and a daily or weekly breakdown. +-- +-- > views' (OAuth "supersecrettoken") "qfpl" "tasty-hedgehog" Day views' :: Auth -> Name Owner -> Name Repo -> Period p -> IO (Either Error (Views p)) views' auth user repo = - executeRequest auth . viewsR user repo + executeRequest auth . viewsR user repo +-- | The total number of views over the last 14 days, and a daily or weekly breakdown. +-- See viewsR :: Name Owner -> Name Repo -> Period p -> Request k (Views p) viewsR user repo period = - query ["repos", toPathPart user, toPathPart repo, "traffic", "views"] [("per", Just $ prettyPeriod period)] + query ["repos", toPathPart user, toPathPart repo, "traffic", "views"] [("per", Just $ prettyPeriod period)] +-- | The total number of clones over the last 14 days, and a daily or weekly breakdown. +-- +-- > clones' (OAuth "supersecrettoken") "qfpl" "tasty-hedgehog" Week clones' :: Auth -> Name Owner -> Name Repo -> Period p -> IO (Either Error (Clones p)) clones' auth user repo = - executeRequest auth . clonesR user repo + executeRequest auth . clonesR user repo +-- | The total number of clones over the last 14 days, and a daily or weekly breakdown. +-- See clonesR :: Name Owner -> Name Repo -> Period p -> Request k (Clones p) clonesR user repo period = - query ["repos", toPathPart user, toPathPart repo, "traffic", "clones"] [("per", Just $ prettyPeriod period)] + query ["repos", toPathPart user, toPathPart repo, "traffic", "clones"] [("per", Just $ prettyPeriod period)] From 029c3527531de7752fe390f946769aadfba9210a Mon Sep 17 00:00:00 2001 From: Andrew McCluskey Date: Mon, 3 Jun 2019 14:17:52 +1000 Subject: [PATCH 11/18] Remove type-level tracking of periods + formatting. --- src/GitHub/Data/Traffic.hs | 95 ++++++++++++--------------- src/GitHub/Endpoints/Repos/Traffic.hs | 8 +-- 2 files changed, 47 insertions(+), 56 deletions(-) diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs index a972195e..96504d8f 100644 --- a/src/GitHub/Data/Traffic.hs +++ b/src/GitHub/Data/Traffic.hs @@ -1,8 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE StandaloneDeriving #-} -- | Data types used in the traffic API module GitHub.Data.Traffic where @@ -23,11 +21,11 @@ data Referrer = Referrer deriving (Eq, Show, Generic) instance FromJSON Referrer where - parseJSON = withObject "Referrer" $ \o -> - Referrer - <$> o .: "referrer" - <*> o .: "count" - <*> o .: "uniques" + parseJSON = withObject "Referrer" $ \o -> + Referrer + <$> o .: "referrer" + <*> o .: "count" + <*> o .: "uniques" data PopularPath = PopularPath { popularPath :: !Text @@ -38,73 +36,66 @@ data PopularPath = PopularPath deriving (Eq, Show) instance FromJSON PopularPath where - parseJSON = withObject "Path" $ \o -> - PopularPath - <$> o .: "path" - <*> o .: "title" - <*> o .: "count" - <*> o .: "uniques" - -data Period' = - Day' - | Week' - deriving (Eq, Show) - -data Period p where - Day :: Period 'Day' - Week :: Period 'Week' - -deriving instance Eq (Period p) -deriving instance Show (Period p) - -prettyPeriod :: IsString a => Period p -> a + parseJSON = withObject "Path" $ \o -> + PopularPath + <$> o .: "path" + <*> o .: "title" + <*> o .: "count" + <*> o .: "uniques" + +data Period = + Day + | Week + deriving (Eq, Show) + +prettyPeriod :: IsString a => Period -> a prettyPeriod = \case - Day -> "day" - Week -> "week" + Day -> "day" + Week -> "week" data TrafficEvent = View | Clone deriving (Eq, Show) -data TrafficCount (e :: TrafficEvent) (p :: Period') = TrafficCount +data TrafficCount (e :: TrafficEvent) = TrafficCount { trafficCountTimestamp :: !UTCTime , trafficCount :: !Int , trafficCountUniques :: !Int } deriving (Eq, Show) -instance FromJSON (TrafficCount e p) where - parseJSON = withObject "TrafficCount" $ \o -> - TrafficCount - <$> o .: "timestamp" - <*> o .: "count" - <*> o .: "uniques" +instance FromJSON (TrafficCount e) where + parseJSON = withObject "TrafficCount" $ \o -> + TrafficCount + <$> o .: "timestamp" + <*> o .: "count" + <*> o .: "uniques" -data Views p = Views +data Views = Views { viewsCount :: !Int , viewsUniques :: !Int - , views :: !(Vector (TrafficCount 'View p)) + , views :: !(Vector (TrafficCount 'View)) } deriving (Eq, Show) -instance FromJSON (Views p) where - parseJSON = withObject "Views" $ \o -> - Views - <$> o .: "count" - <*> o .: "uniques" - <*> o .: "views" +instance FromJSON Views where + parseJSON = withObject "Views" $ \o -> + Views + <$> o .: "count" + <*> o .: "uniques" + <*> o .: "views" -data Clones p = Clones +data Clones = Clones { clonesCount :: !Int , clonesUniques :: !Int - , clones :: !(Vector (TrafficCount 'Clone p)) + , clones :: !(Vector (TrafficCount 'Clone)) } deriving (Eq, Show) -instance FromJSON (Clones p) where - parseJSON = withObject "Clones" $ \o -> - Clones - <$> o .: "count" - <*> o .: "uniques" - <*> o .: "clones" +instance FromJSON Clones where + parseJSON = withObject "Clones" $ \o -> + Clones + <$> o .: "count" + <*> o .: "uniques" + <*> o .: "clones" diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs index dd83aeb3..1ef62f53 100644 --- a/src/GitHub/Endpoints/Repos/Traffic.hs +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -47,25 +47,25 @@ popularPathsR user repo = -- | The total number of views over the last 14 days, and a daily or weekly breakdown. -- -- > views' (OAuth "supersecrettoken") "qfpl" "tasty-hedgehog" Day -views' :: Auth -> Name Owner -> Name Repo -> Period p -> IO (Either Error (Views p)) +views' :: Auth -> Name Owner -> Name Repo -> Period -> IO (Either Error Views) views' auth user repo = executeRequest auth . viewsR user repo -- | The total number of views over the last 14 days, and a daily or weekly breakdown. -- See -viewsR :: Name Owner -> Name Repo -> Period p -> Request k (Views p) +viewsR :: Name Owner -> Name Repo -> Period -> Request k Views viewsR user repo period = query ["repos", toPathPart user, toPathPart repo, "traffic", "views"] [("per", Just $ prettyPeriod period)] -- | The total number of clones over the last 14 days, and a daily or weekly breakdown. -- -- > clones' (OAuth "supersecrettoken") "qfpl" "tasty-hedgehog" Week -clones' :: Auth -> Name Owner -> Name Repo -> Period p -> IO (Either Error (Clones p)) +clones' :: Auth -> Name Owner -> Name Repo -> Period -> IO (Either Error Clones) clones' auth user repo = executeRequest auth . clonesR user repo -- | The total number of clones over the last 14 days, and a daily or weekly breakdown. -- See -clonesR :: Name Owner -> Name Repo -> Period p -> Request k (Clones p) +clonesR :: Name Owner -> Name Repo -> Period -> Request k Clones clonesR user repo period = query ["repos", toPathPart user, toPathPart repo, "traffic", "clones"] [("per", Just $ prettyPeriod period)] From 10ceda745bd27f3ca3226bdf9c6ab3f775fa236b Mon Sep 17 00:00:00 2001 From: Andrew McCluskey Date: Mon, 3 Jun 2019 15:24:04 +1000 Subject: [PATCH 12/18] Add traffic functions to top level module. --- src/GitHub.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index fb342a9c..5de81045 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -313,6 +313,13 @@ module GitHub ( pingRepoWebhookR, deleteRepoWebhookR, + -- ** Traffic + -- | See + popularReferrersR, + popularPathsR, + viewsR, + clonesR, + -- * Releases releasesR, releaseR, @@ -410,6 +417,7 @@ import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Releases import GitHub.Endpoints.Repos.Statuses +import GitHub.Endpoints.Repos.Traffic import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users From bb3a6b19a50d757d28d09b5f450c42b761cc431b Mon Sep 17 00:00:00 2001 From: Andrew McCluskey Date: Mon, 3 Jun 2019 15:37:30 +1000 Subject: [PATCH 13/18] Final formatting on Data/Traffic. --- src/GitHub/Data/Traffic.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs index 96504d8f..b80544fb 100644 --- a/src/GitHub/Data/Traffic.hs +++ b/src/GitHub/Data/Traffic.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} -- | Data types used in the traffic API module GitHub.Data.Traffic where @@ -28,9 +28,9 @@ instance FromJSON Referrer where <*> o .: "uniques" data PopularPath = PopularPath - { popularPath :: !Text - , popularPathTitle :: !Text - , popularPathCount :: !Int + { popularPath :: !Text + , popularPathTitle :: !Text + , popularPathCount :: !Int , popularPathUniques :: !Int } deriving (Eq, Show) @@ -60,8 +60,8 @@ data TrafficEvent = data TrafficCount (e :: TrafficEvent) = TrafficCount { trafficCountTimestamp :: !UTCTime - , trafficCount :: !Int - , trafficCountUniques :: !Int + , trafficCount :: !Int + , trafficCountUniques :: !Int } deriving (Eq, Show) @@ -73,9 +73,9 @@ instance FromJSON (TrafficCount e) where <*> o .: "uniques" data Views = Views - { viewsCount :: !Int + { viewsCount :: !Int , viewsUniques :: !Int - , views :: !(Vector (TrafficCount 'View)) + , views :: !(Vector (TrafficCount 'View)) } deriving (Eq, Show) @@ -87,9 +87,9 @@ instance FromJSON Views where <*> o .: "views" data Clones = Clones - { clonesCount :: !Int + { clonesCount :: !Int , clonesUniques :: !Int - , clones :: !(Vector (TrafficCount 'Clone)) + , clones :: !(Vector (TrafficCount 'Clone)) } deriving (Eq, Show) From ad1e7d33b7ae5b02c1116d49bc4cefc9a9e26903 Mon Sep 17 00:00:00 2001 From: Andrew McCluskey Date: Mon, 3 Jun 2019 15:41:59 +1000 Subject: [PATCH 14/18] Line lengths in Endpoints/Repos/Traffic. --- src/GitHub/Endpoints/Repos/Traffic.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs index 1ef62f53..cebb0ab1 100644 --- a/src/GitHub/Endpoints/Repos/Traffic.hs +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -55,7 +55,8 @@ views' auth user repo = -- See viewsR :: Name Owner -> Name Repo -> Period -> Request k Views viewsR user repo period = - query ["repos", toPathPart user, toPathPart repo, "traffic", "views"] [("per", Just $ prettyPeriod period)] + query ["repos", toPathPart user, toPathPart repo, "traffic", "views"] + [("per", Just $ prettyPeriod period)] -- | The total number of clones over the last 14 days, and a daily or weekly breakdown. -- @@ -68,4 +69,5 @@ clones' auth user repo = -- See clonesR :: Name Owner -> Name Repo -> Period -> Request k Clones clonesR user repo period = - query ["repos", toPathPart user, toPathPart repo, "traffic", "clones"] [("per", Just $ prettyPeriod period)] + query ["repos", toPathPart user, toPathPart repo, "traffic", "clones"] + [("per", Just $ prettyPeriod period)] From 90930b52750850ff60de9cec5183c48cb30874bb Mon Sep 17 00:00:00 2001 From: Andrew McCluskey Date: Tue, 4 Jun 2019 09:49:17 +1000 Subject: [PATCH 15/18] Format Data.Traffic per feedback. --- src/GitHub/Data/Traffic.hs | 51 +++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 28 deletions(-) diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs index b80544fb..f5d91eed 100644 --- a/src/GitHub/Data/Traffic.hs +++ b/src/GitHub/Data/Traffic.hs @@ -21,11 +21,10 @@ data Referrer = Referrer deriving (Eq, Show, Generic) instance FromJSON Referrer where - parseJSON = withObject "Referrer" $ \o -> - Referrer - <$> o .: "referrer" - <*> o .: "count" - <*> o .: "uniques" + parseJSON = withObject "Referrer" $ \o -> Referrer + <$> o .: "referrer" + <*> o .: "count" + <*> o .: "uniques" data PopularPath = PopularPath { popularPath :: !Text @@ -36,12 +35,11 @@ data PopularPath = PopularPath deriving (Eq, Show) instance FromJSON PopularPath where - parseJSON = withObject "Path" $ \o -> - PopularPath - <$> o .: "path" - <*> o .: "title" - <*> o .: "count" - <*> o .: "uniques" + parseJSON = withObject "Path" $ \o -> PopularPath + <$> o .: "path" + <*> o .: "title" + <*> o .: "count" + <*> o .: "uniques" data Period = Day @@ -53,8 +51,8 @@ prettyPeriod = \case Day -> "day" Week -> "week" -data TrafficEvent = - View +data TrafficEvent + = View | Clone deriving (Eq, Show) @@ -66,11 +64,10 @@ data TrafficCount (e :: TrafficEvent) = TrafficCount deriving (Eq, Show) instance FromJSON (TrafficCount e) where - parseJSON = withObject "TrafficCount" $ \o -> - TrafficCount - <$> o .: "timestamp" - <*> o .: "count" - <*> o .: "uniques" + parseJSON = withObject "TrafficCount" $ \o -> TrafficCount + <$> o .: "timestamp" + <*> o .: "count" + <*> o .: "uniques" data Views = Views { viewsCount :: !Int @@ -80,11 +77,10 @@ data Views = Views deriving (Eq, Show) instance FromJSON Views where - parseJSON = withObject "Views" $ \o -> - Views - <$> o .: "count" - <*> o .: "uniques" - <*> o .: "views" + parseJSON = withObject "Views" $ \o -> Views + <$> o .: "count" + <*> o .: "uniques" + <*> o .: "views" data Clones = Clones { clonesCount :: !Int @@ -94,8 +90,7 @@ data Clones = Clones deriving (Eq, Show) instance FromJSON Clones where - parseJSON = withObject "Clones" $ \o -> - Clones - <$> o .: "count" - <*> o .: "uniques" - <*> o .: "clones" + parseJSON = withObject "Clones" $ \o -> Clones + <$> o .: "count" + <*> o .: "uniques" + <*> o .: "clones" From c70f2b8a8f3af9fe9884caa5d0aa9ccb052c251b Mon Sep 17 00:00:00 2001 From: Andrew McCluskey Date: Tue, 4 Jun 2019 09:54:08 +1000 Subject: [PATCH 16/18] Move period serialization to Endpoint module. --- src/GitHub/Data/Traffic.hs | 6 ------ src/GitHub/Endpoints/Repos/Traffic.hs | 21 +++++++++++++++------ 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs index f5d91eed..46831d3e 100644 --- a/src/GitHub/Data/Traffic.hs +++ b/src/GitHub/Data/Traffic.hs @@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} -- | Data types used in the traffic API module GitHub.Data.Traffic where @@ -46,11 +45,6 @@ data Period = | Week deriving (Eq, Show) -prettyPeriod :: IsString a => Period -> a -prettyPeriod = \case - Day -> "day" - Week -> "week" - data TrafficEvent = View | Clone diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs index cebb0ab1..414bc78e 100644 --- a/src/GitHub/Endpoints/Repos/Traffic.hs +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE LambdaCase #-} + -- | The traffic API, as described at module GitHub.Endpoints.Repos.Traffic ( popularReferrers', @@ -13,10 +15,12 @@ module GitHub.Endpoints.Repos.Traffic ( import Data.Vector (Vector) import GitHub.Data - (Auth, Clones, Error, Name, Owner, Period, PopularPath, Referrer, Repo, - Views, prettyPeriod) -import GitHub.Data.Request (query, toPathPart) -import GitHub.Request (Request, executeRequest) + (Auth, Clones, Error, Name, Owner, Period (Day, Week), PopularPath, + Referrer, Repo, Views) +import GitHub.Data.Request (query, toPathPart) +import GitHub.Internal.Prelude +import GitHub.Request (Request, executeRequest) +import Prelude () -- | The top 10 referrers for the past 14 days. -- @@ -56,7 +60,7 @@ views' auth user repo = viewsR :: Name Owner -> Name Repo -> Period -> Request k Views viewsR user repo period = query ["repos", toPathPart user, toPathPart repo, "traffic", "views"] - [("per", Just $ prettyPeriod period)] + [("per", Just $ serializePeriod period)] -- | The total number of clones over the last 14 days, and a daily or weekly breakdown. -- @@ -70,4 +74,9 @@ clones' auth user repo = clonesR :: Name Owner -> Name Repo -> Period -> Request k Clones clonesR user repo period = query ["repos", toPathPart user, toPathPart repo, "traffic", "clones"] - [("per", Just $ prettyPeriod period)] + [("per", Just $ serializePeriod period)] + +serializePeriod :: IsString a => Period -> a +serializePeriod = \case + Day -> "day" + Week -> "week" From 509ed8a41a2487229b2c29cd43b8142f05d14ef0 Mon Sep 17 00:00:00 2001 From: Andrew McMiddlin Date: Wed, 5 Jun 2019 09:44:47 +1000 Subject: [PATCH 17/18] Remove use of LambdaCase. --- src/GitHub/Endpoints/Repos/Traffic.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/GitHub/Endpoints/Repos/Traffic.hs b/src/GitHub/Endpoints/Repos/Traffic.hs index 414bc78e..084a358b 100644 --- a/src/GitHub/Endpoints/Repos/Traffic.hs +++ b/src/GitHub/Endpoints/Repos/Traffic.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} - -- | The traffic API, as described at module GitHub.Endpoints.Repos.Traffic ( popularReferrers', @@ -77,6 +75,6 @@ clonesR user repo period = [("per", Just $ serializePeriod period)] serializePeriod :: IsString a => Period -> a -serializePeriod = \case +serializePeriod p = case p of Day -> "day" Week -> "week" From 6e036e9f3efad7dcd9faae57926bfc11b2e9358a Mon Sep 17 00:00:00 2001 From: Andrew McCluskey Date: Tue, 9 Jul 2019 10:58:30 +1000 Subject: [PATCH 18/18] Add ToJSON instances for Traffic types. --- src/GitHub/Data/Traffic.hs | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/src/GitHub/Data/Traffic.hs b/src/GitHub/Data/Traffic.hs index 46831d3e..df45b8ad 100644 --- a/src/GitHub/Data/Traffic.hs +++ b/src/GitHub/Data/Traffic.hs @@ -25,6 +25,13 @@ instance FromJSON Referrer where <*> o .: "count" <*> o .: "uniques" +instance ToJSON Referrer where + toJSON (Referrer r c u) = object + [ "referrer" .= r + , "count" .= c + , "uniques" .= u + ] + data PopularPath = PopularPath { popularPath :: !Text , popularPathTitle :: !Text @@ -40,6 +47,14 @@ instance FromJSON PopularPath where <*> o .: "count" <*> o .: "uniques" +instance ToJSON PopularPath where + toJSON (PopularPath p t c u) = object + [ "path" .= p + , "title" .= t + , "count" .= c + , "uniques" .= u + ] + data Period = Day | Week @@ -63,6 +78,13 @@ instance FromJSON (TrafficCount e) where <*> o .: "count" <*> o .: "uniques" +instance ToJSON (TrafficCount e) where + toJSON (TrafficCount t c u) = object + [ "timestamp" .= t + , "count" .= c + , "uniques" .= u + ] + data Views = Views { viewsCount :: !Int , viewsUniques :: !Int @@ -76,6 +98,13 @@ instance FromJSON Views where <*> o .: "uniques" <*> o .: "views" +instance ToJSON Views where + toJSON (Views c u v) = object + [ "count" .= c + , "uniques" .= u + , "views" .= v + ] + data Clones = Clones { clonesCount :: !Int , clonesUniques :: !Int @@ -88,3 +117,10 @@ instance FromJSON Clones where <$> o .: "count" <*> o .: "uniques" <*> o .: "clones" + +instance ToJSON Clones where + toJSON (Clones c u cs) = object + [ "count" .= c + , "uniques" .= u + , "clones" .= cs + ]