From: fr33domlover <[email protected]>
---
src/Model/Issue.hs | 19 ++++++++++---------
src/Model/Project.hs | 21 ++++++++++++---------
stack.yaml | 4 ----
3 files changed, 22 insertions(+), 22 deletions(-)
diff --git a/src/Model/Issue.hs b/src/Model/Issue.hs
index f9cccd4..1e0b61b 100644
--- a/src/Model/Issue.hs
+++ b/src/Model/Issue.hs
@@ -11,7 +11,7 @@ import Text.Printf
import Widgets.Tag (pickForegroundColor)
import qualified Data.Set as S
import qualified Data.Text as T
-import qualified Github.Issues as GH
+import qualified GitHub.Data.Issues as GH
-- An Issue abstracts a Snowdrift ticket, Github issue, etc.
class Issue a where
@@ -63,12 +63,15 @@ instance Issue GH.Issue where
#{GH.labelName tag}
|]
- fg :: String -> String
+ -- TODO: Use Text tools and not String ones with ugly un/pack
+ -- e.g. use 'formatting' package instead of printf
+ fg :: Text -> String
fg = printf "%06x"
. pickForegroundColor
. maybe 0 fst
. listToMaybe
. readHex
+ . T.unpack
issueFilterable = mkFromGithubIssue Filterable
issueOrderable = mkFromGithubIssue Orderable
@@ -88,14 +91,12 @@ mkFromGithubIssue c i = c is_claimed has_tag get_named_ts
search_literal
is_claimed "UNCLAIMED" = has_issue_assignee
is_claimed cmd = error $ "Unrecognized command " <> T.unpack cmd
- has_tag t = elem (T.unpack t) $ map GH.labelName $ GH.issueLabels i
+ has_tag t = t `elem` fmap GH.labelName (GH.issueLabels i)
- get_named_ts "CREATED" =
- S.singleton $ GH.fromGithubDate $ GH.issueCreatedAt i
- get_named_ts "LAST UPDATED" =
- S.singleton $ GH.fromGithubDate $ GH.issueUpdatedAt i
+ get_named_ts "CREATED" = S.singleton $ GH.issueCreatedAt i
+ get_named_ts "LAST UPDATED" = S.singleton $ GH.issueUpdatedAt i
get_named_ts name = error $ "Unrecognized time name " ++ T.unpack name
search_literal str =
- not (null $ T.breakOnAll str $ T.pack $ GH.issueTitle i)
- || fromMaybe False (null . T.breakOnAll str . T.pack <$> GH.issueBody
i)
+ not (null $ T.breakOnAll str $ GH.issueTitle i)
+ || fromMaybe False (null . T.breakOnAll str <$> GH.issueBody i)
diff --git a/src/Model/Project.hs b/src/Model/Project.hs
index 6338826..844b4b2 100644
--- a/src/Model/Project.hs
+++ b/src/Model/Project.hs
@@ -38,8 +38,8 @@ import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Database.Persist as P
-import qualified Github.Data as GH
-import qualified Github.Issues as GH
+import qualified GitHub.Data as GH
+import qualified GitHub.Endpoints.Issues as GH
import Data.Filter
import Data.Order
@@ -153,17 +153,20 @@ getGithubIssues project =
return
where
eMsg = "failed to fetch GitHub tickets\n"
+ getIssues (account, repo) =
+ fmap (fmap toList) $ GH.issuesForRepo account repo []
getGithubIssues' :: Handler (Async (Either GH.Error [GH.Issue]))
getGithubIssues' = liftIO . async $
- maybe
- (return $ Right [])
- (\(account, repo) -> GH.issuesForRepo account repo [])
- parsedProjectGithubRepo
+ maybe (return $ Right []) getIssues parsedProjectGithubRepo
- parsedProjectGithubRepo :: Maybe (String, String)
+ parsedProjectGithubRepo :: Maybe (GH.Name GH.Owner, GH.Name GH.Repo)
parsedProjectGithubRepo =
- fmap (second (drop 1) . break (== '/') . T.unpack)
- (projectGithubRepo project)
+ fmap
+ ( (GH.mkOwnerName *** GH.mkRepoName)
+ . second (T.drop 1)
+ . T.break (== '/')
+ )
+ (projectGithubRepo project)
summarizeProject :: Entity Project
-> Mech.Project
diff --git a/stack.yaml b/stack.yaml
index ace815b..ca22213 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -19,8 +19,4 @@ extra-deps:
- mime-0.4.0.2
- titlecase-0.1.0.2
- yesod-markdown-0.11.0
- # TODO: upgrade to github-0.14+, which is in LTS
- - github-0.13.2
- # Transitive dep of github-0.13.2
- - failure-0.2.0.3
resolver: lts-5.5
--
1.9.1
_______________________________________________
Dev mailing list
[email protected]
https://lists.snowdrift.coop/mailman/listinfo/dev
