twin/app/Main.hs

module Main where

import System.Directory
import Options.Applicative
import Data.List

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