pivotal-tracker (empty) → 0.1.0.0
raw patch · 6 files changed
+313/−0 lines, 6 filesdep +aesondep +aeson-casingdep +basesetup-changed
Dependencies added: aeson, aeson-casing, base, either, servant, servant-client, text, time, tracker, transformers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- pivotal-tracker.cabal +45/−0
- src/Main.hs +69/−0
- src/Web/Tracker.hs +44/−0
- src/Web/Tracker/Types.hs +123/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Utku Demir++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Utku Demir nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pivotal-tracker.cabal view
@@ -0,0 +1,45 @@+-- Initial pivotal-tracker.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: pivotal-tracker+version: 0.1.0.0+synopsis: A library and a CLI tool for accessing Pivotal Tracker API+-- description: +license: BSD3+license-file: LICENSE+author: Utku Demir+maintainer: utdemir@gmail.com+-- copyright: +category: Web+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/utdemir/hs-pivotal-tracker ++library+ exposed-modules: Web.Tracker+ other-modules: Web.Tracker.Types+ build-depends: base >=4.8 && <4.9+ , servant+ , servant-client+ , aeson+ , text+ , transformers+ , time+ , aeson-casing+ hs-source-dirs: src+ default-language: Haskell2010++executable tracker+ main-is: src/Main.hs+ build-depends: base >=4.8 && <4.9+ , tracker+ , servant+ , text+ , either+ , transformers+ default-language: Haskell2010+
+ src/Main.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++--------------------------------------------------------------------------------+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Either+import Data.List+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import Servant.API+import System.Environment+import System.Exit+import Text.Read (readMaybe)+--------------------------------------------------------------------------------+import Web.Tracker+--------------------------------------------------------------------------------++main :: IO ()+main = do+ token <- fmap T.pack <$> lookupEnv "TRACKER_API_TOKEN"++ query <- getArgs >>= return . \case+ "unstart" :sid:[] -> doSetState token Unstarted <$> readMaybe sid+ "start" :sid:[] -> doSetState token Started <$> readMaybe sid+ "finish" :sid:[] -> doSetState token Finished <$> readMaybe sid+ "deliver" :sid:[] -> doSetState token Delivered <$> readMaybe sid+ "accept" :sid:[] -> doSetState token Accepted <$> readMaybe sid+ "reject" :sid:[] -> doSetState token Rejected <$> readMaybe sid+ "stateOf" :sid:[] -> doStateOf token <$> readMaybe sid+ "list-unstarted" :pid:[] -> doList token Unstarted <$> readMaybe pid+ "list-started" :pid:[] -> doList token Started <$> readMaybe pid+ "list-finished" :pid:[] -> doList token Finished <$> readMaybe pid+ "list-delivered" :pid:[] -> doList token Delivered <$> readMaybe pid+ _ -> Nothing++ query <- maybe invalidSyntax return query++ runEitherT query >>= \case+ Left err -> print err >> exitWith (ExitFailure 1)+ Right () -> return ()++ return ()++doSetState :: Maybe Text -> StoryState -> StoryId -> EitherT ServantError IO ()+doSetState t s i = void $ updateStory t (SetStoryState s) i++printStory :: MonadIO m => Story -> m ()+printStory Story{sId=StoryId id, sName, sStoryType, sCurrentState}+ = liftIO . putStrLn $ show id+ <> "\t" <> show sStoryType+ <> "\t" <> show sCurrentState+ <> "\t" <> T.unpack sName++doList :: Maybe Text -> StoryState -> ProjectId -> EitherT ServantError IO ()+doList t s i = stories t i (Just s) >>= mapM_ printStory . take 30++doStateOf :: Maybe Text -> StoryId -> EitherT ServantError IO ()+doStateOf t i = story t i >>= liftIO . print . sCurrentState++invalidSyntax :: IO a+invalidSyntax = getProgName >>= putStrLn . msg >> exitWith (ExitFailure 1)+ where msg n+ = "Usage: " <> n <> " <unstart|start|finish|deliver|accept|reject> STORY_ID\n"+ <> " Use TRACKER_API_TOKEN environment variable if needed"
+ src/Web/Tracker.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++module Web.Tracker+ ( module Web.Tracker.Types+ , story+ , updateStory+ , stories++ -- Re-exports+ , ServantError+ ) where++--------------------------------------------------------------------------------+import Data.Proxy+import Data.Text (Text)+import Servant.API+import Servant.Client+--------------------------------------------------------------------------------+import Web.Tracker.Types+--------------------------------------------------------------------------------++type API = "services" :> "v5" :> "stories"+ :> Header "X-TrackerToken" Text+ :> Capture ":storyId" StoryId+ :> Get '[JSON] Story+ :<|> "services" :> "v5" :> "stories"+ :> Header "X-TrackerToken" Text+ :> ReqBody '[JSON] UpdateStory+ :> Capture ":storyId" StoryId+ :> Put '[JSON] Story+ :<|> "services" :> "v5" :> "projects"+ :> Header "X-TrackerToken" Text+ :> Capture ":projectId" ProjectId+ :> "stories"+ :> QueryParam "with_state" StoryState+ :> Get '[JSON] [Story]++api :: Proxy API+api = Proxy++story :<|> updateStory :<|> stories = client api (BaseUrl Https "www.pivotaltracker.com" 443)
+ src/Web/Tracker/Types.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module Web.Tracker.Types where++--------------------------------------------------------------------------------+import Data.Aeson+import Data.Aeson.Casing+import Data.String+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock+import GHC.Generics+import Servant.API+import Text.Read+--------------------------------------------------------------------------------+data StoryId+ = StoryId Integer+ deriving (Show, Eq, Ord)++instance FromJSON StoryId where+ parseJSON = fmap StoryId . parseJSON++instance Read StoryId where+ readPrec = fmap StoryId readPrec++instance ToJSON StoryId where+ toJSON (StoryId t) = toJSON t++instance ToText StoryId where+ toText (StoryId t) = toText t++data ProjectId+ = ProjectId Int+ deriving (Show, Eq, Ord)++instance FromJSON ProjectId where+ parseJSON = fmap ProjectId . parseJSON++instance Read ProjectId where+ readPrec = fmap ProjectId readPrec++instance ToText ProjectId where+ toText (ProjectId t) = toText t++data UserId+ = UserId Int+ deriving (Show, Eq, Ord)++instance FromJSON UserId where+ parseJSON = fmap UserId . parseJSON++data StoryState+ = Accepted | Delivered | Finished | Started+ | Rejected | Planned | Unstarted | Unscheduled+ deriving (Show, Eq, Ord, Enum, Bounded)++instance FromJSON StoryState where+ parseJSON "accepted" = return Accepted+ parseJSON "delivered" = return Delivered+ parseJSON "finished" = return Finished+ parseJSON "started" = return Started+ parseJSON "rejected" = return Rejected+ parseJSON "planned" = return Planned+ parseJSON "unstarted" = return Unstarted+ parseJSON "unscheduled" = return Unscheduled++instance ToJSON StoryState where+ toJSON = toJSON . toText++instance ToText StoryState where+ toText Accepted = "accepted"+ toText Delivered = "delivered"+ toText Finished = "finished"+ toText Started = "started"+ toText Rejected = "rejected"+ toText Planned = "planned"+ toText Unstarted = "unstarted"+ toText Unscheduled = "unscheduled"++data StoryType+ = Feature | Bug | Chore | Release+ deriving (Show, Eq, Ord)++instance FromJSON StoryType where+ parseJSON "feature" = return Feature+ parseJSON "bug" = return Bug+ parseJSON "chore" = return Chore+ parseJSON "release" = return Release++data UpdateStory+ = SetStoryState StoryState++instance ToJSON UpdateStory where+ toJSON (SetStoryState state)+ = object [ "current_state" .= state ]++data Story = Story+ { sId :: StoryId+ , sProjectId :: ProjectId+ , sName :: Text+ , sDescription :: Maybe Text+ , sStoryType :: StoryType+ , sCurrentState :: StoryState+ , sEstimate :: Maybe Double+ , sAcceptedAt :: Maybe UTCTime+ -- , sDeadline :: UTCTime+ -- , sProjectedCompletion :: UTCTime+ , sRequestedById :: UserId+ , sOwnerIds :: [UserId]+ -- , sLabels :: [Label]+ -- , sFollowerIds :: [UserId]+ , sCreatedAt :: UTCTime+ , sUpdatedAt :: UTCTime+ -- , sBeforeId :: UTCTime+ -- , sAfterId :: UTCtime+ -- , sIntegrationId+ -- , sExternalId+ , sUrl :: Text+ } deriving (Show, Generic)++instance FromJSON Story where+ parseJSON = genericParseJSON $ aesonPrefix snakeCase