From 486a2386ba8c9b5f450d2fd087441bd338bc242e Mon Sep 17 00:00:00 2001
From: Ricky Elrod <ricky@elrod.me>
Date: Aug 14 2015 20:48:41 +0000
Subject: Add user function, without settings for now


Signed-off-by: Ricky Elrod <ricky@elrod.me>

---

diff --git a/pagure.cabal b/pagure.cabal
index 7003563..058e512 100644
--- a/pagure.cabal
+++ b/pagure.cabal
@@ -24,6 +24,7 @@ library
     , Web.Pagure.Types
     , Web.Pagure.Types.Issue
     , Web.Pagure.Types.Project
+    , Web.Pagure.Types.User
     , Web.Pagure.Users
     , Web.Pagure
   -- other-modules:
diff --git a/src/Web/Pagure/Types/User.hs b/src/Web/Pagure/Types/User.hs
new file mode 100644
index 0000000..df453d4
--- /dev/null
+++ b/src/Web/Pagure/Types/User.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE OverloadedStrings #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Web.Pagure.Types.User
+-- Copyright : (C) 2015 Ricky Elrod
+-- License : BSD2 (see LICENSE file)
+-- Maintainer : Ricky Elrod <relrod@redhat.com>
+-- Stability : experimental
+-- Portability : ghc (lens)
+--
+-- Types for users
+----------------------------------------------------------------------------
+module Web.Pagure.Types.User where
+
+import Control.Applicative
+import Control.Monad (mzero)
+import Data.Aeson
+import Web.Pagure.Types
+import Prelude
+
+data UserResponse =
+  UserResponse { userForks :: [UserRepo]
+               , userRepos :: [UserRepo]
+               , user :: User
+               } deriving (Eq, Show)
+
+data UserRepo =
+  UserRepo { userRepoDateCreated :: String
+           , userRepoDescription :: String
+           , userRepoId :: Integer
+           , userRepoName :: String
+           , userRepoParent :: Maybe Project
+             -- TODO: Uncomment after upstream python type cast error is fixed...
+           --, userRepoSettings :: UserRepoSettings
+           , userRepoTags :: [Tag]
+           , userRepoUser :: User
+           } deriving (Eq, Show)
+
+data UserRepoSettings =
+
+  UserRepoSettings { userRepoSettingsMinimumPRScore :: Integer
+                   , userRepoSettingsOnlyAssigneeCanMergePR :: Bool
+                   , userRepoSettingsWebhooks :: Maybe String
+                   , userRepoSettingsIssueTracker :: Bool
+                   , userRepoSettingsProjectDocumentation :: Bool
+                   , userRepoSettingsProjectPullRequests :: Bool
+                   , userRepoSettingsEnforceSignedOffCommitsInPR :: Bool
+                   } deriving (Eq, Show)
+
+instance FromJSON UserResponse where
+  parseJSON (Object x) = UserResponse <$>
+                         x .: "forks"
+                     <*> x .: "repos"
+                     <*> x .: "user"
+  parseJSON _            = mzero
+
+instance FromJSON UserRepo where
+  parseJSON (Object x) = UserRepo <$>
+                         x .: "date_created"
+                     <*> x .: "description"
+                     <*> x .: "id"
+                     <*> x .: "name"
+                     <*> x .: "parent"
+                     -- TODO: Uncomment after upstream python type cast error is fixed...
+                     -- <*> x .: "settings"
+                     <*> x .: "tags"
+                     <*> x .: "user"
+  parseJSON _            = mzero
+
+instance FromJSON UserRepoSettings where
+  parseJSON (Object x) = UserRepoSettings <$>
+                         x .: "Minimum_score_to_merge_pull-request"
+                     <*> x .: "Only_assignee_can_merge_pull-request"
+                     <*> x .: "Web-hooks"
+                     <*> x .: "issue_tracker"
+                     <*> x .: "project_documentation"
+                     <*> x .: "pull_requests"
+                     <*> x .: "Enforce_signed-off_commits_in_pull-request"
+  parseJSON _            = mzero
diff --git a/src/Web/Pagure/Users.hs b/src/Web/Pagure/Users.hs
index 13467fe..e71bf4b 100644
--- a/src/Web/Pagure/Users.hs
+++ b/src/Web/Pagure/Users.hs
@@ -18,6 +18,7 @@ import qualified Data.Text as T
 import Network.Wreq
 import Web.Pagure.Internal.Wreq
 import Web.Pagure.Types
+import Web.Pagure.Types.User
 
 -- | Access the @/users@ endpoint.
 --
@@ -60,3 +61,17 @@ groups pattern = do
         Just p -> opts & param "pattern" .~ [p]
   resp <- pagureGetWith opts' "groups"
   return $ resp ^.. responseBody . key "groups" . values . _String
+
+-- | Access the @/user/[username]@ endpoint.
+--
+-- Example:
+--
+-- @
+-- >>> import Web.Pagure
+-- >>> let pc = PagureConfig "https://pagure.io" Nothing
+-- >>> runPagureT (user "codeblock") pc
+-- @
+user :: Username -> PagureT (Maybe UserResponse)
+user u = do
+  resp <- asJSON =<< pagureGet ("user/" ++ T.unpack u)
+  return $ resp ^. responseBody