diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/pivotal-tracker.cabal b/pivotal-tracker.cabal new file mode 100644 --- /dev/null +++ b/pivotal-tracker.cabal @@ -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 + diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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 <> " STORY_ID\n" + <> " Use TRACKER_API_TOKEN environment variable if needed" diff --git a/src/Web/Tracker.hs b/src/Web/Tracker.hs new file mode 100644 --- /dev/null +++ b/src/Web/Tracker.hs @@ -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) diff --git a/src/Web/Tracker/Types.hs b/src/Web/Tracker/Types.hs new file mode 100644 --- /dev/null +++ b/src/Web/Tracker/Types.hs @@ -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