tldr 0.7.1 → 0.8.0
raw patch · 11 files changed
+312/−255 lines, 11 files
Files
- CHANGELOG.md +5/−0
- app/Main.hs +3/−231
- src/Tldr.hs +5/−14
- src/Tldr/App.hs +78/−0
- src/Tldr/App/Constant.hs +13/−0
- src/Tldr/App/Handler.hs +156/−0
- src/Tldr/Types.hs +34/−0
- test/data/grep.golden +3/−1
- test/data/ls.golden +1/−0
- test/data/ps.golden +1/−0
- tldr.cabal +13/−9
CHANGELOG.md view
@@ -1,3 +1,8 @@+# 0.8.0++* Split the library into more parts.+* Fix [multiple line bugs](https://github.com/psibi/tldr-hs/issues/26 "multiple line bugs")+ # 0.7.1 * Client gives non zero exit status for non-existent pages.
app/Main.hs view
@@ -1,234 +1,6 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE BangPatterns #-}--module Main- ( main- ) where--import Control.Monad-import Data.List (intercalate)-import Data.Semigroup ((<>))-import qualified Data.Set as Set-import Data.Version (showVersion)-import System.IO (stdout, stderr, hPutStrLn)-import Options.Applicative-import Paths_tldr (version)-import System.Directory-import System.Environment (getArgs, getExecutablePath, lookupEnv)-import System.Exit (exitFailure)-import System.FilePath-import System.Process.Typed-import Data.Char (toLower)-import Tldr--data TldrOpts = TldrOpts- { tldrAction :: TldrCommand- } deriving (Show)--data TldrCommand- = UpdateIndex- | ViewPage ViewOptions- [String]- | About- deriving (Show, Eq, Ord)--data ViewOptions =- ViewOptions- { platformOption :: Maybe String- , languageOption :: Maybe String- }- deriving (Show, Eq, Ord)--englishViewOptions :: ViewOptions -> ViewOptions-englishViewOptions xs = xs { languageOption = Just "en_US.utf8" }--programOptions :: Parser TldrOpts-programOptions =- (TldrOpts <$> (updateIndexCommand <|> viewPageCommand <|> aboutFlag))--updateIndexCommand :: Parser TldrCommand-updateIndexCommand =- flag'- UpdateIndex- (long "update" <> short 'u' <> help "Update offline cache of tldr pages")--aboutFlag :: Parser TldrCommand-aboutFlag = flag' About (long "about" <> short 'a' <> help "About this program")--viewOptionsParser :: Parser ViewOptions-viewOptionsParser = ViewOptions <$> platformFlag <*> languageFlag--viewPageCommand :: Parser TldrCommand-viewPageCommand =- ViewPage <$> viewOptionsParser <*>- some (strArgument (metavar "COMMAND" <> help "name of the command"))--platformFlag :: Parser (Maybe String)-platformFlag =- optional- (strOption- (long "platform" <> short 'p' <> metavar "PLATFORM" <>- help- ("Prioritize specfic platform while searching. Valid values include " <>- platformHelpValue)))- where- platformHelpValue :: String- platformHelpValue = intercalate ", " platformDirs--languageFlag :: Parser (Maybe String)-languageFlag =- optional- (strOption- (long "language" <> short 'L' <> metavar "LOCALE" <>- help- ("Preferred language for the page returned")))--tldrDirName :: String-tldrDirName = "tldr"--repoHttpsUrl :: String-repoHttpsUrl = "https://github.com/tldr-pages/tldr.git"--checkDirs :: [String]-checkDirs = "common" : platformDirs--platformDirs :: [String]-platformDirs = ["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--tldrParserInfo :: ParserInfo TldrOpts-tldrParserInfo =- info- (helper <*> versionOption <*> 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")--pageExists :: FilePath -> IO (Maybe FilePath)-pageExists fname = do- exists <- doesFileExist fname- if exists- then return $ Just fname- else return Nothing--getPagePath :: Locale -> String -> [String] -> IO (Maybe FilePath)-getPagePath locale page platformDirs = 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") platformDirs- foldr1 (<|>) <$> mapM pageExists paths--getCheckDirs :: ViewOptions -> [String]-getCheckDirs voptions =- case platformOption voptions of- Nothing -> checkDirs- Just platform -> nubOrd $ ["common", platform] <> checkDirs---- | Strip out duplicates-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--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--handleTldrOpts :: TldrOpts -> IO ()-handleTldrOpts opts@TldrOpts {..} = do- case tldrAction of- UpdateIndex -> updateTldrPages- About -> handleAboutFlag- vopts@(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 -> do- if checkLocale locale- then do- hPutStrLn stderr ("No tldr entry for " <> (intercalate " " pages))- exitFailure- else handleTldrOpts- (opts- { tldrAction =- ViewPage (englishViewOptions voptions) pages- })--checkLocale :: Locale -> Bool-checkLocale English = True-checkLocale _ = False--data Locale = English | Missing | Other String | Unknown String+module Main where -retriveLocale :: IO Locale-retriveLocale = do- lang <- lookupEnv "LANG"- pure $ computeLocale lang- -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 str -> Unknown str+import Tldr.App (appMain) main :: IO ()-main = do- args <- getArgs- case execParserPure (prefs showHelpOnEmpty) tldrParserInfo args of- failOpts@(Failure _) -> handleParseResult failOpts >> return ()- Success opts -> handleTldrOpts opts- compOpts@(CompletionInvoked _) -> handleParseResult compOpts >> return ()+main = appMain
src/Tldr.hs view
@@ -14,21 +14,11 @@ import CMark import Data.Monoid ((<>)) import Data.Text hiding (cons)-import qualified Data.Text as T-import qualified Data.Text.IO as TIO import GHC.IO.Handle (Handle) import System.Console.ANSI--data ConsoleSetting =- ConsoleSetting- { italic :: Bool- , underline :: Underlining- , blink :: BlinkSpeed- , fgIntensity :: ColorIntensity- , fgColor :: Color- , bgIntensity :: ColorIntensity- , consoleIntensity :: ConsoleIntensity- }+import Tldr.Types (ConsoleSetting(..))+import qualified Data.Text as T+import qualified Data.Text.IO as TIO defConsoleSetting :: ConsoleSetting defConsoleSetting =@@ -55,7 +45,7 @@ ] renderNode :: NodeType -> Handle -> IO ()-renderNode (TEXT txt) handle = TIO.hPutStrLn handle txt+renderNode (TEXT txt) handle = TIO.hPutStrLn handle (txt <> "\n") renderNode (HTML_BLOCK txt) handle = TIO.hPutStrLn handle txt renderNode (CODE_BLOCK _ txt) handle = TIO.hPutStrLn handle txt renderNode (HTML_INLINE txt) handle = TIO.hPutStrLn handle txt@@ -81,6 +71,7 @@ handleSubsetNodeType _ = mempty handleSubsetNode :: Node -> Text+handleSubsetNode (Node _ SOFTBREAK _) = "\n" handleSubsetNode (Node _ ntype xs) = handleSubsetNodeType ntype <> T.concat (Prelude.map handleSubsetNode xs)
+ src/Tldr/App.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Tldr.App+ ( appMain+ ) where++import Data.List (intercalate)+import Data.Semigroup ((<>))+import Data.Version (showVersion)+import Options.Applicative+import Paths_tldr (version)+import System.Environment (getArgs)+import Tldr.App.Constant (platformDirs)+import Tldr.App.Handler+import Tldr.Types+import Control.Monad (void)++programOptions :: Parser TldrOpts+programOptions =+ TldrOpts <$> (updateIndexCommand <|> viewPageCommand <|> aboutFlag)++updateIndexCommand :: Parser TldrCommand+updateIndexCommand =+ flag'+ UpdateIndex+ (long "update" <> short 'u' <> help "Update offline cache of tldr pages")++aboutFlag :: Parser TldrCommand+aboutFlag = flag' About (long "about" <> short 'a' <> help "About this program")++viewOptionsParser :: Parser ViewOptions+viewOptionsParser = ViewOptions <$> platformFlag <*> languageFlag++viewPageCommand :: Parser TldrCommand+viewPageCommand =+ ViewPage <$> viewOptionsParser <*>+ some (strArgument (metavar "COMMAND" <> help "name of the command"))++platformFlag :: Parser (Maybe String)+platformFlag =+ optional+ (strOption+ (long "platform" <> short 'p' <> metavar "PLATFORM" <>+ help+ ("Prioritize specfic platform while searching. Valid values include " <>+ platformHelpValue)))+ where+ platformHelpValue :: String+ platformHelpValue = intercalate ", " platformDirs++languageFlag :: Parser (Maybe String)+languageFlag =+ optional+ (strOption+ (long "language" <> short 'L' <> metavar "LOCALE" <>+ help+ "Preferred language for the page returned"))++tldrParserInfo :: ParserInfo TldrOpts+tldrParserInfo =+ info+ (helper <*> versionOption <*> 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")++appMain :: IO ()+appMain = do+ args <- getArgs+ case execParserPure (prefs showHelpOnEmpty) tldrParserInfo args of+ failOpts@(Failure _) -> void $ handleParseResult failOpts+ Success opts -> handleTldrOpts opts+ compOpts@(CompletionInvoked _) -> void $ handleParseResult compOpts
+ src/Tldr/App/Constant.hs view
@@ -0,0 +1,13 @@+module Tldr.App.Constant where++tldrDirName :: String+tldrDirName = "tldr"++repoHttpsUrl :: String+repoHttpsUrl = "https://github.com/tldr-pages/tldr.git"++checkDirs :: [String]+checkDirs = "common" : platformDirs++platformDirs :: [String]+platformDirs = ["linux", "osx", "windows", "sunos"]
+ src/Tldr/App/Handler.hs view
@@ -0,0 +1,156 @@+{-#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+++-- | Strip out duplicates+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
+ src/Tldr/Types.hs view
@@ -0,0 +1,34 @@+module Tldr.Types where++import System.Console.ANSI++data Locale = English | Missing | Other String | Unknown String++data ConsoleSetting =+ ConsoleSetting+ { italic :: Bool+ , underline :: Underlining+ , blink :: BlinkSpeed+ , fgIntensity :: ColorIntensity+ , fgColor :: Color+ , bgIntensity :: ColorIntensity+ , consoleIntensity :: ConsoleIntensity+ }++newtype TldrOpts = TldrOpts+ { tldrAction :: TldrCommand+ } deriving (Show)++data TldrCommand+ = UpdateIndex+ | ViewPage ViewOptions+ [String]+ | About+ deriving (Show, Eq, Ord)++data ViewOptions =+ ViewOptions+ { platformOption :: Maybe String+ , languageOption :: Maybe String+ }+ deriving (Show, Eq, Ord)
test/data/grep.golden view
@@ -1,5 +1,7 @@ grep-Matches patterns in input text.Supports simple patterns and regular expressions.++Matches patterns in input text.+Supports simple patterns and regular expressions. - Search for an exact string: grep {{search_string}} {{path/to/file}}
test/data/ls.golden view
@@ -1,4 +1,5 @@ ls+ List directory contents. - List files one per line:
test/data/ps.golden view
@@ -1,4 +1,5 @@ ps+ Information about running processes. - List all running processes:
tldr.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 10ec649ff467c4fa6cedd898599125c78e4b7c56269fac74fe81112e0fec75f9+-- hash: 6227f2af49b8d2a6bce7e1b2f3b3dd1df2bfe9922b13aaa8e10824c73f2d1b51 name: tldr-version: 0.7.1+version: 0.8.0 synopsis: Haskell tldr client description: Haskell tldr client with support for viewing tldr pages. Has offline cache for accessing pages. Visit https://tldr.sh for more details.@@ -42,6 +42,10 @@ library exposed-modules: Tldr+ Tldr.App+ Tldr.App.Constant+ Tldr.App.Handler+ Tldr.Types other-modules: Paths_tldr hs-source-dirs:@@ -51,7 +55,13 @@ , base >=4.7 && <5 , bytestring , cmark+ , containers+ , directory+ , filepath+ , optparse-applicative+ , semigroups , text+ , typed-process default-language: Haskell2010 executable tldr@@ -62,13 +72,7 @@ app build-depends: base- , containers- , directory- , filepath- , optparse-applicative- , semigroups , tldr- , typed-process if flag(static) && os(linux) ghc-options: -rtsopts -threaded -optc-Os -optl=-pthread -optl=-static -fPIC ld-options: -static