More flags and some cleanup

app/Main.hs

@@ -1,24 +1,26 @@
+{-# LANGUAGE GADTs #-}
 module Main where
 
-import System.IO
 import System.Directory
 import Options.Applicative
 import Data.List
 import Control.Exception
+import Data.Ord
 
 data CgiState = CgiSuccess
 instance Show CgiState where
     show CgiSuccess = "20 text/gemini; lang=en; charset=utf-8\r"
 
-data Args = Args
-    { title :: String
-    , directory :: FilePath
-    , fileHead :: FilePath
-    --, verbose :: Bool
-    , names :: Bool
-    , cgi :: Bool
-    , back :: Bool
-    }
+data Args where
+  Args :: { title       :: String,
+            directory   :: FilePath,
+            fileHead    :: FilePath,
+            names       :: Bool,
+            cgi         :: Bool,
+            back        :: String,
+            reverseSort :: Bool,
+            filename    :: Bool} ->
+            Args
 
 args :: Parser Args
 args = Args
@@ -28,7 +30,9 @@ args = Args
     -- <*> switch ( long "verbose" <> short 'v' <> help "Verbose mode")
     <*> switch ( long "names" <> short 'n' <> help "Generate link names based on first of each document" )
     <*> switch ( long "cgi" <> help "Output gemini file header")
-    <*> switch ( long "back" <> help "Print 'return to dir' url")
+    <*> strOption ( long "back" <> short 'b' <> value "" <> help "Print 'return to dir' url")
+    <*> switch ( long "reverse" <> short 'r' <> help "Reverse sort order")
+    <*> switch ( long "filename" <> help "Prepend filename")
 
 main :: IO ()
 main = parseArgs =<< execParser opts
@@ -40,7 +44,7 @@ main = parseArgs =<< execParser opts
 
 parseArgs :: Args -> IO()
 --parseArgs (Args t dir h v n c b) = do
-parseArgs (Args t dir h n c b) = do
+parseArgs (Args t dir h genNames c backValue revOrder prependFile) = do
     if c
     then do print CgiSuccess
             putStrLn $ "# " ++ t
@@ -50,34 +54,47 @@ parseArgs (Args t dir h n c b) = do
     then putStr $ "\n" ++ h ++ "\n\n"
     else putStr "\n"
 
-    if b then do
-        mapM_ (mkIndex n dir) . filter (isSuffixOf ".gmi") =<< getDirectoryContents dir
-        putStr "\n"
-        putStrLn "=> .. "
-    else mapM_ (mkIndex n dir) . filter (isSuffixOf ".gmi") =<< getDirectoryContents dir
+    if not (null backValue)
+    then do
+         generateList genNames prependFile dir revOrder
+         putStr "\n"
+         putStrLn $ "=> " ++ backValue ++ " Back"
+    else generateList genNames prependFile dir revOrder
 
-mkIndex :: Bool -> FilePath -> FilePath -> IO ()
+generateList :: Bool -> Bool -> FilePath -> Bool -> IO ()
+generateList genNames prependFile dir revOrder = do
+    dirContents <- (if revOrder then sortBy (comparing Down) else sort) . filter (isSuffixOf "gmi") <$> getDirectoryContents dir
+    mapM_ putStrLn =<< mapM (mkIndex genNames prependFile dir) dirContents
 
-mkIndex False d f = putStrLn $ "=> " ++ path d
-    where path s
-            | s == "./" = f
-            | otherwise = s++"/"++f
+mkIndex :: Bool -> Bool -> FilePath -> FilePath -> IO String
 
-mkIndex True d f =
-  let path = d ++ "/" ++ f
-      trim s
-        | length s >= 8 = appendDots . unwords . take 8 . cleanString $ s
-        | otherwise = unwords . cleanString $ s
+mkIndex False _ dir file =
+  return $
+    "=> " ++ case dir of
+      "./" -> file
+      _    -> dir ++ "/" ++ file
+
+-- a sane person should look over this fucking thing...
+mkIndex True prependFile dir file =
+  let path = dir ++ "/" ++ file
+      basename = if prependFile
+                 -- I wish I had BQNs Under mofiefier/combiantor here...
+                 then (" " ++) . reverse . drop 4 . reverse $ file
+                 else ""
+      trim string
+        | length string >= 8 = appendDots . unwords . take 8 . cleanString $ string
+        | otherwise          = unwords . cleanString $ string
         where
           -- remove all '#' signs and any potential resulting empty lists
           cleanString = filter (/= "") . map (dropWhile (== '#'))
           -- in case the last character is a dot, remove it
           appendDots name
-            | last name == '.' = (++ "...") . reverse . dropWhile (=='.') . reverse $ name
-            | otherwise = name
+            | last name == '.' = (++ "...") . reverse . dropWhile (== '.') . reverse $ name
+            | otherwise        = name
    in do
         line <- trim . words . head . lines <$> readFile path
-        putStrLn $ "=> " ++ path ++ " " ++ line
+        return $
+            "=> " ++ path ++ basename ++ " " ++ line
 
 getFirstLine :: FilePath -> IO (Maybe String)
 getFirstLine f = (Just <$> readFile f) `catch` handler