twin/app/Main.hs

{-# LANGUAGE GADTs #-}
module Main where

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 where
  Args :: { title       :: String
          , directory   :: FilePath
          , fileHead    :: FilePath
          , names       :: Bool
          , cgi         :: Bool
          , back        :: String
          , reverseSort :: Bool
          , filename    :: Bool
          } -> Args

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")
    <*> 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
  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 genNames c backValue revOrder prependFile) = 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 not (null backValue)
    then do
         generateList genNames prependFile dir revOrder
         putStr "\n"
         putStrLn $ "=> " ++ backValue ++ " Back"
    else generateList genNames prependFile dir revOrder

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 :: Bool -> Bool -> FilePath -> FilePath -> IO String

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 modifier/combinator 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
   in do
        line <- trim . words . head . lines <$> readFile path
        return $
            "=> " ++ path ++ basename ++ " " ++ line

getFirstLine :: FilePath -> IO (Maybe String)
getFirstLine f = (Just <$> readFile f) `catch` handler
    where
        handler :: IOException -> IO (Maybe String)
        handler _ = return Nothing