{-#LANGUAGE RecordWildCards#-}
{-# LANGUAGE BangPatterns #-}
module Tldr.App.Handler
( handleAboutFlag
, retriveLocale
, checkLocale
, englishViewOptions
, getCheckDirs
, initializeTldrPages
, pageExists
, getPagePath
, updateTldrPages
, handleTldrOpts
) where
import Control.Monad (unless)
import Data.Char (toLower)
import Data.List (intercalate)
import Data.Semigroup ((<>))
import qualified Data.Set as Set
import Data.Version (showVersion)
import Options.Applicative
import Paths_tldr (version)
import System.Directory
( XdgDirectory(..)
, createDirectoryIfMissing
, doesDirectoryExist
, doesFileExist
, getXdgDirectory
)
import System.Environment (lookupEnv, getExecutablePath)
import System.Exit (exitFailure)
import System.FilePath ((<.>), (</>))
import System.IO (hPutStrLn, stderr, stdout)
import System.Process.Typed
import Tldr
import Tldr.App.Constant
import Tldr.Types
handleAboutFlag :: IO ()
handleAboutFlag = do
path <- getExecutablePath
let content =
unlines
[ path <> " v" <> showVersion version
, "Copyright (C) 2017 Sibi Prabakaran"
, "Source available at https://github.com/psibi/tldr-hs"
]
putStr content
retriveLocale :: IO Locale
retriveLocale = do
lang <- lookupEnv "LANG"
pure $ computeLocale lang
checkLocale :: Locale -> Bool
checkLocale English = True
checkLocale _ = False
englishViewOptions :: ViewOptions -> ViewOptions
englishViewOptions xs = xs { languageOption = Just "en_US.utf8" }
handleTldrOpts :: TldrOpts -> IO ()
handleTldrOpts opts@TldrOpts {..} =
case tldrAction of
UpdateIndex -> updateTldrPages
About -> handleAboutFlag
ViewPage voptions pages -> do
let npage = intercalate "-" pages
locale <-
case languageOption voptions of
Nothing -> retriveLocale
Just lg -> pure $ computeLocale (Just lg)
fname <- getPagePath locale npage (getCheckDirs voptions)
case fname of
Just path -> renderPage path stdout
Nothing ->
if checkLocale locale
then do
hPutStrLn stderr ("No tldr entry for " <> unwords pages)
exitFailure
else handleTldrOpts
(opts
{ tldrAction =
ViewPage (englishViewOptions voptions) pages
})
updateTldrPages :: IO ()
updateTldrPages = do
dataDir <- getXdgDirectory XdgData tldrDirName
let repoDir = dataDir </> "tldr"
repoExists <- doesDirectoryExist repoDir
if repoExists
then runProcess_ $
setWorkingDir repoDir $ proc "git" ["pull", "origin", "master"]
else initializeTldrPages
computeLocale :: Maybe String -> Locale
computeLocale lang = case map toLower <$> lang of
Nothing -> Missing
Just ('e':'n':_) -> English
Just (a:b:'_':_) -> Other [a,b]
Just (a:b:c:'_':_) -> Other [a,b,c]
Just other -> Unknown other
getPagePath :: Locale -> String -> [String] -> IO (Maybe FilePath)
getPagePath locale page pDirs = do
dataDir <- getXdgDirectory XdgData tldrDirName
let currentLocale = case locale of
English -> "pages"
Other xs -> "pages." <> xs
Unknown xs -> "pages." <> xs
Missing -> "pages"
pageDir = dataDir </> "tldr" </> currentLocale
paths = map (\x -> pageDir </> x </> page <.> "md") pDirs
foldr1 (<|>) <$> mapM pageExists paths
pageExists :: FilePath -> IO (Maybe FilePath)
pageExists fname = do
exists <- doesFileExist fname
if exists
then return $ Just fname
else return Nothing
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]
getCheckDirs :: ViewOptions -> [String]
getCheckDirs voptions =
case platformOption voptions of
Nothing -> checkDirs
Just platform -> nubOrd $ ["common", platform] <> checkDirs
nubOrd :: Ord a => [a] -> [a]
nubOrd = loop mempty
where
loop _ [] = []
loop !s (a:as)
| a `Set.member` s = loop s as
| otherwise = a : loop (Set.insert a s) as