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 + ] pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy