From 97041d7012d7b839a139698fa415134c6f8eaeb3 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 2 Feb 2020 15:34:20 +0100
Subject: [PATCH] Add listing gists

---
 app/Main.hs | 95 ++++++++++++++++++++++++++++++++++++++++-------------
 lib/GHup.hs | 14 ++++++++
 2 files changed, 87 insertions(+), 22 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 8ba635b..6d31262 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -42,6 +42,7 @@ data Command
   | Del DelOptions
   | ListForks ListForkOptions
   | CreateGist CreateGistOptions
+  | ListGist ListGistOptions
 
 data ForkOptions = ForkOptions
   {
@@ -74,6 +75,12 @@ data Input
   = FileInput [ByteString]
   | StdInput
 
+data ListGistOptions = ListGistOptions
+  {
+    lgSince        :: Maybe ByteString
+  , lgDesc         :: Bool
+  }
+
 fileInput :: Parser Input
 fileInput =
   FileInput
@@ -117,9 +124,12 @@ opts = subparser
        <$> (info (lForkOpts <**> helper) (progDesc "List my forks"))
        )
   <> command
-       "gist"
+       "gistc"
        (CreateGist <$> (info (cGistOpts <**> helper) (progDesc "Create gist"))
        )
+  <> command
+       "gistl"
+       (ListGist <$> (info (lGistOpts <**> helper) (progDesc "List gists")))
   )
 
 configOpts :: Parser ConfigOptions
@@ -183,6 +193,20 @@ cGistOpts =
             "Whether gist should be private (default: public)"
           )
 
+lGistOpts :: Parser ListGistOptions
+lGistOpts =
+  ListGistOptions
+    <$> optional
+          (strOption
+            (short 's' <> long "since" <> metavar "SINCE" <> help
+              "The repository to fork"
+            )
+          )
+    <*> switch
+          (short 'd' <> long "descriptions" <> help
+            "Whether to show descriptions (default: False)"
+          )
+
 
 main :: IO ()
 main = do
@@ -222,26 +246,7 @@ main = do
 
             -- list-forks
             ListForks (ListForkOptions {..}) -> run $ do
-              mtime <- liftIO $ case lSince of
-                Just t' -> do
-                  dt <- getCurrentDateTime
-                  let
-                    mt =
-                      either (const Nothing) Just
-                        . parseDate dt
-                        . UTF8.toString
-                        $ t'
-                  pure $ mt >>= \t ->
-                    (parseTimeM
-                      True
-                      defaultTimeLocale
-                      "%Y-%-m-%-d"
-                      (show (year t) <> "-" <> show (month t) <> "-" <> show
-                        (day t)
-                      ) :: Maybe UTCTime
-                    )
-                Nothing -> pure Nothing
-
+              mtime <- parseSince lSince
               forks <- withExceptT show $ getForks mtime
               let
                 formatted =
@@ -258,7 +263,7 @@ main = do
               liftIO $ putStrLn $ formatted
               pure ()
 
-            -- gist
+            -- gistc
             CreateGist (CreateGistOptions {..}) -> run $ do
               let desc   = maybe T.empty E.decodeUtf8 description
                   public = not private
@@ -276,8 +281,54 @@ main = do
                   postGistFiles files' desc public
               liftIO $ putStrLn $ T.unpack $ getUrl $ gistHtmlUrl gist
 
+            -- gistl
+            ListGist (ListGistOptions {..}) -> run $ do
+              mtime <- parseSince lgSince
+              gists <- listGists mtime
+              let
+                formatted =
+                  gridString
+                      (  [column expand left def def]
+                      <> (if lgDesc then [column expand left def def] else [])
+                      <> [column expand left def def]
+                      )
+                    $ fmap
+                        (\Gist {..} ->
+                          [(T.unpack . getUrl $ gistHtmlUrl)]
+                            <> (if lgDesc
+                                 then
+                                   [ T.unpack $ fromMaybe (T.pack "(No desc)")
+                                                          gistDescription
+                                   ]
+                                 else []
+                               )
+                            <> [ formatShow (iso8601Format :: Format Day)
+                                            (utctDay gistUpdatedAt)
+                               ]
+                        )
+                        gists
+              liftIO $ putStrLn $ formatted
+
+
 
   -- print error, if any
   case e of
     Right () -> pure ()
     Left  t  -> die (color Red $ t)
+
+ where
+  parseSince lSince = do
+    liftIO $ case lSince of
+      Just t' -> do
+        dt <- getCurrentDateTime
+        let mt =
+              either (const Nothing) Just . parseDate dt . UTF8.toString $ t'
+        pure $ mt >>= \t ->
+          (parseTimeM
+            True
+            defaultTimeLocale
+            "%Y-%-m-%-d"
+            (show (year t) <> "-" <> show (month t) <> "-" <> show (day t)) :: Maybe
+              UTCTime
+          )
+      Nothing -> pure Nothing
diff --git a/lib/GHup.hs b/lib/GHup.hs
index a61d996..85d77ab 100644
--- a/lib/GHup.hs
+++ b/lib/GHup.hs
@@ -33,6 +33,7 @@ module GHup
   , postGistStdin
   , postGistFiles
   , postGist
+  , listGists
   -- * Parsers
   , parseURL
   , ghURLParser
@@ -67,6 +68,8 @@ import qualified Data.Text.Encoding            as E
 import qualified Data.Text.IO                  as T
 import           Data.Traversable
 import           Data.Time.Clock
+import           Data.Time.Format.ISO8601
+import qualified Data.Vector                   as V
 import           Data.Word8
 import           GHC.Exts                       ( toList )
 import           GitHub.Auth
@@ -398,6 +401,17 @@ postGist :: (MonadIO m, MonadReader Settings m)
 postGist greq = githubAuth (command Post [T.pack "gists"] (encode greq))
 
 
+listGists :: (MonadIO m, MonadReader Settings m)
+          => Maybe UTCTime
+          -> ExceptT Error m [Gist]
+listGists mtime = do
+  let queryString = case mtime of
+        Just time -> [(u8 "since", Just $ UTF8.fromString $ iso8601Show time)]
+        Nothing   -> []
+  V.toList <$> githubAuth (pagedQuery [T.pack "gists"] queryString FetchAll)
+
+
+
 
     ---------------
     --[ Parsers ]--