From 0f71972321101dbda044afdf6f7163384431b3f3 Mon Sep 17 00:00:00 2001 From: Marty Sluijtman Date: Sun, 10 Mar 2024 14:23:22 +0100 Subject: [PATCH] More flags and some cleanup --- app/Main.hs | 77 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 47 insertions(+), 30 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 437629a..713f28c 100644 --- a/app/Main.hs +++ b/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