tldr-0.4.0.2: app/Main.hs

{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import Control.Monad
import Data.List (intercalate, isPrefixOf)
import Data.Semigroup ((<>))
import Data.Version (showVersion)
import GHC.IO.Handle.FD (stdout)
import Options.Applicative hiding ((<>))
import Paths_tldr (version)
import System.Directory
import System.Environment (getArgs, withArgs)
import System.FilePath
import System.Process.Typed
import Tldr

data TldrOpts = TldrOpts
  { pageName :: String
  } deriving (Show)

tldrDirName :: String
tldrDirName = "tldr"

repoHttpsUrl :: String
repoHttpsUrl = "https://github.com/tldr-pages/tldr.git"

checkDirs :: [String]
checkDirs = ["common", "linux", "osx", "windows", "sunos"]

tldrInitialized :: IO Bool
tldrInitialized = do
  dataDir <- getXdgDirectory XdgData tldrDirName
  let dir2 = dataDir </> "tldr"
      pages = dataDir </> "tldr" </> "pages"
  exists <- mapM doesDirectoryExist [dataDir, dir2, pages]
  return $ all (== True) exists

initializeTldrPages :: IO ()
initializeTldrPages = do
  initialized <- tldrInitialized
  unless initialized $ do
    dataDir <- getXdgDirectory XdgData tldrDirName
    createDirectoryIfMissing False dataDir
    runProcess_ $ setWorkingDir dataDir $ proc "git" ["clone", repoHttpsUrl]

updateTldrPages :: IO ()
updateTldrPages = do
  dataDir <- getXdgDirectory XdgData tldrDirName
  let repoDir = dataDir </> "tldr"
  repoExists <- doesDirectoryExist repoDir
  case repoExists of
    True ->
      runProcess_ $
      setWorkingDir (repoDir) $ proc "git" ["pull", "origin", "master"]
    False -> initializeTldrPages

updateOption :: Parser (a -> a)
updateOption = infoOption "update" (long "update" <> help "Update tldr pages")

tldrParserInfo :: ParserInfo TldrOpts
tldrParserInfo =
  info
    (helper <*> versionOption <*> updateOption <*> programOptions)
    (fullDesc <> progDesc "tldr Client program" <>
     header "tldr - Simplified and community-driven man pages")
  where
    versionOption :: Parser (a -> a)
    versionOption =
      infoOption
        (showVersion version)
        (long "version" <> short 'v' <> help "Show version")

programOptions :: Parser TldrOpts
programOptions =
  (TldrOpts <$> strArgument (metavar "COMMAND" <> help "name of the command"))

pageExists :: FilePath -> IO (Maybe FilePath)
pageExists fname = do
  exists <- doesFileExist fname
  if exists
    then return $ Just fname
    else return Nothing

getPagePath :: String -> IO (Maybe FilePath)
getPagePath page = do
  dataDir <- getXdgDirectory XdgData tldrDirName
  let pageDir = dataDir </> "tldr" </> "pages"
      paths = map (\x -> pageDir </> x </> page <.> "md") checkDirs
  foldr1 (<|>) <$> mapM pageExists paths

isOption :: String -> Bool
isOption string = string `isPrefixOf` "--"

hasOption :: [String] -> Bool
hasOption xs = any isOption xs

main :: IO ()
main = do
  args <- getArgs
  case execParserPure (prefs showHelpOnEmpty) tldrParserInfo args of
    failOpts@(Failure _)
      | args == ["--update"] -> updateTldrPages
      | otherwise ->
        if hasOption args
          then handleParseResult failOpts >> return ()
          else do
            let npage = intercalate "-" args
            fname <- getPagePath npage
            case fname of
              Just path -> renderPage path stdout
              Nothing ->
                putStrLn ("No tldr entry for " <> (intercalate " " args))
    Success opts -> do
      initializeTldrPages
      let page = pageName opts
      fname <- getPagePath page
      maybe
        (putStrLn ("No tldr entry for " <> page))
        (flip renderPage stdout)
        fname
    compOpts@(CompletionInvoked _) -> handleParseResult compOpts >> return ()