tldr 0.5.1 → 0.6.0
raw patch · 5 files changed
+158/−95 lines, 5 filesdep +containers
Dependencies added: containers
Files
- CHANGELOG.md +7/−1
- README.md +21/−2
- app/Main.hs +84/−41
- src/Tldr.hs +42/−49
- tldr.cabal +4/−2
CHANGELOG.md view
@@ -1,3 +1,9 @@+# 0.6.0++* Make it obey --platform option+* Add -u as an alias for --update+* Make parsing more robust+ # 0.5.1 * Proper options handling@@ -6,7 +12,7 @@ * Obey XdgData for storing the files. * Also search pages from sunos directory now.-* Support subcommansds ie. tldr git submodule will now work.+* Support subcommands ie. tldr git submodule will now work. # 0.4.0.2
README.md view
@@ -19,14 +19,33 @@ $ tldr --help tldr - Simplified and community-driven man pages -Usage: tldr [-v|--version] [--update] COMMAND+Usage: tldr [-v|--version] ((-u|--update) | [-p|--platform PLATFORM] COMMAND) tldr Client program Available options: -h,--help Show this help text -v,--version Show version- --update Update tldr pages+ -u,--update Update offline cache of tldr pages+ -p,--platform PLATFORM Prioritize specfic platform while searching. Valid+ values include linux, osx, windows, sunos COMMAND name of the command+```++Or a much better example of the usage:++``` shellsession+$ tldr tldr+tldr+Simplified man pages.More information: https://tldr.sh.++ - Get typical usages of a command (hint: this is how you got here!):+ tldr {{command}}++ - Show the tar tldr page for linux:+ tldr -p {{linux}} {{tar}}++ - Get help for a git subcommand:+ tldr {{git checkout}} ``` ## Snapshot
app/Main.hs view
@@ -1,26 +1,71 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE BangPatterns #-} -module Main where+module Main+ ( main+ ) where import Control.Monad-import Data.List (intercalate, isPrefixOf)+import Data.List (intercalate) import Data.Semigroup ((<>))+import qualified Data.Set as Set import Data.Version (showVersion) import GHC.IO.Handle.FD (stdout)-import Options.Applicative hiding ((<>))+import Options.Applicative import Paths_tldr (version) import System.Directory-import System.Environment (getArgs, withArgs)+import System.Environment (getArgs) import System.FilePath import System.Process.Typed import Tldr data TldrOpts = TldrOpts- { pageName :: String+ { tldrAction :: TldrCommand } deriving (Show) +data TldrCommand+ = UpdateIndex+ | ViewPage ViewOptions [String]+ deriving (Show, Eq, Ord)++data ViewOptions =+ ViewOptions+ { platformOption :: Maybe String+ }+ deriving (Show, Eq, Ord)++programOptions :: Parser TldrOpts+programOptions = (TldrOpts <$> (updateIndexCommand <|> viewPageCommand))++updateIndexCommand :: Parser TldrCommand+updateIndexCommand =+ flag'+ UpdateIndex+ (long "update" <> short 'u' <> help "Update offline cache of tldr pages")++viewOptionsParser :: Parser ViewOptions+viewOptionsParser = ViewOptions <$> platformFlag++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+ tldrDirName :: String tldrDirName = "tldr" @@ -28,8 +73,11 @@ repoHttpsUrl = "https://github.com/tldr-pages/tldr.git" checkDirs :: [String]-checkDirs = ["common", "linux", "osx", "windows", "sunos"]+checkDirs = "common" : platformDirs +platformDirs :: [String]+platformDirs = ["linux", "osx", "windows", "sunos"]+ tldrInitialized :: IO Bool tldrInitialized = do dataDir <- getXdgDirectory XdgData tldrDirName@@ -57,13 +105,10 @@ 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)+ (helper <*> versionOption <*> programOptions) (fullDesc <> progDesc "tldr Client program" <> header "tldr - Simplified and community-driven man pages") where@@ -73,10 +118,6 @@ (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@@ -84,41 +125,43 @@ then return $ Just fname else return Nothing -getPagePath :: String -> IO (Maybe FilePath)-getPagePath page = do+getPagePath :: String -> [String] -> IO (Maybe FilePath)+getPagePath page platformDirs = do dataDir <- getXdgDirectory XdgData tldrDirName let pageDir = dataDir </> "tldr" </> "pages"- paths = map (\x -> pageDir </> x </> page <.> "md") checkDirs+ paths = map (\x -> pageDir </> x </> page <.> "md") platformDirs foldr1 (<|>) <$> mapM pageExists paths -isOption :: String -> Bool-isOption string = "--" `isPrefixOf` string+getCheckDirs :: ViewOptions -> [String]+getCheckDirs voptions =+ case platformOption voptions of+ Nothing -> checkDirs+ Just platform -> nubOrd $ ["common", platform] <> checkDirs -hasOption :: [String] -> Bool-hasOption xs = any isOption xs+-- | 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 +handleTldrOpts :: TldrOpts -> IO ()+handleTldrOpts TldrOpts {..} = do+ case tldrAction of+ UpdateIndex -> updateTldrPages+ ViewPage voptions pages -> do+ let npage = intercalate "-" pages+ fname <- getPagePath npage (getCheckDirs voptions)+ case fname of+ Just path -> renderPage path stdout+ Nothing -> putStrLn ("No tldr entry for " <> (intercalate " " pages))+ main :: IO () main = do args <- getArgs case execParserPure (prefs showHelpOnEmpty) tldrParserInfo args of- failOpts@(Failure _)- | args == ["--update"] -> updateTldrPages- | otherwise ->- if (hasOption args || 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+ failOpts@(Failure _) -> handleParseResult failOpts >> return ()+ Success opts -> handleTldrOpts opts compOpts@(CompletionInvoked _) -> handleParseResult compOpts >> return ()
src/Tldr.hs view
@@ -11,41 +11,39 @@ , changeConsoleSetting ) where -import Data.Text-import qualified Data.Text as T-import qualified Data.Text.IO as TIO import CMark-import System.Console.ANSI 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- }+data ConsoleSetting =+ ConsoleSetting+ { italic :: Bool+ , underline :: Underlining+ , blink :: BlinkSpeed+ , fgIntensity :: ColorIntensity+ , fgColor :: Color+ , bgIntensity :: ColorIntensity+ , consoleIntensity :: ConsoleIntensity+ } defConsoleSetting :: ConsoleSetting defConsoleSetting = ConsoleSetting- { italic = False- , underline = NoUnderline- , blink = NoBlink- , fgIntensity = Dull- , fgColor = White- , bgIntensity = Dull- , consoleIntensity = NormalIntensity- }+ { italic = False+ , underline = NoUnderline+ , blink = NoBlink+ , fgIntensity = Dull+ , fgColor = White+ , bgIntensity = Dull+ , consoleIntensity = NormalIntensity+ } headingSetting :: ConsoleSetting-headingSetting =- defConsoleSetting- { consoleIntensity = BoldIntensity- }+headingSetting = defConsoleSetting {consoleIntensity = BoldIntensity} toSGR :: ConsoleSetting -> [SGR] toSGR cons =@@ -57,30 +55,21 @@ ] renderNode :: NodeType -> Handle -> IO ()-renderNode (TEXT txt) handle = TIO.hPutStrLn handle txt-renderNode (HTML_BLOCK txt) handle = TIO.hPutStrLn handle txt+renderNode (TEXT txt) handle = TIO.hPutStrLn handle txt+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-renderNode (CODE txt) handle = TIO.hPutStrLn handle (" " <> txt)-renderNode LINEBREAK handle = TIO.hPutStrLn handle ""-renderNode (LIST _) handle = TIO.hPutStrLn handle "" >> TIO.hPutStr handle " - "-renderNode _ _ = return ()+renderNode (HTML_INLINE txt) handle = TIO.hPutStrLn handle txt+renderNode (CODE txt) handle = TIO.hPutStrLn handle (" " <> txt)+renderNode LINEBREAK handle = TIO.hPutStrLn handle ""+renderNode (LIST _) handle = TIO.hPutStrLn handle "" >> TIO.hPutStr handle " - "+renderNode _ _ = return () changeConsoleSetting :: NodeType -> IO () changeConsoleSetting (HEADING _) = setSGR $ toSGR headingSetting changeConsoleSetting BLOCK_QUOTE = setSGR $ toSGR headingSetting-changeConsoleSetting ITEM =- setSGR $- toSGR $- defConsoleSetting- { fgColor = Green- }+changeConsoleSetting ITEM = setSGR $ toSGR $ defConsoleSetting {fgColor = Green} changeConsoleSetting (CODE _) =- setSGR $- toSGR $- defConsoleSetting- { fgColor = Yellow- }+ setSGR $ toSGR $ defConsoleSetting {fgColor = Yellow} changeConsoleSetting _ = return () handleSubsetNodeType :: NodeType -> Text@@ -91,21 +80,25 @@ handleSubsetNodeType (CODE txt) = txt handleSubsetNodeType _ = mempty - handleSubsetNode :: Node -> Text-handleSubsetNode (Node _ ntype xs) = handleSubsetNodeType ntype <> T.concat (Prelude.map handleSubsetNode xs)+handleSubsetNode (Node _ ntype xs) =+ handleSubsetNodeType ntype <> T.concat (Prelude.map handleSubsetNode xs) handleParagraph :: [Node] -> Handle -> IO ()-handleParagraph xs handle = TIO.hPutStrLn handle $ T.concat $ Prelude.map handleSubsetNode xs-+handleParagraph xs handle =+ TIO.hPutStrLn handle $ T.concat $ Prelude.map handleSubsetNode xs handleNode :: Node -> Handle -> IO () handleNode (Node _ PARAGRAPH xs) handle = handleParagraph xs handle-handleNode (Node _ ITEM xs) handle = changeConsoleSetting ITEM >> handleParagraph xs handle+handleNode (Node _ ITEM xs) handle =+ changeConsoleSetting ITEM >> handleParagraph xs handle handleNode (Node _ ntype xs) handle = do changeConsoleSetting ntype renderNode ntype handle- mapM_ (\(Node _ ntype' ns) -> renderNode ntype' handle >> mapM_ (`handleNode` handle) ns) xs+ mapM_+ (\(Node _ ntype' ns) ->+ renderNode ntype' handle >> mapM_ (`handleNode` handle) ns)+ xs setSGR [Reset] parsePage :: FilePath -> IO Node
tldr.cabal view
@@ -1,7 +1,8 @@ name: tldr-version: 0.5.1+version: 0.6.0 synopsis: Haskell tldr client-description: Haskell tldr client with support for updating and viewing tldr pages.+description: Haskell tldr client with support for viewing tldr pages. Has offline+ cache for accessing pages. Visit https://tldr.sh for more details. homepage: https://github.com/psibi/tldr-hs#readme license: BSD3 license-file: LICENSE@@ -35,6 +36,7 @@ , filepath , typed-process , semigroups+ , containers default-language: Haskell2010 test-suite tldr-test