Browse Source

Add argument parsing support

master
Wesley Kerfoot 6 years ago
parent
commit
99abc26d18
  1. 21
      app/Main.hs
  2. 3
      pullwatch.cabal
  3. 28
      src/PullWatch/PullWatch.hs
  4. 2
      stack.yaml

21
app/Main.hs

@ -1,27 +1,20 @@
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import PullWatch.PullWatch
( monitorPRs
, getLatestPRs
, getLatest
, prID
)
import PullWatch.Environment (getPAT)
import qualified Data.Default as Default (def)
import Data.Default (def)
import Control.Applicative
main :: IO ()
main = do
doMonitor :: RepoArgs -> IO ()
doMonitor (RepoArgs owner repo) = do
-- Set up authentication token from environment
pat <- getPAT
let ?pat = pat
--prIDs <- getLatestPRs [("racket", "racket")]
--print prIDs
monitorPRs def [("weskerfoot", "PullWatch")]
monitorPRs Default.def [(owner, repo)]
return ()
main = parseRepoArgs doMonitor

3
pullwatch.cabal

@ -34,6 +34,7 @@ library
build-depends:
base >=4.7 && <5
, github
, argparser
, base-compat
, text
, bytestring
@ -55,6 +56,7 @@ executable pullwatch-exe
base >=4.7 && <5
, pullwatch
, github
, argparser
, base-compat
, text
, bytestring
@ -77,6 +79,7 @@ test-suite pullwatch-test
base >=4.7 && <5
, pullwatch
, github
, argparser
, base-compat
, text
, bytestring

28
src/PullWatch/PullWatch.hs

@ -1,6 +1,7 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE FlexibleInstances #-}
module PullWatch.PullWatch
( getLatest
@ -9,6 +10,8 @@ module PullWatch.PullWatch
, prTitle
, prID
, monitorPRs
, parseRepoArgs
, RepoArgs(..)
) where
import GitHub.Data.PullRequests
@ -28,12 +31,17 @@ import Data.Vector ((!?))
import GitHub.Data.Id (untagId)
import GitHub.Data.Name (untagName)
import Prelude.Compat
import System.Console.ArgParser
import System.Console.ArgParser.QuickParams (RawRead, rawParse)
import GitHub.Data.Name
import qualified Data.IntMap as IntMap
import qualified Data.Text as T
import qualified GitHub.Auth as Auth
import qualified GitHub.Endpoints.PullRequests as PR
-- Type definitions
type PullRequests = IntMap PullRequest
data PullRequest = PR {
@ -45,6 +53,11 @@ data PullRequest = PR {
}
deriving (Show)
data RepoArgs = RepoArgs (PR.Name PR.Owner)
(PR.Name PR.Repo)
deriving (Show)
instance Default PullRequest where
def = PR {
prText = ""
@ -54,6 +67,21 @@ instance Default PullRequest where
, prID = 0
}
instance RawRead (PR.Name a) where
rawParse x = Just (N $ T.pack x, x)
-- Argument parser
parseRepos :: ParserSpec RepoArgs
parseRepos = RepoArgs
`parsedBy` reqPos "owner"
`andBy` reqPos "repo"
parseRepoArgs = withParseResult parseRepos
-- Helper functions
tenMinutes = 300000000*2
getPRId = Just . fromIntegral . untagId . simplePullRequestId

2
stack.yaml

@ -41,6 +41,8 @@ packages:
extra-deps:
- fdo-notify-0.3.1
- github-0.21
- git: git@github.com:sbergot/ArgParser.git
commit: 801ffac4551382a0b08a50ae3b98402ebbf35b30
# Override default flag values for local packages and extra-deps
# flags: {}

Loading…
Cancel
Save