GitHub API v3 — Gists (partial)

GitHubGistAPI.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
module GitHub where

import Control.Lens
import Data.Aeson
import Data.Aeson.Types (camelTo)
import qualified Data.Aeson.Types as JSON
import Data.HashMap.Strict (HashMap)
import Data.Proxy
import Data.Swagger
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.Typeable
import GHC.Generics (Generic)
import Servant
import Servant.Swagger

type GitHubGistAPI
    = "users" :> Capture "username" Username :> "gists" :> QueryParam "since" UTCTime :> Get '[JSON] [Gist]
 :<|> "gists" :> GistsAPI

type GistsAPI
    = "public"  :> QueryParam "since" UTCTime :> Get '[JSON] [Gist]
 :<|> "starred" :> QueryParam "since" UTCTime :> Get '[JSON] [Gist]
 :<|> Capture "id" GistId :> GistAPI

type GistAPI
    = Get '[JSON] Gist
 :<|> Capture "sha" Revision :> Get '[JSON] Gist

newtype Username = Username Text deriving (Show, Generic, Typeable, ToText, ToJSON)

newtype GistId = GistId Text deriving (Show, Generic, Typeable, ToText, ToJSON)

newtype SHA = SHA Text deriving (Show, Generic, Typeable, ToText)

type Revision = SHA

data Gist = Gist
  { gistId          :: GistId
  , gistDescription :: Text
  , gistOwner       :: Owner
  , gistFiles       :: HashMap FilePath GistFile
  , gistTruncated   :: Bool
  , gistComments    :: Integer
  , gistCreatedAt   :: UTCTime
  , gistUpdatedAt   :: UTCTime
  } deriving (Show, Generic, Typeable)

data OwnerType
  = User
  | Organization
  deriving (Show, Generic, Typeable)

data Owner = Owner
  { ownerLogin      :: Username
  , ownerType       :: OwnerType
  , ownerSiteAdmin  :: Bool
  } deriving (Show, Generic, Typeable)

data GistFile = GistFile
  { gistfileSize      :: Integer
  , gistfileLanguage  :: Text
  , gistfileRawUrl    :: Text
  } deriving (Show, Generic, Typeable)

modifier :: String -> String
modifier = drop 1 . dropWhile (/= '_') . camelTo '_'

prefixOptions :: JSON.Options
prefixOptions = JSON.defaultOptions { JSON.fieldLabelModifier = modifier }

instance ToJSON OwnerType
instance ToJSON Owner    where toJSON = genericToJSON prefixOptions
instance ToJSON GistFile where toJSON = genericToJSON prefixOptions
instance ToJSON Gist     where toJSON = genericToJSON prefixOptions

prefixSchemaOptions :: SchemaOptions
prefixSchemaOptions = defaultSchemaOptions { fieldLabelModifier = modifier }

instance ToParamSchema SHA
instance ToParamSchema Username
instance ToParamSchema GistId

instance ToSchema Username
instance ToSchema GistId
instance ToSchema OwnerType
instance ToSchema Owner    where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions
instance ToSchema GistFile where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions
instance ToSchema Gist     where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions

gistSwagger :: Swagger
gistSwagger = toSwagger (Proxy :: Proxy GitHubGistAPI)
  & host ?~ "api.github.com"
  & info.title .~ "GitHub Gists API"
  & info.version .~ "v3"