pivotal-tracker 0.1.0.1 → 0.2.0.0
raw patch · 6 files changed
+231/−159 lines, 6 filesdep +hspecdep +http-clientdep +http-client-tlsdep ~base
Dependencies added: hspec, http-client, http-client-tls, mtl
Dependency ranges changed: base
Files
- pivotal-tracker.cabal +19/−4
- src/Main.hs +24/−24
- src/Web/Tracker.hs +40/−8
- src/Web/Tracker/Story.hs +129/−0
- src/Web/Tracker/Types.hs +0/−123
- test/Spec.hs +19/−0
pivotal-tracker.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: pivotal-tracker-version: 0.1.0.1+version: 0.2.0.0 synopsis: A library and a CLI tool for accessing Pivotal Tracker API -- description: license: BSD3@@ -21,25 +21,40 @@ library exposed-modules: Web.Tracker- other-modules: Web.Tracker.Types- build-depends: base >=4.8 && <4.9+ , Web.Tracker.Story+ build-depends: base >=4.6 && <4.11 , servant , servant-client , aeson+ , http-client+ , http-client-tls+ , mtl , text , transformers , time , aeson-casing hs-source-dirs: src default-language: Haskell2010+ default-extensions: OverloadedStrings executable tracker main-is: src/Main.hs- build-depends: base >=4.8 && <4.9+ build-depends: base >=4.6 && <4.11 , pivotal-tracker , servant , text , either , transformers default-language: Haskell2010+ default-extensions: OverloadedStrings +test-suite tracker-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , hspec+ , pivotal-tracker+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010+ default-extensions: OverloadedStrings
src/Main.hs view
@@ -1,13 +1,12 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-} module Main where --------------------------------------------------------------------------------+import Control.Applicative ((<$>)) import Control.Monad import Control.Monad.IO.Class-import Control.Monad.Trans.Either import Data.List import Data.Monoid import Data.Text (Text)@@ -18,36 +17,37 @@ import Text.Read (readMaybe) -------------------------------------------------------------------------------- import Web.Tracker+import Web.Tracker.Story -------------------------------------------------------------------------------- main :: IO () main = do- token <- fmap T.pack <$> lookupEnv "TRACKER_API_TOKEN"+ token <- T.pack <$> lookupFail "TRACKER_API_TOKEN"+ manager <- mkManager 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+ "unstart" :sid:[] -> doSetState Unstarted <$> readMaybe sid+ "start" :sid:[] -> doSetState Started <$> readMaybe sid+ "finish" :sid:[] -> doSetState Finished <$> readMaybe sid+ "deliver" :sid:[] -> doSetState Delivered <$> readMaybe sid+ "accept" :sid:[] -> doSetState Accepted <$> readMaybe sid+ "reject" :sid:[] -> doSetState Rejected <$> readMaybe sid+ "stateOf" :sid:[] -> doStateOf <$> readMaybe sid+ "list-unstarted" :pid:[] -> doList Unstarted <$> readMaybe pid+ "list-started" :pid:[] -> doList Started <$> readMaybe pid+ "list-finished" :pid:[] -> doList Finished <$> readMaybe pid+ "list-delivered" :pid:[] -> doList Delivered <$> readMaybe pid _ -> Nothing - query <- maybe invalidSyntax return query-- runEitherT query >>= \case+ maybe invalidSyntax (runTrackerAPI token manager) query >>= \case Left err -> print err >> exitWith (ExitFailure 1) Right () -> return () - return ()+lookupFail :: String -> IO String+lookupFail var = maybe (fail $ "Expected environment variable " ++ var) return =<< lookupEnv var -doSetState :: Maybe Text -> StoryState -> StoryId -> EitherT ServantError IO ()-doSetState t s i = void $ updateStory t (SetStoryState s) i+doSetState :: StoryState -> StoryId -> TrackerAPI ()+doSetState s i = void $ updateStory (SetStoryState s) i printStory :: MonadIO m => Story -> m () printStory Story{sId=StoryId id, sName, sStoryType, sCurrentState}@@ -56,11 +56,11 @@ <> "\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+doList :: StoryState -> ProjectId -> TrackerAPI ()+doList s i = stories i (Just s) >>= mapM_ printStory . take 30 -doStateOf :: Maybe Text -> StoryId -> EitherT ServantError IO ()-doStateOf t i = story t i >>= liftIO . print . sCurrentState+doStateOf :: StoryId -> TrackerAPI ()+doStateOf i = story i >>= liftIO . print . sCurrentState invalidSyntax :: IO a invalidSyntax = getProgName >>= putStrLn . msg >> exitWith (ExitFailure 1)
src/Web/Tracker.hs view
@@ -1,44 +1,76 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Web.Tracker- ( module Web.Tracker.Types- , story+ ( story , updateStory , stories -- Re-exports , ServantError+ , HTTP.Manager+ , mkManager+ , TrackerAPI+ , runTrackerAPI ) where --------------------------------------------------------------------------------+import Control.Monad.IO.Class+import Control.Monad.Trans.Except+import Control.Monad.Trans.Reader import Data.Proxy import Data.Text (Text)+import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Client.TLS as HTTP import Servant.API import Servant.Client ---------------------------------------------------------------------------------import Web.Tracker.Types+import Web.Tracker.Story -------------------------------------------------------------------------------- type API = "services" :> "v5" :> "stories"- :> Header "X-TrackerToken" Text :> Capture ":storyId" StoryId+ :> Header "X-TrackerToken" Text :> Get '[JSON] Story :<|> "services" :> "v5" :> "stories"- :> Header "X-TrackerToken" Text :> ReqBody '[JSON] UpdateStory :> Capture ":storyId" StoryId+ :> Header "X-TrackerToken" Text :> Put '[JSON] Story :<|> "services" :> "v5" :> "projects"- :> Header "X-TrackerToken" Text :> Capture ":projectId" ProjectId :> "stories" :> QueryParam "with_state" StoryState+ :> Header "X-TrackerToken" Text :> Get '[JSON] [Story] api :: Proxy API api = Proxy -story :<|> updateStory :<|> stories = client api (BaseUrl Https "www.pivotaltracker.com" 443)+story' :<|> updateStory' :<|> stories' = client api --++trackerUrl = (BaseUrl Https "www.pivotaltracker.com" 443 "")++type TrackerAPI a = ReaderT (Text, HTTP.Manager) (ExceptT ServantError IO ) a++type TrackerClientM a = Maybe Text -> ClientM a++runTrackerAPI :: Text -> HTTP.Manager -> TrackerAPI a -> IO (Either ServantError a)+runTrackerAPI tok man tApi = runExceptT $ runReaderT tApi (tok,man)++toTrackerAPI :: TrackerClientM a -> TrackerAPI a+toTrackerAPI cli = ReaderT $ \(tok,man) -> ExceptT $ runClientM (cli $ Just tok) (ClientEnv man trackerUrl)++mkManager :: IO HTTP.Manager+mkManager = HTTP.newManager HTTP.tlsManagerSettings++story :: StoryId -> TrackerAPI Story+story = toTrackerAPI . story'++updateStory :: UpdateStory -> StoryId -> TrackerAPI Story+updateStory us sid = toTrackerAPI $ updateStory' us sid++stories :: ProjectId -> Maybe StoryState -> TrackerAPI [Story]+stories pid mbss = toTrackerAPI $ stories' pid mbss
+ src/Web/Tracker/Story.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Web.Tracker.Story 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 ToHttpApiData StoryId where+ toUrlPiece (StoryId t) = toUrlPiece 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 ToHttpApiData ProjectId where+ toUrlPiece (ProjectId t) = toUrlPiece 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 = withText "StoryState" $ \case+ "accepted" -> return Accepted+ "delivered" -> return Delivered+ "finished" -> return Finished+ "started" -> return Started+ "rejected" -> return Rejected+ "planned" -> return Planned+ "unstarted" -> return Unstarted+ "unscheduled" -> return Unscheduled+ other -> fail $ "Invalid story state: " ++ T.unpack other++instance ToJSON StoryState where+ toJSON = toJSON . toUrlPiece++instance ToHttpApiData StoryState where+ toUrlPiece = \case+ Accepted -> "accepted"+ Delivered -> "delivered"+ Finished -> "finished"+ Started -> "started"+ Rejected -> "rejected"+ Planned -> "planned"+ Unstarted -> "unstarted"+ Unscheduled -> "unscheduled"++data StoryType+ = Feature | Bug | Chore | Release+ deriving (Show, Eq, Ord)++instance FromJSON StoryType where+ parseJSON = withText "StoryType" $ \case+ "feature" -> return Feature+ "bug" -> return Bug+ "chore" -> return Chore+ "release" -> return Release+ other -> fail $ "Invalid StoryType: " ++ T.unpack other++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
− src/Web/Tracker/Types.hs
@@ -1,123 +0,0 @@-{-# 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
+ test/Spec.hs view
@@ -0,0 +1,19 @@+import Test.Hspec++--------------------------------------------------------------------------------+import Data.Functor((<$>))+--------------------------------------------------------------------------------+import Web.Tracker+import Web.Tracker.Story+--------------------------------------------------------------------------------++main :: IO ()+main = hspec $+ describe "Web.Tracker story" $+ it "should return story data" $ do+ manager <- mkManager+ s <- runTrackerAPI token manager $ story (StoryId 104591424)+ show (sStoryType <$> s) `shouldBe` "Right Feature"+ show (sName <$> s) `shouldBe` "Right \"Shopper should be able to view contents of shopping cart\""+ where+ token = "7f3f76bc6ae8c48e7b528369c999c8d8"