twin/app/Main.hs
2024-03-09 02:52:59 +01:00

87 lines
2.8 KiB
Haskell

module Main where
import System.IO
import System.Directory
import Options.Applicative
import Data.List
import Control.Exception
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
}
args :: Parser Args
args = Args
<$> strOption ( long "title" <> short 't' <> value "Title Left Blank" <> help "Document title" )
<*> strOption ( long "directory" <> short 'd' <> value "./" <> help "Directory to parse" )
<*> strOption ( long "header" <> short 'H' <> value "" <> help "Header text" )
-- <*> 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")
main :: IO ()
main = parseArgs =<< execParser opts
where
opts = info ( args <**> helper)
( fullDesc
<> progDesc "Generate gemini page index"
<> header "Generate a gemini page index")
parseArgs :: Args -> IO()
--parseArgs (Args t dir h v n c b) = do
parseArgs (Args t dir h n c b) = do
if c
then do print CgiSuccess
putStrLn $ "# " ++ t
else putStrLn $ "# " ++ t
if not (null h)
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
mkIndex :: Bool -> FilePath -> FilePath -> IO ()
mkIndex False d f = putStrLn $ "=> " ++ path d
where path s
| s == "./" = f
| otherwise = s++"/"++f
mkIndex True d f =
let path = d ++ "/" ++ f
trim s
| length s >= 8 = appendDots . unwords . take 8 . cleanString $ s
| otherwise = unwords . cleanString $ s
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
in do
line <- trim . words . head . lines <$> readFile path
putStrLn $ "=> " ++ path ++ " " ++ line
getFirstLine :: FilePath -> IO (Maybe String)
getFirstLine f = (Just <$> readFile f) `catch` handler
where
handler :: IOException -> IO (Maybe String)
handler _ = return Nothing