Redmine (empty) → 0.0.3
raw patch · 7 files changed
Files
- LICENSE +21/−0
- Redmine.cabal +38/−0
- Setup.lhs +6/−0
- src/Redmine/Get.hs +383/−0
- src/Redmine/Manager.hs +28/−0
- src/Redmine/Types.hs +230/−0
- testsuite/testGet.hs +18/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2014 Charles St-Pierre++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.
+ Redmine.cabal view
@@ -0,0 +1,38 @@+name: Redmine+version: 0.0.3+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: "LICENSE"+maintainer: charles.stpierre@gmail.com+synopsis: Library to access Redmine's REST services+description: Library to access Redmine's REST services+author: Charles St-Pierre+category: Network, Web+homepage: https://github.com/lookunder/RedmineHs+data-dir: ""++source-repository head+ type: git+ location: https://github.com/lookunder/RedmineHs.git++Library+ default-language: Haskell2010+ build-depends: base >=2 && <5, old-locale -any,+ time -any, old-time -any, bytestring -any, http-conduit >= 2.1.0,+ aeson -any, HTTP -any, network -any, text,+ transformers, containers, http-client-tls,+ resourcet, connection, MissingH+ exposed-modules: Redmine.Types, Redmine.Manager, Redmine.Get+ buildable: True+ hs-source-dirs: src++test-suite test-Redmine+ default-language: Haskell2010+ build-depends: base >=2 && <5, HUnit, text, MissingH, resourcet, transformers, old-locale, time,+ http-conduit >= 2.1.0, http-client-tls, connection, network, bytestring, aeson, containers+ type: exitcode-stdio-1.0+ main-is: testGet.hs+ buildable: True+ cpp-options: -DMAIN_FUNCTION=main+ hs-source-dirs: testsuite, src
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ src/Redmine/Get.hs view
@@ -0,0 +1,383 @@+{-# LANGUAGE OverloadedStrings #-}++module Redmine.Get ( getTimeEntries+ , getTimeEntriesForIssue+ , getIssue+ , getIssues+ , getProjects+ , getProjectForId+ , getProject+ , getVersions+ , getUser+ , expandOptions+ , increaseQueryRange+ ) where++import Data.Aeson+import Data.Maybe+import Data.Monoid+import qualified Data.Map as Map+import Data.Tuple+import Redmine.Types+import Redmine.Manager+import Control.Applicative ((<$>), (<*>), pure)+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import Network+import Network.Connection (TLSSettings (..))+import Network.HTTP.Conduit+import Network.HTTP.Client.TLS+import Network.HTTP.Client.Conduit (defaultManagerSettings)+import Data.Time.Format (parseTime)+import Data.Time.Clock (UTCTime)+import Data.Time.Calendar (Day)+import System.Locale (defaultTimeLocale)+import Control.Monad (liftM)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Resource+import Data.String.Utils+import Debug.Trace+import qualified Data.Text as T++parseRHTime :: String -> Maybe UTCTime+parseRHTime = parseTime defaultTimeLocale "%FT%X%QZ"++parseShortTime :: String -> Maybe Day+parseShortTime = parseTime defaultTimeLocale "%F"++queryRedmine :: RedmineMng -> S.ByteString -> IO L.ByteString+queryRedmine mng req = do+ request <- creerRqt mng req+ let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing+ response <- withManagerSettings settings $ httpLbs request+ return $ responseBody response++creerRqt :: RedmineMng -> S.ByteString -> IO Request+creerRqt (RedmineMng h) r = parseUrl $ S8.unpack (h <> r)+creerRqt (RedmineMngWithProxy h u p) r = fmap (addProxy u p) (creerRqt (RedmineMng h) r)+creerRqt (RedmineMngWithAuth h l pass) r = fmap (applyBasicAuth l pass) (creerRqt (RedmineMng h) r)+creerRqt (RedmineMngWithAuthAndProxy h l pass u p) r = fmap (applyBasicAuth l pass) (creerRqt (RedmineMngWithProxy h u p) r)++type ParamRest = Map.Map S.ByteString S.ByteString++-- Remplace par urlEncodedBody+expandOptions :: ParamRest -> S.ByteString+expandOptions = Map.foldrWithKey (\k a res -> res <> k <> "=" <> a <> "&") "?"++bsAInt :: S.ByteString -> Int+bsAInt = read . S8.unpack++increaseQueryRange :: ParamRest -> ParamRest+increaseQueryRange param =+ let offset = bsAInt $ Map.findWithDefault "0" "offset" param+ limit = bsAInt $ Map.findWithDefault "100" "limit" param+ nouvelOffset = offset + limit+ in Map.insert "offset" (S8.pack $ show nouvelOffset) param++-- Réécrire avec les autres modes+queryRedmineAvecOptions :: (FromJSON a, Monoid a, Collection a) =>+ RedmineMng -> S.ByteString -> ParamRest -> Manager -> IO( Maybe a)+queryRedmineAvecOptions redmineMng req param mng = -- MaybeT IO $ withSocketsDo $+ do+ request <- creerRqt redmineMng (req <> expandOptions param)+ --traceM (S8.unpack $ (req <> (expandOptions param)))+ let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing+ response <- withManagerSettings settings $ httpLbs request+ parsedRes <- debugResult . eitherDecode . responseBody $ response+ --putStrLn $ show parsedRes+ case parsedRes of+ Just a | 0 == longueur a -> return $ Just a+ | otherwise ->+ do let hausse = increaseQueryRange param+ --traceM . show $ hausse+ reste <- queryRedmineAvecOptions redmineMng req hausse mng+ case reste of+ Just b -> return . Just $ mappend a b+ Nothing -> return $ Just a+ --return (reste >>= (\b -> Just $ mappend a b ))++ Nothing -> return Nothing++-- |The function 'debugResult' is used to print the parsing error statement+-- and continue the processing.+debugResult :: Either String a -> IO(Maybe a)+debugResult res = case res of+ Left msg -> putStrLn msg >> return Nothing+ Right v -> return (Just v)++runQuery :: FromJSON a => RedmineMng -> S.ByteString -> IO( Maybe a)+runQuery mng requete = do -- withSocketsDo $ do+ toto <- queryRedmine mng requete+ (debugResult . eitherDecode) toto++initOpt = Map.fromList [("offset","0"), ("limit","100")]++-- |The function 'getTimeEntries' fetches all the time entries.+-- They can be filtered by spenton date using spent_on=%3E%3C2013-05-01|2013-05-31+getTimeEntries :: RedmineMng -> ParamRest -> MaybeT IO [TimeEntry]+getTimeEntries mng param = MaybeT $ do+ mngConn <- newManager tlsManagerSettings+ res <- queryRedmineAvecOptions mng requete ( Map.union param initOpt) mngConn+ return $ fmap time_entries res+ where requete = "/time_entries.json"++getTimeEntriesForIssue :: RedmineMng -> Integer-> MaybeT IO [TimeEntry]+getTimeEntriesForIssue mng issueid = MaybeT $ do+ mngConn <- newManager tlsManagerSettings+ res <- queryRedmineAvecOptions mng requete initOpt mngConn+ return $ fmap time_entries res+ where requete = "/time_entries/" <> S8.pack (show issueid) <> ".json"++getIssues :: RedmineMng -> ParamRest -> MaybeT IO [Issue]+getIssues mng param = MaybeT $ do+ mngConn <- liftIO $ newManager tlsManagerSettings+ res <- queryRedmineAvecOptions mng requete ( Map.union param initOpt) mngConn+ return $ fmap issues res+ where requete = "/issues.json"++getIssue :: RedmineMng -> Integer -> ParamRest -> MaybeT IO Issue+getIssue mng elemId param =+ fmap issue (MaybeT $ runQuery mng requete)+ where requete = "/issues/" <> S8.pack (show elemId) <> ".json" <> expandOptions param++getProjects :: RedmineMng -> MaybeT IO [Project]+getProjects mng = MaybeT $ do+ mngConn <- newManager tlsManagerSettings+ res <- queryRedmineAvecOptions mng requete initOpt mngConn+ return $ fmap projects res+ where requete = "/projects.json"++getProjectForId :: RedmineMng -> Integer -> MaybeT IO Project+getProjectForId mng elemId =+ MaybeT $ runQuery mng requete+ where requete = rmhost mng <> "/projects/" <> S8.pack (show elemId) <> ".json"++getProject :: RedmineMng -> S.ByteString -> MaybeT IO Project+getProject mng projId =+ MaybeT $ runQuery mng requete+ where requete = "/projects/" <> projId <> ".json"++--Get all the versions associated to a project+getVersions :: RedmineMng --The connection manager+ -> S.ByteString --The project+ -> MaybeT IO [Version]+getVersions mng proj =+ fmap versions (MaybeT $ runQuery mng requete)+ where requete = "/projects/" <> proj <> "/versions.json"++getVersion:: RedmineMng -> Integer -> ParamRest -> MaybeT IO Version+getVersion mng elemId param =+ fmap version (MaybeT $ runQuery mng requete)+ where requete = "/versions/" <> S8.pack (show elemId) <> ".json" <> expandOptions param++getUser :: RedmineMng -> Integer -> MaybeT IO User+getUser mng elemId =+ do let requete = "/users/" <> S8.pack (show elemId) <> ".json"+ MaybeT $ runQuery mng requete++instance FromJSON ObjRef where+ parseJSON (Object v) =+ ObjRef <$> (v .: "id")+ <*> (v .: "name")++instance FromJSON ObjID where+ parseJSON (Object v) =+ ObjID <$> (v .: "id")++instance FromJSON IssuesRsp where+ parseJSON (Object v) = IssuesRsp <$> (v .: "issues")++instance FromJSON IssueRsp where+ parseJSON (Object v) = IssueRsp <$> (v .: "issue")++instance FromJSON Issue where+ parseJSON (Object v) =+ Issue <$> (v .: "id")+ <*> (v .: "project")+ <*> (v .:? "parent")+ <*> (v .: "tracker")+ <*> (v .: "status")+ <*> (v .: "priority")+ <*> (v .: "author")+ <*> (v .:? "assigned_to")+ <*> (v .:? "category")+ <*> (v .: "fixed_version")+ <*> (v .: "subject")+ <*> (v .: "description")+ <*> liftM (parseShortTime . fromMaybe "") (v .:? "start_date")+ <*> liftM (parseShortTime . fromMaybe "") (v .:? "due_date")+ <*> (v .: "done_ratio")+ <*> (v .:? "estimated_hours")+ <*> (v .:? "spent_hours")+ <*> (v .:? "custom_fields")+ <*> liftM parseRHTime (v .: "created_on")+ <*> liftM parseRHTime (v .: "updated_on")+ <*> (v .:? "journals")+ <*> (v .:? "attachements")+ <*> (v .:? "changesets")+ <*> (v .:? "watchers")+ <*> (v .:? "relations")+ <*> (v .:? "children")+++instance FromJSON Child where+ parseJSON (Object v) =+ Child <$> (v .: "id")+ <*> (v .: "tracker")+ <*> (v .: "subject")++instance FromJSON Attachement where+ parseJSON (Object v) =+ Attachement <$> (v .: "id")+ <*> (v .: "filename")+ <*> (v .: "filesize")+ <*> (v .: "content_type")+ <*> (v .: "description")+ <*> (v .: "content_url")+ <*> (v .: "author_name")+ <*> liftM (fromJust.parseRHTime) (v .: "created_on")++instance FromJSON ChangeSet where+ parseJSON (Object v) =+ ChangeSet <$> (v .: "revision")+ <*> (v .: "user")+ <*> (v .: "comments")+ <*> liftM (fromJust.parseRHTime) (v .: "committed_on")++instance FromJSON Watcher where+ parseJSON (Object v) =+ Watcher <$> (v .: "id")+ <*> (v .: "name")++instance FromJSON CustomField where+ parseJSON (Object v) =+ CustomField <$> (v .: "id") <*> (v .: "name") <*> (v .: "value")++instance FromJSON Journal where+ parseJSON (Object v) =+ Journal <$> (v .: "id")+ <*> (v .: "user")+ <*> (v .:? "notes" .!= "")+ <*> liftM parseRHTime (v .: "created_on")+ <*> (v .: "details")++instance FromJSON Detail where+ parseJSON (Object v) =+ Detail <$> (v .: "property")+ <*> (v .: "name")+ <*> (v .:? "old_value")+ <*> (v .: "new_value")++instance FromJSON ProjectsRsp where+ parseJSON (Object v) = ProjectsRsp <$> (v .: "projects")++instance FromJSON Project where+ parseJSON (Object v) =+ Project <$> (v .: "id")+ <*> (v .: "name")+ <*> (v .: "identifier")+ <*> (v .: "description")+ <*> (v .:? "custom_fields")+ <*> liftM parseRHTime (v .: "created_on")+ <*> liftM parseRHTime (v .: "updated_on")++instance FromJSON TimeEntriesRsp where+ parseJSON (Object v) = TimeEntriesRsp <$> (v .: "time_entries")++instance FromJSON TimeEntry where+ parseJSON (Object v) =+ TimeEntry <$> (v .: "id")+ <*> (v .: "project")+ <*> (v .: "issue")+ <*> (v .: "user")+ <*> (v .:? "activity")+ <*> (v .:? "hours")+ <*> (v .: "comments")+ <*> liftM parseRHTime (v .: "created_on")+ <*> liftM parseRHTime (v .: "updated_on")+ <*> liftM (parseShortTime . fromMaybe "") (v .:? "spent_on")++instance FromJSON VersionsRsp where+ parseJSON (Object v) = VersionsRsp <$> (v .: "versions")++instance FromJSON VersionRsp where+ parseJSON (Object v) = VersionRsp <$> (v .: "version")++instance FromJSON Day where+ parseJSON = withText "Day" $ \t ->+ case parseTime defaultTimeLocale "%F" (T.unpack t) of+ Just d -> pure d+ _ -> fail "could not parse ISO-8601 date"++instance FromJSON Version where+ parseJSON (Object v) =+ Version <$> (v .: "id")+ <*> (v .: "name")+ <*> (v .: "project")+ <*> (v .: "description")+ <*> (v .: "status")+ <*> (v .: "sharing")+ --FIXME avoid parsing an empty string+ <*> liftM (parseShortTime . fromMaybe "") (v .:? "due_date")+ <*> liftM parseRHTime (v .: "created_on")+ <*> liftM parseRHTime (v .: "updated_on")++instance FromJSON Relations where+ parseJSON (Object v) = Relations <$> (v .: "relations")++instance FromJSON Relation where+ parseJSON (Object v) =+ Relation <$> (v .: "id")+ <*> (v .: "issue_id")+ <*> (v .: "issue_to_id")+ <*> (v .: "relation_type")+ <*> (v .:? "delay")++instance FromJSON Roles where+ parseJSON (Object v) = Roles <$> (v .: "roles")++instance FromJSON Role where+ parseJSON (Object v) =+ Role <$> (v .: "id") <*> (v .: "name")++instance FromJSON Memberships where+ parseJSON (Object v) = Memberships <$> (v .: "memberships")++instance FromJSON Membership where+ parseJSON (Object v) =+ Membership <$> (v .: "id")+ <*> (v .: "project")+ <*> (v .: "user")+ <*> (v .: "roles")++instance FromJSON UsersRsp where+ parseJSON (Object v) = UsersRsp <$> (v .: "users")++instance FromJSON User where+ parseJSON (Object v) =+ User <$> (v .: "lastname")+ <*> liftM parseRHTime (v .: "created_on")+ <*> (v .: "mail")+ <*> liftM parseRHTime (v .: "last_login_on")+ <*> (v .: "firstname")+ <*> (v .: "id")++instance FromJSON Trackers where+ parseJSON (Object v) = Trackers <$> (v .: "trackers")++instance FromJSON Tracker where+ parseJSON (Object v) =+ Tracker <$> (v .: "id") <*> (v .: "name")++instance FromJSON IssueStatuses where+ parseJSON (Object v) = IssueStatuses <$> (v .: "issue_statuses")++instance FromJSON IssueStatus where+ parseJSON (Object v) =+ IssueStatus <$> (v .: "id")+ <*> (v .: "name")+ <*> (v .: "is_default")+ <*> (v .: "is_closed")+
+ src/Redmine/Manager.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module Redmine.Manager where++import Data.ByteString++-- Ajt Gestionaire de connection+data RedmineMng++ -- |Constructor to create an anonymous connection.+ = RedmineMng {rmhost::ByteString}++ -- |Constructor to create a connection throught a proxy+ | RedmineMngWithProxy { rmhost::ByteString+ , rmurlProxy::ByteString+ , rmportProxy::Int }++ -- |Constructor to create a connection with authentification+ | RedmineMngWithAuth { rmhost::ByteString+ , login::ByteString+ , passwd::ByteString }++ -- |Constructor to create a connection throught a proxy with authentification+ | RedmineMngWithAuthAndProxy { rmhost::ByteString+ , login::ByteString+ , passwd::ByteString+ , rmurlProxy::ByteString+ , rmportProxy::Int }
+ src/Redmine/Types.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE OverloadedStrings #-}++module Redmine.Types where++import Data.Time.Clock (UTCTime)+import Data.Time.Calendar (Day)+import Network.HTTP.Conduit+import Data.Monoid+import Data.Typeable+import Data.Data+import Data.Aeson+import qualified Data.Text as T++data Status = Closed | Open deriving (Eq, Show)++data VersionsRsp = VersionsRsp { versions :: [Version] } deriving (Eq,Show)++data VersionRsp = VersionRsp { version :: Version } deriving (Eq,Show)++data Version = Version { id_Version :: Integer+ , name_Version :: T.Text+ , project_Version :: ObjRef+ , desc_Version :: T.Text+ , status_Version :: T.Text+ , sharing_Version :: T.Text+ , dueDate_Version :: Maybe Day+ , createdOn_Version :: Maybe UTCTime+ , updatedOn_Version :: Maybe UTCTime+ } deriving (Eq, Show)+--ajouter offset total_cout et limit+data IssuesRsp = IssuesRsp { issues :: [Issue] } deriving (Eq,Show)++--data Parent = Parent { parent :: ObjID } deriving (Eq,Show)++data IssueRsp = IssueRsp { issue :: Issue } deriving (Eq,Show)++data Issue = Issue { id_Issue :: Integer+ , project_Issue :: ObjRef+ , parent_Issue :: Maybe ObjID --Single issue only+ , tracker_Issue :: ObjRef+ , status_Issue :: ObjRef+ , priority_Issue :: ObjRef+ , author_Issue :: ObjRef+ , assignedTo_Issue :: Maybe ObjRef+ , category_Issue :: Maybe ObjRef+ , fixedVersion_Issue :: Maybe ObjRef+ , subject_Issue :: T.Text+ , description_Issue :: T.Text+ , startDate_Issue :: Maybe Day+ , dueDate_Issue :: Maybe Day+ , doneRatio_Issue :: Int+ , estimatedHours_Issue :: Maybe Float+ , spentHours_Issue :: Maybe Float --Single issue only+ , customFields_Issue :: Maybe [CustomField]+ , createdOn_Issue :: Maybe UTCTime+ , updatedOn_Issue :: Maybe UTCTime+ , journals_Issue :: Maybe [Journal] -- Single issue only+ , attachements_Issue :: Maybe [Attachement]+ , changeSets_Issue :: Maybe [ChangeSet]+ , watchers_Issue :: Maybe [Watcher]+ , relations_Issue :: Maybe [Relation]+ , children_Issue :: Maybe [Child]+ } deriving (Eq, Show)++data ChangeSet = ChangeSet { revision_ChangeSet :: T.Text+ , user_ChangeSet :: ObjRef+ , comments_ChangeSet :: T.Text+ , committedOn_ChangeSet :: UTCTime+ } deriving (Eq, Show)++data Watcher = Watcher { id_Watcher :: Integer+ , name_Watcher :: T.Text+ } deriving (Eq, Show)++data Child = Child { id_Child :: Integer+ , tracker_Child :: ObjRef+ , subject_Tracker :: T.Text+ } deriving (Eq, Show)++data CustomField = CustomField { id_CF :: Integer+ , name_CF :: T.Text+ , value_CF :: T.Text+ } deriving (Eq,Show)++data ObjRef = ObjRef { id_ObjRef:: Integer, name_ObjRef:: T.Text } deriving (Eq, Show)++data ObjID = ObjID { id_ObjID:: Integer } deriving (Eq, Show)++data IssueStatuses = IssueStatuses { issue_statuses :: [IssueStatus] }+ deriving (Eq,Show)++data IssueStatus = IssueStatus { id_IssueStatus:: Integer+ , name_IssueStatus:: T.Text+ , isDefault_IssueStatus:: Bool+ , isClosed_IssueStatus:: Bool+ } deriving (Eq, Show)++data ProjectsRsp = ProjectsRsp { projects :: [Project] } deriving (Eq,Show)++data ProjectRsp = ProjectRsp { project :: Project } deriving (Eq,Show)++data Project = Project { id_Project:: Integer+ , name_Project:: T.Text+ , identifier_Project:: T.Text+ , desc_Project:: T.Text+ , customFields_Project :: Maybe [CustomField]+ , createdOn_Project :: Maybe UTCTime+ , updatedOn_Project :: Maybe UTCTime+ } deriving (Eq, Show)+++data UsersRsp = UsersRsp { users :: [User] } deriving (Eq,Show)++data UserRsp = UserRsp { user :: User } deriving (Eq,Show)++data User = User { lastname:: T.Text+ , createdOn_User:: Maybe UTCTime+ , mail:: T.Text+ , r :: Maybe UTCTime+ , firstname:: T.Text+ , id_User:: Integer+ } deriving (Eq, Show)++data Trackers = Trackers { trackers :: [Tracker] } deriving (Eq,Show)++data Tracker = Tracker { id_Tracker :: Integer+ , name_Tracker :: T.Text+ } deriving (Eq, Show)+++data Detail = Detail { property :: T.Text+ , name_Detail :: T.Text+ , old_value_Detail :: Maybe T.Text+ , new_value_Detail :: T.Text+ } deriving (Eq,Show)+++data Journal = Journal { id_Journal :: Integer+ , user_Journal :: ObjRef+ , notes_Journal :: T.Text+ , createdOn_Journal :: Maybe UTCTime+ , details_Journal :: Maybe [Detail]+ } deriving (Eq, Show)+++data Attachement = Attachement { id_Attachement :: Integer+ , filename_Attachement :: T.Text+ , filesize_Attachement :: Integer+ , contentType_Attachement :: T.Text+ , description_Attachement :: T.Text+ , contentUrl_Attachement :: T.Text+ , authorName_Attachement :: ObjRef+ , createdOn_Attachement :: UTCTime+ } deriving (Eq, Show)+++data TimeEntriesRsp = TimeEntriesRsp { time_entries :: [TimeEntry] } deriving (Eq,Show)++data TimeEntryRsp = TimeEntryRsp { time_entry :: TimeEntry } deriving (Eq,Show)++data TimeEntry = TimeEntry { id_TE :: Integer+ , project_TE :: ObjRef+ , issue_TE :: ObjID+ , user_TE :: ObjRef+ , activity_TE :: Maybe ObjRef+ , hours_TE :: Maybe Float+ , comments_TE :: T.Text+ , createdOn_TE :: Maybe UTCTime+ , updatedOn_TE :: Maybe UTCTime+ , spentOn_TE :: Maybe Day+ } deriving (Eq, Show)++data Memberships = Memberships { memberships :: [Membership]+ } deriving (Eq,Show)++data Membership = Membership { id_Membership :: Integer+ , project_Membership :: ObjRef+ , user_Membership :: ObjRef+ , roles_Membership :: [Role]+ } deriving (Eq, Show)++data Roles = Roles { roles :: [Role] } deriving (Eq,Show)++data Role = Role { id_Role :: Integer+ , name_Role :: T.Text+ } deriving (Eq, Show)++data RelationType = Relates | Duplicates | Duplicated | Blocks | Blocked+ | Precedes | Follows deriving (Eq, Show)++data Relations = Relations { relations :: [Relation] } deriving (Eq,Show)++data Relation = Relation { id_Relation :: Integer+ , issueId_Relation:: Integer+ , issueToId_Relation:: Integer+ , relationType_Relation:: T.Text+ , delay_Relation:: Maybe Integer+ } deriving (Eq, Show)++instance Monoid TimeEntriesRsp where+ mappend a b = TimeEntriesRsp (time_entries a++time_entries b)+ mempty = TimeEntriesRsp []++instance Monoid IssuesRsp where+ mappend a b = IssuesRsp (issues a++issues b)+ mempty = IssuesRsp []++instance Monoid ProjectsRsp where+ mappend a b = ProjectsRsp (projects a++projects b)+ mempty = ProjectsRsp []++instance Monoid VersionsRsp where+ mappend a b = VersionsRsp (versions a++versions b)+ mempty = VersionsRsp []++class Collection a where+ longueur :: a -> Int++instance Collection TimeEntriesRsp where+ longueur (TimeEntriesRsp a) = length a++instance Collection IssuesRsp where+ longueur (IssuesRsp a) = length a++instance Collection ProjectsRsp where+ longueur (ProjectsRsp a) = length a++instance Collection VersionsRsp where+ longueur (VersionsRsp a) = length a+
+ testsuite/testGet.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.HUnit+import Data.Map+import Redmine.Get++test1 = TestCase (do let m = fromList [("toto","a"),("offset","20"), ("limit","100")]+ ref = "?toto=a&offset=20&limit=100&"+ assertEqual "Option expansion failed" ref (expandOptions m))++test2 = TestCase (do let m = fromList [("offset","20"), ("limit","100")]+ ref = fromList [("offset","120"), ("limit","100")]+ assertEqual "increaseQueryRange a échouée" ref (increaseQueryRange m))+++--decodeIssue++main = runTestTT test2 --[test1,test2]