More flags and some cleanup
This commit is contained in:
parent
261d1c6264
commit
0f71972321
77
app/Main.hs
77
app/Main.hs
|
@ -1,24 +1,26 @@
|
||||||
|
{-# LANGUAGE GADTs #-}
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import System.IO
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Options.Applicative
|
import Options.Applicative
|
||||||
import Data.List
|
import Data.List
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
|
import Data.Ord
|
||||||
|
|
||||||
data CgiState = CgiSuccess
|
data CgiState = CgiSuccess
|
||||||
instance Show CgiState where
|
instance Show CgiState where
|
||||||
show CgiSuccess = "20 text/gemini; lang=en; charset=utf-8\r"
|
show CgiSuccess = "20 text/gemini; lang=en; charset=utf-8\r"
|
||||||
|
|
||||||
data Args = Args
|
data Args where
|
||||||
{ title :: String
|
Args :: { title :: String,
|
||||||
, directory :: FilePath
|
directory :: FilePath,
|
||||||
, fileHead :: FilePath
|
fileHead :: FilePath,
|
||||||
--, verbose :: Bool
|
names :: Bool,
|
||||||
, names :: Bool
|
cgi :: Bool,
|
||||||
, cgi :: Bool
|
back :: String,
|
||||||
, back :: Bool
|
reverseSort :: Bool,
|
||||||
}
|
filename :: Bool} ->
|
||||||
|
Args
|
||||||
|
|
||||||
args :: Parser Args
|
args :: Parser Args
|
||||||
args = Args
|
args = Args
|
||||||
|
@ -28,7 +30,9 @@ args = Args
|
||||||
-- <*> switch ( long "verbose" <> short 'v' <> help "Verbose mode")
|
-- <*> 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 "names" <> short 'n' <> help "Generate link names based on first of each document" )
|
||||||
<*> switch ( long "cgi" <> help "Output gemini file header")
|
<*> 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 :: IO ()
|
||||||
main = parseArgs =<< execParser opts
|
main = parseArgs =<< execParser opts
|
||||||
|
@ -40,7 +44,7 @@ main = parseArgs =<< execParser opts
|
||||||
|
|
||||||
parseArgs :: Args -> IO()
|
parseArgs :: Args -> IO()
|
||||||
--parseArgs (Args t dir h v n c b) = do
|
--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
|
if c
|
||||||
then do print CgiSuccess
|
then do print CgiSuccess
|
||||||
putStrLn $ "# " ++ t
|
putStrLn $ "# " ++ t
|
||||||
|
@ -50,34 +54,47 @@ parseArgs (Args t dir h n c b) = do
|
||||||
then putStr $ "\n" ++ h ++ "\n\n"
|
then putStr $ "\n" ++ h ++ "\n\n"
|
||||||
else putStr "\n"
|
else putStr "\n"
|
||||||
|
|
||||||
if b then do
|
if not (null backValue)
|
||||||
mapM_ (mkIndex n dir) . filter (isSuffixOf ".gmi") =<< getDirectoryContents dir
|
then do
|
||||||
putStr "\n"
|
generateList genNames prependFile dir revOrder
|
||||||
putStrLn "=> .. "
|
putStr "\n"
|
||||||
else mapM_ (mkIndex n dir) . filter (isSuffixOf ".gmi") =<< getDirectoryContents dir
|
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
|
mkIndex :: Bool -> Bool -> FilePath -> FilePath -> IO String
|
||||||
where path s
|
|
||||||
| s == "./" = f
|
|
||||||
| otherwise = s++"/"++f
|
|
||||||
|
|
||||||
mkIndex True d f =
|
mkIndex False _ dir file =
|
||||||
let path = d ++ "/" ++ f
|
return $
|
||||||
trim s
|
"=> " ++ case dir of
|
||||||
| length s >= 8 = appendDots . unwords . take 8 . cleanString $ s
|
"./" -> file
|
||||||
| otherwise = unwords . cleanString $ s
|
_ -> 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
|
where
|
||||||
-- remove all '#' signs and any potential resulting empty lists
|
-- remove all '#' signs and any potential resulting empty lists
|
||||||
cleanString = filter (/= "") . map (dropWhile (== '#'))
|
cleanString = filter (/= "") . map (dropWhile (== '#'))
|
||||||
-- in case the last character is a dot, remove it
|
-- in case the last character is a dot, remove it
|
||||||
appendDots name
|
appendDots name
|
||||||
| last name == '.' = (++ "...") . reverse . dropWhile (=='.') . reverse $ name
|
| last name == '.' = (++ "...") . reverse . dropWhile (== '.') . reverse $ name
|
||||||
| otherwise = name
|
| otherwise = name
|
||||||
in do
|
in do
|
||||||
line <- trim . words . head . lines <$> readFile path
|
line <- trim . words . head . lines <$> readFile path
|
||||||
putStrLn $ "=> " ++ path ++ " " ++ line
|
return $
|
||||||
|
"=> " ++ path ++ basename ++ " " ++ line
|
||||||
|
|
||||||
getFirstLine :: FilePath -> IO (Maybe String)
|
getFirstLine :: FilePath -> IO (Maybe String)
|
||||||
getFirstLine f = (Just <$> readFile f) `catch` handler
|
getFirstLine f = (Just <$> readFile f) `catch` handler
|
||||||
|
|
Loading…
Reference in a new issue