leankit-api (empty) → 0.1
raw patch · 21 files changed
+920/−0 lines, 21 filesdep +basedep +curldep +splitsetup-changed
Dependencies added: base, curl, split
Files
- LICENSE +20/−0
- Leankit/Api.hs +190/−0
- Leankit/Types.hs +38/−0
- Leankit/Types/AssignedUser.hs +26/−0
- Leankit/Types/Board.hs +44/−0
- Leankit/Types/BoardHistoryItem.hs +35/−0
- Leankit/Types/BoardIdentifierSet.hs +34/−0
- Leankit/Types/BoardShort.hs +26/−0
- Leankit/Types/Card.hs +93/−0
- Leankit/Types/CardComment.hs +27/−0
- Leankit/Types/CardContext.hs +26/−0
- Leankit/Types/CardHistoryItem.hs +105/−0
- Leankit/Types/Common.hs +64/−0
- Leankit/Types/Credentials.hs +10/−0
- Leankit/Types/Lane.hs +42/−0
- Leankit/Types/LaneLayout.hs +21/−0
- Leankit/Types/LaneShort.hs +30/−0
- Leankit/Types/TH.hs +13/−0
- Leankit/Types/User.hs +34/−0
- Setup.hs +2/−0
- leankit-api.cabal +40/−0
+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2014 dtorok++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Leankit/Api.hs view
@@ -0,0 +1,190 @@+module Leankit.Api where++import Data.ByteString.Lazy.Internal (ByteString)+import Network.Curl++import Control.Applicative ((<$>))++import Data.Aeson+import Leankit.Types+import Leankit.Types.Common+import Leankit.Types.Credentials+import Leankit.Types.Board (Board)+import Leankit.Types.BoardShort (BoardShort)+import Leankit.Types.Card (Card)+import Leankit.Types.BoardIdentifierSet (BoardIdentifierSet)+import Leankit.Types.BoardHistoryItem (BoardHistoryItem)+import Leankit.Types.Lane (Lane)+import Leankit.Types.LaneLayout (LaneLayout)+import Leankit.Types.CardHistoryItem (CardHistoryItem)+import Leankit.Types.CardComment (CardComment)++-- TODO what can we do with this?+(<=<) :: Monad m => (b->m c) -> (a -> m b) -> (a -> m c)+(<=<) fbc fab a = fbc =<< fab a++(<==<) :: Monad m => (b->m c) -> (a1 -> a2 -> m b) -> (a1 -> a2 -> m c)+(<==<) fbc fab a1 a2 = fbc =<< fab a1 a2++(<===<) :: Monad m => (b->m c) -> (a1 -> a2 -> a3 -> m b) -> (a1 -> a2 -> a3 -> m c)+(<===<) fbc fab a1 a2 a3 = fbc =<< fab a1 a2 a3++---------+-- API --+---------++-- getBoards+getBoards :: Credentials -> IO [BoardShort]+getBoards = _either2fail <=< getBoardsEither++getBoardsMaybe :: Credentials -> IO (Maybe [BoardShort])+getBoardsMaybe = _either2maybe <=< getBoardsEither++getBoardsEither :: Credentials -> IO (Either String [BoardShort])+getBoardsEither creds = _apiCallEither creds "/Boards/"+++-- getBoard+getBoard :: Credentials -> BoardID -> IO (Board)+getBoard = _either2fail <==< getBoardEither++getBoardMaybe :: Credentials -> BoardID -> IO (Maybe Board)+getBoardMaybe = _either2maybe <==< getBoardEither++getBoardEither :: Credentials -> BoardID -> IO (Either String Board)+getBoardEither cred (BoardID boardID) = _apiCallEither cred ("/Boards/" ++ show boardID)+++-- getCard+getCard :: Credentials -> BoardID -> CardID -> IO (Card)+getCard = _either2fail <===< getCardEither++getCardMaybe :: Credentials -> BoardID -> CardID -> IO (Maybe Card)+getCardMaybe = _either2maybe <===< getCardEither++getCardEither :: Credentials -> BoardID -> CardID -> IO (Either String Card)+getCardEither cred boardID (CardID cardID) = _boardApiCallEither cred boardID ("/GetCard/" ++ show cardID ++ "/")+++-- getBoardIdentifiers+getBoardIdentifiers :: Credentials -> BoardID -> IO (BoardIdentifierSet)+getBoardIdentifiers = _either2fail <==< getBoardIdentifiersEither++getBoardIdentifiersMaybe :: Credentials -> BoardID -> IO (Maybe BoardIdentifierSet)+getBoardIdentifiersMaybe = _either2maybe <==< getBoardIdentifiersEither++getBoardIdentifiersEither :: Credentials -> BoardID -> IO (Either String BoardIdentifierSet)+getBoardIdentifiersEither cred boardID = _boardApiCallEither cred boardID ("/GetBoardIdentifiers/")+++-- getNewerIfExists+-- NOTE that this function returns with Nothing not only when an error occures+-- but when there is no newer board than the given version.+-- This is why ``getNewerIfExists`` returns with ``Maybe Board`` already.+getNewerIfExists :: Credentials -> BoardID -> Int -> IO (Maybe Board)+getNewerIfExists = getNewerIfExistsMaybe++getNewerIfExistsMaybe :: Credentials -> BoardID -> Int -> IO (Maybe Board)+getNewerIfExistsMaybe = _either2maybe <===< getNewerIfExistsEither++getNewerIfExistsEither :: Credentials -> BoardID -> Int -> IO (Either String Board)+getNewerIfExistsEither cred boardID boardVersion = + _boardApiCallEither cred boardID ("/BoardVersion/" ++ show boardVersion ++ "/GetNewerIfExists/")+++-- getBoardHistorySince+getBoardHistorySince :: Credentials -> BoardID -> Int -> IO ([BoardHistoryItem])+getBoardHistorySince = _either2fail <===< getBoardHistorySinceEither++getBoardHistorySinceMaybe :: Credentials -> BoardID -> Int -> IO (Maybe [BoardHistoryItem])+getBoardHistorySinceMaybe = _either2maybe <===< getBoardHistorySinceEither++getBoardHistorySinceEither :: Credentials -> BoardID -> Int -> IO (Either String [BoardHistoryItem])+getBoardHistorySinceEither cred boardID boardVersion =+ _boardApiCallEither cred boardID ("/BoardVersion/" ++ show boardVersion ++ "/GetBoardHistorySince/")+++-- getCardByExternalId+getCardByExternalId :: Credentials -> BoardID -> String -> IO (Card)+getCardByExternalId = _either2fail <===< getCardByExternalIdEither++getCardByExternalIdMaybe :: Credentials -> BoardID -> String -> IO (Maybe Card)+getCardByExternalIdMaybe = _either2maybe <===< getCardByExternalIdEither++getCardByExternalIdEither :: Credentials -> BoardID -> String -> IO (Either String Card)+getCardByExternalIdEither cred boardID externalID = _boardApiCallEither cred boardID ("/GetCardByExternalId/" ++ show externalID ++ "/")+++-- getBackLog+getBackLog :: Credentials -> BoardID -> IO ([Lane])+getBackLog = _either2fail <==< getBackLogEither++getBackLogMaybe :: Credentials -> BoardID -> IO (Maybe [Lane])+getBackLogMaybe = _either2maybe <==< getBackLogEither++getBackLogEither :: Credentials -> BoardID -> IO (Either String [Lane])+getBackLogEither cred boardID = _boardApiCallEither cred boardID "/Backlog/"+++-- getArchive+getArchive :: Credentials -> BoardID -> IO ([LaneLayout])+getArchive = _either2fail <==< getArchiveEither++getArchiveMaybe :: Credentials -> BoardID -> IO (Maybe [LaneLayout])+getArchiveMaybe = _either2maybe <==< getArchiveEither++getArchiveEither :: Credentials -> BoardID -> IO (Either String [LaneLayout])+getArchiveEither cred boardID = _boardApiCallEither cred boardID "/Archive/"+++-- getCardHistory+getCardHistory :: Credentials -> BoardID -> CardID -> IO ([CardHistoryItem])+getCardHistory = _either2fail <===< getCardHistoryEither++getCardHistoryMaybe :: Credentials -> BoardID -> CardID -> IO (Maybe [CardHistoryItem])+getCardHistoryMaybe = _either2maybe <===< getCardHistoryEither++getCardHistoryEither :: Credentials -> BoardID -> CardID -> IO (Either String [CardHistoryItem])+getCardHistoryEither cred (BoardID boardID) (CardID cardID) = + _apiCallEither cred ("/Card/History/" ++ show boardID ++ "/" ++ show cardID ++ "/")+++-- getCardComments+getCardComments :: Credentials -> BoardID -> CardID -> IO ([CardComment])+getCardComments = _either2fail <===< getCardCommentsEither++getCardCommentsMaybe :: Credentials -> BoardID -> CardID -> IO (Maybe [CardComment])+getCardCommentsMaybe = _either2maybe <===< getCardCommentsEither++getCardCommentsEither :: Credentials -> BoardID -> CardID -> IO (Either String [CardComment])+getCardCommentsEither cred (BoardID boardID) (CardID cardID) = + _apiCallEither cred ("/Card/GetComments/" ++ show boardID ++ "/" ++ show cardID ++ "/")+++-------------+-- PRIVATE --+-------------++_either2fail :: FromJSON a => Either String a -> IO a+_either2fail (Left err) = fail err+_either2fail (Right res) = return res++_either2maybe :: FromJSON a => Either String a -> IO (Maybe a)+_either2maybe (Left err) = return Nothing+_either2maybe (Right res) = return $ Just res++_boardApiCallEither :: FromJSON a => Credentials -> BoardID -> String -> IO (Either String a)+_boardApiCallEither cred (BoardID boardID) urlfrag = + _apiCallEither ((cred)) ("/Board/" ++ show boardID ++ urlfrag) + +_apiCallEither :: FromJSON a => Credentials -> String -> IO (Either String a)+_apiCallEither creds url = parseReplyData <$> _loadPath url creds++_loadPath :: String -> Credentials -> IO ByteString+_loadPath lpath cred = do+ (_, body) <- curlGetString_ url opts+ return body+ where+ url = "http://" ++ (_company cred) ++ ".leankitkanban.com/Kanban/Api" ++ lpath+ opts = [CurlUserPwd authstr]+ authstr = _username cred ++ ":" ++ _password cred
+ Leankit/Types.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}++module Leankit.Types where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson++import Data.ByteString.Lazy (ByteString)++data Reply datatype = Reply {+ _replyCode :: Int,+ _replyText :: String,+ _replyData :: [Maybe datatype]+} deriving (Eq, Show)++instance FromJSON datatype => FromJSON (Reply datatype) where+ parseJSON (Object v) = Reply + <$> v .: "ReplyCode" + <*> v .: "ReplyText"+ <*> v .: "ReplyData"+ parseJSON _ = mzero++parseReply :: FromJSON a => ByteString -> Either String (Reply a)+parseReply = eitherDecode++parseReplyData :: FromJSON a => ByteString -> Either String a+parseReplyData json = + case reply of+ Left s -> Left s+ Right repl -> case _replyData repl of+ [] -> Left $ errorMsg repl+ (Nothing:[]) -> Left $ errorMsg repl+ (Just rdata:[]) -> Right $ rdata+ (xs) -> Left $ errorMsg repl ++ " (multiple items in result data)"+ where + reply = parseReply json+ errorMsg repl = show (_replyCode repl) ++ ": " ++ _replyText repl
+ Leankit/Types/AssignedUser.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.AssignedUser where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson+import Data.Aeson.TH++import Leankit.Types.Common+import Leankit.Types.TH+++data AssignedUser = AssignedUser {+ _id :: UserID,+ _emailAddress :: Maybe String,+ _fullName :: Maybe String,++ _gravatarLink :: Maybe String,+ _smallGravatarLink :: Maybe String,++ _assignedUserName :: Maybe String,+ _assignedUserId :: Maybe UserID+} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''AssignedUser)
+ Leankit/Types/Board.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.Board where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson.TH++import Leankit.Types.Common+import Leankit.Types.User+import Leankit.Types.Lane++import Leankit.Types.TH++data Board = Board {+ _active :: Maybe Bool,+ _title :: Maybe String,+ _prefix :: Maybe String,+ _description :: Maybe String,++ _version :: Maybe Int,++ _excludeCompletedAndArchiveViolations :: Maybe Bool,+ _isCardIdEnabled :: Maybe Bool,+ _isHyperlinkEnabled :: Maybe Bool,+ _isPrefixEnabled :: Maybe Bool,+ _isPrefixIncludedInHyperlink :: Maybe Bool,+ _isPrivate :: Maybe Bool,+ _isWelcome :: Maybe Bool,+ _classOfServiceEnabled :: Maybe Bool,+ _archiveTopLevelLaneId :: Maybe Int,++ _organizationId :: Maybe OrganizationID,+ _cardColorField :: Maybe String,+ _maxFileSize :: Maybe Int,+ _format :: Maybe String,++ _boardUsers :: [User],+ _currentUserRole :: Maybe Int,+ _topLevelLaneIds :: [LaneID],+ _lanes :: [Lane]+} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''Board)
+ Leankit/Types/BoardHistoryItem.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.BoardHistoryItem where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson.TH++import Leankit.Types.TH+import Leankit.Types.Common+++data BoardHistoryItem = BoardHistoryItem {+ _eventType :: Maybe String,+ _eventDateTime :: Maybe String,++ _cardId :: Maybe CardID,+ _userId :: Maybe UserID,+ _assignedUserId :: Maybe UserID,+ _fromLaneId :: Maybe LaneID,+ _toLaneId :: Maybe LaneID,++ _message :: Maybe String,+ _commentText :: Maybe String,+ _blockedComment :: Maybe String,+ _wipOverrideUser :: Maybe Int,+ _wipOverrideLane :: Maybe Int,+ _wipOverrideComment :: Maybe String,++ _isUnassigning :: Maybe Bool,+ _isBlocked :: Maybe Bool,+ _requiresBoardRefresh :: Maybe Bool+} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''BoardHistoryItem)
+ Leankit/Types/BoardIdentifierSet.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.BoardIdentifierSet where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson.TH++import Leankit.Types.TH+import Leankit.Types.Common+import Leankit.Types.LaneShort+++data BoardIdentifier a = BoardIdentifier {+ _id :: a,+ _name :: String+} deriving (Eq, Show)++data BoardIdentifierSet = BoardIdentifierSet {+ _boardId :: BoardID,++ _lanes :: [LaneShort],+ _laneType :: [BoardIdentifier LaneTypeID],+ _laneClassType :: [BoardIdentifier LaneClassTypeID],++ _cardTypes :: [BoardIdentifier CardTypeID],+ _boardUsers :: [BoardIdentifier UserID],+ _priorities :: [BoardIdentifier PriorityID]+-- _classesOfService :: Something -- TODO+-- _boardStatistics :: Something -- TODO+} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''BoardIdentifier)+$(deriveFromJSON parseOptions ''BoardIdentifierSet)
+ Leankit/Types/BoardShort.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.BoardShort where++import Data.Aeson.TH++import Leankit.Types.TH+import Leankit.Types.Common++data BoardShort = BoardShort {+ _id :: BoardID,+ _title :: Maybe String,+ _description :: Maybe String,++ _isArchived :: Maybe Bool,+ _isBreakoutBoard :: Maybe Bool,+ _isPrivate :: Maybe Bool,++ _parentId :: Maybe Int,+ _creationDate :: Maybe Date,++ _drillThroughBoards :: [BoardShort]+-- _breakoutBoards :: [Something], -- TODO+} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''BoardShort)
+ Leankit/Types/Card.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.Card where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson+import Data.Aeson.TH+import Data.Aeson.Types+import Data.Colour+import Data.Colour.SRGB+import Data.List.Split++import Leankit.Types.TH+import Leankit.Types.Common+import Leankit.Types.AssignedUser (AssignedUser)+import Leankit.Types.CardContext (CardContext)+++-- TODO clumsy, why do I need a separate data type??+newtype Tags = Tags [String] deriving (Eq, Show)+instance FromJSON Tags where+ parseJSON Null = return $ Tags []+ parseJSON v = toTags <$> parseJSON v where+ toTags = Tags . (splitOn ",")+++data Card = Card {+ _id :: Int,+ _version :: Maybe Int,++ -- _type :: Something, -- TODO+ _typeId :: Maybe Int,+ _typeName :: Maybe String,+ _typeColorHex :: Maybe Color,+ _typeIconPath :: Maybe String,++ _title :: Maybe String,+ _description :: Maybe String,+ _tags :: Tags,+ _dueDate :: Maybe Date,+ _size :: Maybe Int,+ _priority :: Maybe Int,+ _priorityText :: Maybe String,+ _color :: Maybe Color,++ _laneId :: Maybe Int,+ _parentCardId :: Maybe CardID,+ _gravatarLink :: Maybe String,+ _smallGravatarLink :: Maybe String,++ _active :: Maybe Bool,+ _index :: Maybe Int,+ _taskBoardCompletionPercent :: Maybe Int,+ _classOfServiceId :: Maybe Int,+ _classOfServiceTitle :: Maybe String,+ _classOfServiceColorHex :: Maybe Color,+ _classOfServiceIconPath :: Maybe String,+ _currentTaskBoardId :: Maybe BoardID,+ _systemType :: Maybe String,+ _currentContext :: Maybe String,+ _cardContexts :: Maybe [CardContext], -- ?+ --_taskBoardTotalCards :: [Something], -- TODO+ _blockReason :: Maybe String,+ _blockStateChangeDate :: Maybe String,++ _assignedUsers :: [AssignedUser],+ _assignedUserIds :: [UserID],++ _externalCardID :: Maybe String,+ _externalSystemName :: Maybe String,+ _externalSystemUrl :: Maybe String,++ _drillThroughBoardId :: Maybe BoardID,+ _drillThroughCompletionPercent :: Maybe Int,+ _drillThroughProgressComplete :: Maybe Int,+ _drillThroughProgressTotal :: Maybe String,++ _lastAttachment :: Maybe String,+ _lastActivity :: Maybe DateTime,+ _lastMove :: Maybe DateTime,+ _lastComment :: Maybe String,+ _commentsCount :: Maybe Int,+ _dateArchived :: Maybe Date,+ _attachmentsCount :: Maybe Int,+ _countOfOldCards :: Maybe Int,++ _hasDrillThroughBoard :: Maybe Bool,+ _isBlocked :: Maybe Bool++} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''Card)
+ Leankit/Types/CardComment.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.CardComment where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson.TH++import Leankit.Types.TH+import Leankit.Types.Common+++data CardComment = CardComment {+ _id :: CardCommentID,++ _postDate :: Maybe DateTime,+ _postedById :: Maybe UserID,+ _postedByFullName :: Maybe String,+ _postedByGravatarLink :: Maybe String, -- TODO gravatar link++ _text :: Maybe String,++ _taggedUsers :: Maybe [String], -- TODO what's this?+ _editable :: Maybe Bool+} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''CardComment)
+ Leankit/Types/CardContext.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.CardContext where++import Control.Applicative ((<$>), (<*>))+import Data.Aeson+import Data.Aeson.TH++import Leankit.Types.Common+import Leankit.Types.TH+++data CardContext = CardContext {+ _id :: CardContextID,+ _name :: Maybe String,++ _taskBoardId :: Maybe BoardID,++ _totalSize :: Int,+ _totalCards :: Int,+ _completedCardCount :: Int,+ _completedCardSize :: Int,+ _progressPercentage :: Int+} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''CardContext)
+ Leankit/Types/CardHistoryItem.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}++module Leankit.Types.CardHistoryItem where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson++import Leankit.Types.Common+++data CardHistoryItem = CardHistoryItem {+ _cardId :: CardID,+ _overrideType :: Maybe String, -- TODO what's this?+ _taskboardContainingCardId :: Maybe CardID,+ _userName :: Maybe String,+ _cardTitle :: Maybe String,+ _gravatarLink :: Maybe String,+ _timeDifference :: Maybe String,+ _dateTime :: Maybe DateTime,+ _lastDate :: Maybe Integer, -- TODO should be converted to datetime...+ _type :: Maybe String,+ _taskboardContainingCardTitle :: Maybe String,+ _userFullName :: Maybe String,+ _toLaneId :: Maybe LaneID,+ _toLaneTitle :: Maybe String,++ _details :: CardHistoryDetails+} deriving (Eq, Show)++instance FromJSON CardHistoryItem where+ parseJSON (Object v) = CardHistoryItem+ <$> v .: "CardId"+ <*> v .:? "OverrideType"+ <*> v .:? "TaskboardContainingCardId"+ <*> v .:? "UserName"+ <*> v .:? "CardTitle"+ <*> v .:? "GravatarLink"+ <*> v .:? "TimeDifference"+ <*> v .:? "DateTime"+ <*> v .:? "LastDate"+ <*> v .:? "Type"+ <*> v .:? "TaskboardContainingCardTitle"+ <*> v .:? "UserFullName"+ <*> v .:? "ToLaneId"+ <*> v .:? "ToLaneTitle"+ <*> parseJSON (Object v)+ parseJSON _ = mzero+++-- ===============+-- CardFieldChange++data CardFieldChange = CardFieldChange {+ _fieldName :: String,+ _newValue :: String,+ _oldValue :: Maybe String,+ _newDueDate :: Maybe String,+ _oldDueDate :: Maybe String+} deriving (Eq, Show)++instance FromJSON CardFieldChange where+ parseJSON (Object v) = do CardFieldChange+ <$> v .: "FieldName"+ <*> v .: "NewValue"+ <*> v .:? "OldValue"+ <*> v .:? "NewDueDate"+ <*> v .:? "OldDueDate"+++-- ==================+-- CardHistoryDetails++data CardHistoryDetails = CardCreateEventDetails |+ CardMoveEventDetails {+ _fromLaneId :: LaneID,+ _fromLaneTitle :: Maybe String+ } |+ UserAssignmentEventDetails {+ _assignedUserId :: UserID,+ _assignedUserEmailAddress :: Maybe String,+ _assignedUserFullName :: Maybe String+ } |+ CardFieldChangedEventDetails {+ _changes :: [CardFieldChange]+ } |+ UnknownEventDetails + deriving (Eq, Show)+++instance FromJSON CardHistoryDetails where+ parseJSON (Object v) = do+ itemType <- v .: "Type"+ case (itemType :: String) of -- TODO is this the proper place to give the type signature?+ "CardCreationEventDTO" -> return CardCreateEventDetails+ "CardMoveEventDTO" -> CardMoveEventDetails + <$> v .: "FromLaneId"+ <*> v .:? "FromLaneTitle"+ "UserAssignmentEventDTO" -> UserAssignmentEventDetails + <$> v .: "AssignedUserId"+ <*> v .:? "AssignedUserEmailAddres" -- TYPO!!!+ <*> v .:? "AssignedUserFullName"+ "CardFieldsChangedEventDTO" -> CardFieldChangedEventDetails+ <$> v .: "Changes"+ _ -> return UnknownEventDetails -- fallback
+ Leankit/Types/Common.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}+module Leankit.Types.Common where++import Control.Applicative ((<$>), pure)+import Data.Aeson.Types+import Data.Attoparsec.Number+import Data.Colour+import Data.Colour.SRGB++type Date = String+type DateTime = String++-- TODO use some template haskell magic to generate these stuff++newtype BoardID = BoardID Int deriving (Eq, Show)+instance FromJSON BoardID where+ parseJSON v = BoardID <$> parseJSON v++newtype OrganizationID = OrganizationID Int deriving (Eq, Show)+instance FromJSON OrganizationID where+ parseJSON v = OrganizationID <$> parseJSON v++newtype UserID = UserID Int deriving (Eq, Show)+instance FromJSON UserID where+ parseJSON v = UserID <$> parseJSON v++newtype LaneID = LaneID Int deriving (Eq, Show)+instance FromJSON LaneID where+ parseJSON v = LaneID <$> parseJSON v++newtype CardID = CardID Int deriving (Eq, Show)+instance FromJSON CardID where+ parseJSON v = CardID <$> parseJSON v++newtype CardContextID = CardContextID Int deriving (Eq, Show)+instance FromJSON CardContextID where+ parseJSON v = CardContextID <$> parseJSON v++newtype CardCommentID = CardCommentID Int deriving (Eq, Show)+instance FromJSON CardCommentID where+ parseJSON v = CardCommentID <$> parseJSON v++newtype CardTypeID = CardTypeID Int deriving (Eq, Show)+instance FromJSON CardTypeID where+ parseJSON v = CardTypeID <$> parseJSON v++newtype Color = Color (Colour Double) deriving (Eq, Show)+instance FromJSON Color where+ parseJSON (String "") = parseJSON (String "#FFFFFF")+ parseJSON v = (Color . sRGB24read) <$> parseJSON v+ -- TODO clumsy... Empty string should be Nothing at the end of the day++newtype LaneClassTypeID = LaneClassTypeID Int deriving (Eq, Show)+instance FromJSON LaneClassTypeID where+ parseJSON v = LaneClassTypeID <$> parseJSON v++newtype LaneTypeID = LaneTypeID Int deriving (Eq, Show)+instance FromJSON LaneTypeID where+ parseJSON v = LaneTypeID <$> parseJSON v++newtype PriorityID = PriorityID Int deriving (Eq, Show)+instance FromJSON PriorityID where+ parseJSON v = PriorityID <$> parseJSON v+
+ Leankit/Types/Credentials.hs view
@@ -0,0 +1,10 @@+module Leankit.Types.Credentials where++data Credentials = Credentials {+ _company :: String,+ _username :: String,+ _password :: String+}++instance Show Credentials where+ show cred = "Credentials " ++ _company cred ++ " " ++ _username cred ++ " *****"
+ Leankit/Types/Lane.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.Lane where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson.TH++import Leankit.Types.TH+import Leankit.Types.Common+import Leankit.Types.Card (Card)+++data Lane = Lane {+ _id :: LaneID,+ _type :: Maybe Int,+ _title :: Maybe String,+ _description :: Maybe String,+ _active :: Maybe Bool,++ _index :: Maybe Int,+ _laneState :: Maybe String,+ _classType :: Maybe Int,+ _width :: Maybe Int,+ _cardLimit :: Maybe Int,+ _orientation :: Maybe Int,+ _isDrillthroughDoneLane :: Maybe Bool,++ _cards :: [Card],++ _cardContextId :: Maybe Int,+ _activityId :: Maybe Int,+ _taskBoardId :: Maybe BoardID,++ _parentLaneId :: Maybe Int,+ _siblingLaneIds :: [LaneID],+ _activityName :: Maybe String,+ _childLaneIds :: [LaneID]++} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''Lane)
+ Leankit/Types/LaneLayout.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.LaneLayout where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson.TH++import Leankit.Types.TH+import Leankit.Types.Common+import Leankit.Types.Lane (Lane)+++data LaneLayout = LaneLayout {+ _lane :: Maybe Lane,+ _parentLane :: Maybe Lane,+ _childLanes :: [Lane]+ -- _dom :: Something -- TODO+} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''LaneLayout)
+ Leankit/Types/LaneShort.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.LaneShort where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson.TH++import Leankit.Types.TH+import Leankit.Types.Common+import Leankit.Types.Card (Card)+++data LaneShort = LaneShort {+ _id :: LaneID,+ _name :: Maybe String,+ _type :: LaneTypeID,++ _classType :: LaneClassTypeID,+ _laneClassType :: LaneClassTypeID, -- TODO ???++ _activityId :: Maybe Int,+ _parentLaneId :: Maybe LaneID,+ _topLevelParentLaneId :: Maybe LaneID,++ _cardLimit :: Int,+ _index :: Int+} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''LaneShort)
+ Leankit/Types/TH.hs view
@@ -0,0 +1,13 @@+module Leankit.Types.TH where++import Data.Char+import Data.Aeson.Types+++key2field :: String -> String+key2field [] = []+key2field "_wip" = "WIP"+key2field ('_':x:xs) = ((toUpper x) : xs)+key2field fn = undefined -- fail $ "Invalid fieldname" ++ fn++parseOptions = defaultOptions{fieldLabelModifier=key2field}
+ Leankit/Types/User.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Leankit.Types.User where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson.TH++import Leankit.Types.TH+import Leankit.Types.Common+++data User = User {+ _id :: UserID,+ _userName :: String,+ _fullName :: Maybe String,+ _emailAddress :: Maybe String,++ _gravatarFeed :: Maybe String,+ _gravatarLink :: Maybe String,++ _role :: Maybe Int,+ _roleName :: Maybe String,++ _enabled :: Maybe Bool,+ _isAccountOwner :: Maybe Bool,+ _isDeleted :: Maybe Bool,++ _dateFormat :: Maybe String,+-- _settings :: Something, -- TODO+ _wip :: Maybe Int+} deriving (Eq, Show)++$(deriveFromJSON parseOptions ''User)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ leankit-api.cabal view
@@ -0,0 +1,40 @@+Name: leankit-api+Version: 0.1+Synopsis: LeanKit API+Description: A lightweight API for LeanKit (http:\/\/leankit.com)+License: MIT+License-file: LICENSE+Author: Daniel Torok+Maintainer: daniel.torok@prezi.com+Category: API+Build-Type: Simple+Cabal-Version: >= 1.6++Source-repository head+ Type: git+ Location: https://github.com/dtorok/leankit-hsapi++Library+ Build-Depends: base >= 4 && < 5,+ curl,+ split+ Exposed-modules: Leankit.Api+ Leankit.Types+ Leankit.Types.AssignedUser+ Leankit.Types.Board+ Leankit.Types.BoardHistoryItem+ Leankit.Types.BoardIdentifierSet+ Leankit.Types.BoardShort+ Leankit.Types.Card+ Leankit.Types.CardComment+ Leankit.Types.CardContext+ Leankit.Types.CardHistoryItem+ Leankit.Types.Common+ Leankit.Types.Credentials+ Leankit.Types.Lane+ Leankit.Types.LaneLayout+ Leankit.Types.LaneShort+ Leankit.Types.TH+ Leankit.Types.User+ extensions: OverloadedStrings+ ghc-options: -Wall