tldr-0.9.2/app/0000755000000000000000000000000014131502333011430 5ustar0000000000000000tldr-0.9.2/src/0000755000000000000000000000000014132455135011447 5ustar0000000000000000tldr-0.9.2/src/Tldr/0000755000000000000000000000000014132453662012357 5ustar0000000000000000tldr-0.9.2/src/Tldr/App/0000755000000000000000000000000014131466352013076 5ustar0000000000000000tldr-0.9.2/test/0000755000000000000000000000000014131466352011641 5ustar0000000000000000tldr-0.9.2/test/data/0000755000000000000000000000000014132453662012553 5ustar0000000000000000tldr-0.9.2/src/Tldr.hs0000644000000000000000000001067214132455135012716 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} module Tldr ( parsePage , renderPage , ConsoleSetting(..) , defConsoleSetting , headingSetting , toSGR , renderNode , changeConsoleSetting ) where import CMark import Control.Monad (forM_) import Data.Attoparsec.Text import Data.Monoid ((<>)) import Data.Text hiding (cons) import GHC.IO.Handle (Handle) import System.Console.ANSI import Tldr.Parser import Tldr.Types (ConsoleSetting(..), ColorSetting (..)) import qualified Data.Text as T import qualified Data.Text.IO as TIO defConsoleSetting :: ConsoleSetting defConsoleSetting = ConsoleSetting { italic = False , underline = NoUnderline , blink = NoBlink , fgIntensity = Dull , fgColor = White , bgIntensity = Dull , consoleIntensity = NormalIntensity } headingSetting :: ConsoleSetting headingSetting = defConsoleSetting {consoleIntensity = BoldIntensity} toSGR :: ColorSetting -> ConsoleSetting -> [SGR] toSGR color cons = case color of NoColor -> def UseColor -> SetColor Foreground (fgIntensity cons) (fgColor cons) : def where def = [ SetItalicized (italic cons) , SetConsoleIntensity (consoleIntensity cons) , SetUnderlining (underline cons) , SetBlinkSpeed (blink cons) ] reset :: ColorSetting -> IO () reset color = case color of NoColor -> pure () UseColor -> setSGR [Reset] renderNode :: NodeType -> ColorSetting -> Handle -> IO () renderNode nt@(TEXT txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle (txt <> "\n") >> reset color renderNode nt@(HTML_BLOCK txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle txt >> reset color renderNode nt@(CODE_BLOCK _ txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle txt >> reset color renderNode nt@(HTML_INLINE txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle txt >> reset color renderNode (CODE txt) color handle = renderCode color txt handle renderNode nt@LINEBREAK color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle "" >> reset color renderNode nt@(LIST _) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle "" >> TIO.hPutStr handle " - " >> reset color renderNode _ _ _ = return () renderCode :: ColorSetting -> Text -> Handle -> IO () renderCode color txt handle = do TIO.hPutStr handle (" ") case parseOnly codeParser txt of Right xs -> do forM_ xs $ \case Left x -> changeConsoleSetting color (CODE txt) >> TIO.hPutStr handle x >> reset color Right x -> TIO.hPutStr handle x Left _ -> changeConsoleSetting color (CODE txt) >> TIO.hPutStr handle txt >> reset color TIO.hPutStr handle ("\n") changeConsoleSetting :: ColorSetting -> NodeType -> IO () changeConsoleSetting color (HEADING _) = setSGR $ toSGR color headingSetting changeConsoleSetting color BLOCK_QUOTE = setSGR $ toSGR color headingSetting changeConsoleSetting color ITEM = setSGR $ toSGR color $ defConsoleSetting {fgColor = Green} changeConsoleSetting color (CODE _) = setSGR $ toSGR color $ defConsoleSetting {fgColor = Yellow} changeConsoleSetting _ _ = return () handleSubsetNodeType :: NodeType -> Text handleSubsetNodeType (HTML_BLOCK txt) = txt handleSubsetNodeType (CODE_BLOCK _ txt) = txt handleSubsetNodeType (TEXT txt) = txt handleSubsetNodeType (HTML_INLINE txt) = txt handleSubsetNodeType (CODE txt) = txt handleSubsetNodeType _ = mempty handleSubsetNode :: Node -> Text handleSubsetNode (Node _ SOFTBREAK _) = "\n" 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 handleNode :: Node -> Handle -> ColorSetting -> IO () handleNode (Node _ PARAGRAPH xs) handle _ = handleParagraph xs handle handleNode (Node _ ITEM xs) handle color = changeConsoleSetting color ITEM >> handleParagraph xs handle handleNode (Node _ ntype xs) handle color = do renderNode ntype color handle mapM_ (\(Node _ ntype' ns) -> renderNode ntype' color handle >> mapM_ (\n -> handleNode n handle color) ns) xs reset color parsePage :: FilePath -> IO Node parsePage fname = do page <- TIO.readFile fname let node = commonmarkToNode [] page return node renderPage :: FilePath -> Handle -> ColorSetting -> IO () renderPage fname handle color = do node <- parsePage fname handleNode node handle color tldr-0.9.2/src/Tldr/App.hs0000644000000000000000000000576014131466352013442 0ustar0000000000000000{-# 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) <*> autoUpdateIntervalOpt <*> colorFlags updateIndexCommand :: Parser TldrCommand updateIndexCommand = flag' UpdateIndex (long "update" <> short 'u' <> help "Update offline cache of tldr pages") autoUpdateIntervalOpt :: Parser (Maybe Int) autoUpdateIntervalOpt = optional (option auto (long "auto-update-interval" <> metavar "DAYS" <> help "Perform an automatic update if the cache is older than DAYS")) 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 a specific 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")) useColorFlag :: Parser (Maybe ColorSetting) useColorFlag = optional (flag' UseColor (long "color" <> help "Force colored output, overriding the NO_COLOR environment variable")) noColorFlag :: Parser (Maybe ColorSetting) noColorFlag = optional (flag' NoColor (long "no-color" <> help "Disable colored output")) colorFlags :: Parser (Maybe ColorSetting) colorFlags = useColorFlag <|> noColorFlag 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 tldr-0.9.2/src/Tldr/App/Constant.hs0000644000000000000000000000042514113433347015222 0ustar0000000000000000module Tldr.App.Constant where tldrDirName :: String tldrDirName = "tldr" pagesUrl :: String pagesUrl = "https://tldr.sh/assets/tldr.zip" checkDirs :: [String] checkDirs = "common" : platformDirs platformDirs :: [String] platformDirs = ["linux", "osx", "windows", "sunos"] tldr-0.9.2/src/Tldr/App/Handler.hs0000644000000000000000000001205514131466352015012 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE BangPatterns #-} module Tldr.App.Handler ( handleAboutFlag , retriveLocale , checkLocale , englishViewOptions , getCheckDirs , pageExists , getPagePath , updateTldrPages , handleTldrOpts ) where import Data.Char (toLower) import Data.List (intercalate) import Data.Maybe (fromMaybe) import Data.Semigroup ((<>)) import qualified Data.Set as Set import Data.Version (showVersion) import Data.Time.Clock import Control.Monad (when) import Options.Applicative import Paths_tldr (version) import System.Directory ( XdgDirectory(..) , createDirectory , removePathForcibly , doesFileExist , doesDirectoryExist , getModificationTime , getXdgDirectory ) import System.Environment (lookupEnv, getExecutablePath) import System.Exit (exitFailure) import System.FilePath ((<.>), ()) import System.IO (hPutStrLn, stderr, stdout) import Network.HTTP.Simple import Codec.Archive.Zip 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 shouldPerformUpdate <- updateNecessary opts when shouldPerformUpdate updateTldrPages 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 -> do defColor <- getNoColorEnv let color = fromMaybe defColor colorSetting renderPage path stdout color Nothing -> if checkLocale locale then do hPutStrLn stderr ("No tldr entry for " <> unwords pages) exitFailure else handleTldrOpts (opts { tldrAction = ViewPage (englishViewOptions voptions) pages }) updateNecessary :: TldrOpts -> IO Bool updateNecessary TldrOpts{..} = do dataDir <- getXdgDirectory XdgData tldrDirName dataDirExists <- doesDirectoryExist dataDir if not dataDirExists then return True else do lastCachedTime <- getModificationTime dataDir currentTime <- getCurrentTime let diffExceedsLimit limit = currentTime `diffUTCTime` lastCachedTime > fromIntegral limit * nominalDay return $ maybe False diffExceedsLimit autoUpdateInterval updateTldrPages :: IO () updateTldrPages = do dataDir <- getXdgDirectory XdgData tldrDirName removePathForcibly dataDir createDirectory dataDir putStrLn $ "Downloading tldr pages to " ++ dataDir response <- httpLBS $ parseRequest_ pagesUrl let zipArchive = toArchive $ getResponseBody response extractFilesFromArchive [OptDestination dataDir] zipArchive 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 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 getCheckDirs :: ViewOptions -> [String] getCheckDirs voptions = case platformOption voptions of Nothing -> checkDirs Just platform -> nubOrd $ ["common", platform] <> checkDirs getNoColorEnv :: IO ColorSetting getNoColorEnv = do noColorSet <- lookupEnv "NO_COLOR" return $ case noColorSet of Just _ -> NoColor Nothing -> UseColor -- | 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 tldr-0.9.2/src/Tldr/Parser.hs0000644000000000000000000000675414132453662014163 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE BangPatterns #-} module Tldr.Parser where import Prelude hiding (takeWhile) import Control.Applicative import Data.Attoparsec.Combinator import Data.Attoparsec.Text import Data.Text (Text) import qualified Data.Text as T -- $setup -- >>> :set -XOverloadedStrings -- >>> import Data.Attoparsec.Text -- | Parses '{{foo}}' blocks in CommonMark Code, such that: -- -- * `ls {{foo}} bar` -> `[Left "ls ", Right "foo", Left " bar"]` -- -- >>> parseOnly codeParser "" -- Right [] -- >>> parseOnly codeParser "tar" -- Right [Left "tar"] -- >>> parseOnly codeParser "tar{" -- Right [Left "tar{"] -- >>> parseOnly codeParser "tar{{" -- Right [Left "tar{{"] -- >>> parseOnly codeParser "tar{{{" -- Right [Left "tar{{{"] -- >>> parseOnly codeParser "tar}" -- Right [Left "tar}"] -- >>> parseOnly codeParser "tar{{{b}" -- Right [Left "tar{{{b}"] -- >>> parseOnly codeParser "tar{{{b}}" -- Right [Left "tar",Right "{b"] -- >>> parseOnly codeParser "tar{{b}}}" -- Right [Left "tar",Right "b}"] -- >>> parseOnly codeParser "tar xf {{source.tar[.gz|.bz2|.xz]}} --directory={{directory}}" -- Right [Left "tar xf ",Right "source.tar[.gz|.bz2|.xz]",Left " --directory=",Right "directory"] codeParser :: Parser [Either Text Text] codeParser = collectEither <$> outer where inner :: Parser [Either Text Text] inner = do _ <- char '{' _ <- char '{' l <- takeWhile (/= '}') e <- optional findEnd case e of Just e' -> (\o -> [Right (l <> e') ] <> o) <$> (outer <|> pure []) Nothing -> (\o -> [Left (T.pack "{{" <> l)] <> o) <$> (outer <|> pure []) where findEnd :: Parser Text findEnd = do c1 <- anyChar (p2, p3) <- peek2Chars case (c1, p2, p3) of ('}', Just '}', Just '}') -> (T.singleton '}' <>) <$> findEnd ('}', Just '}', _) -> mempty <$ anyChar _ -> fail ("Couldn't find end: " <> show (c1, p2, p3)) outer :: Parser [Either Text Text] outer = do o <- takeWhile (/= '{') (p1, p2) <- peek2Chars case (p1, p2) of (Just '{', Just '{') -> (\i -> [Left o ] <> i) <$> (inner <|> ((\t -> [Left t]) <$> takeText)) (Just '{', _) -> (\a b -> [Left (o <> T.singleton a)] <> b) <$> anyChar <*> outer _ -> pure [Left o] -- | Collect both Lefts and Rights, mappending them to zore or one item per connected sublist. -- -- >>> collectEither [] -- [] -- >>> collectEither [Right "abc", Right "def", Left "x", Left "z", Right "end"] -- [Right "abcdef",Left "xz",Right "end"] -- >>> collectEither [Right "", Right "def", Left "x", Left "", Right ""] -- [Right "def",Left "x"] collectEither :: (Eq a, Eq b, Monoid a, Monoid b) => [Either a b] -> [Either a b] collectEither = go Nothing where go Nothing [] = [] go (Just !x) [] | x == Right mempty || x == Left mempty = [] | otherwise = [x] go Nothing (Left b:br) = go (Just (Left b)) br go Nothing (Right b:br) = go (Just (Right b)) br go (Just (Left !a)) (Left b:br) = go (Just (Left (a <> b))) br go (Just (Right !a)) (Right b:br) = go (Just (Right (a <> b))) br go (Just !a) xs | a == Right mempty || a == Left mempty = go Nothing xs | otherwise = a:go Nothing xs -- | Peek 2 characters, not consuming any input. peek2Chars :: Parser (Maybe Char, Maybe Char) peek2Chars = lookAhead ((,) <$> optional anyChar <*> optional anyChar) tldr-0.9.2/src/Tldr/Types.hs0000644000000000000000000000154714131466352014025 0ustar0000000000000000module Tldr.Types where import System.Console.ANSI data Locale = English | Missing | Other String | Unknown String data ColorSetting = NoColor | UseColor deriving (Eq, Show, Ord, Enum, Bounded) data ConsoleSetting = ConsoleSetting { italic :: Bool , underline :: Underlining , blink :: BlinkSpeed , fgIntensity :: ColorIntensity , fgColor :: Color , bgIntensity :: ColorIntensity , consoleIntensity :: ConsoleIntensity } data TldrOpts = TldrOpts { tldrAction :: TldrCommand , autoUpdateInterval :: Maybe Int , colorSetting :: Maybe ColorSetting } 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) tldr-0.9.2/app/Main.hs0000644000000000000000000000015514113433347012661 0ustar0000000000000000module Main where import Tldr.App ( appMain ) main :: IO () main = appMain tldr-0.9.2/test/Spec.hs0000644000000000000000000000215614131466352013073 0ustar0000000000000000import Tldr import Tldr.Types (ColorSetting(..)) import Test.Tasty import Test.Tasty.Golden (goldenVsFile) import System.IO (withBinaryFile, IOMode(..)) import Data.Monoid ((<>)) tests :: TestTree tests = testGroup "tldr Tests" [goldenTests] goldenTests :: TestTree goldenTests = testGroup "Golden tests" [gtests] renderPageToFile :: FilePath -> FilePath -> IO () renderPageToFile mdfile opfile = do withBinaryFile opfile WriteMode (\handle -> renderPage mdfile handle UseColor) -- For adding new command, you need to add: -- A new ".md" file for that command -- A new ".golden" file for the expected output commandTest :: String -> TestTree commandTest str = goldenVsFile (str <> " test") (golden str) (output str) (renderPageToFile (md str) (output str)) where prefix = "test/data/" golden cmd = prefix <> cmd <> ".golden" output cmd = prefix <> cmd <> ".output" md cmd = prefix <> cmd <> ".md" gtests :: TestTree gtests = testGroup "(render test)" [ commandTest "ls" , commandTest "ps" , commandTest "grep" ] main :: IO () main = defaultMain tests tldr-0.9.2/LICENSE0000644000000000000000000000277014113433347011673 0ustar0000000000000000Copyright Sibi Prabakaran (c) 2017 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Author name here nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. tldr-0.9.2/Setup.hs0000644000000000000000000000007014113433347012311 0ustar0000000000000000import Distribution.Simple main = defaultMain tldr-0.9.2/tldr.cabal0000644000000000000000000000425714132455325012622 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack name: tldr version: 0.9.2 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. category: Web, CLI homepage: https://github.com/psibi/tldr-hs#readme bug-reports: https://github.com/psibi/tldr-hs/issues author: Sibi Prabakaran maintainer: sibi@psibi.in copyright: 2017 Sibi Prabakaran license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: README.md CHANGELOG.md test/data/grep.golden test/data/ls.golden test/data/ps.golden test/data/grep.md test/data/ls.md test/data/ps.md source-repository head type: git location: https://github.com/psibi/tldr-hs flag static description: Statically link executables. manual: True default: False library exposed-modules: Tldr Tldr.App Tldr.App.Constant Tldr.App.Handler Tldr.Parser Tldr.Types other-modules: Paths_tldr hs-source-dirs: src ghc-options: -Wall -O2 build-depends: ansi-terminal , attoparsec , base >=4.7 && <5 , bytestring , cmark , containers , directory , filepath , http-conduit , optparse-applicative , semigroups , text , time , zip-archive default-language: Haskell2010 executable tldr main-is: Main.hs other-modules: Paths_tldr hs-source-dirs: app ghc-options: -Wall -O2 build-depends: base , tldr if flag(static) && os(linux) ghc-options: -rtsopts -threaded -optc-Os -optl=-pthread -optl=-static -fPIC ld-options: -static else ghc-options: -rtsopts -threaded default-language: Haskell2010 test-suite tldr-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Paths_tldr hs-source-dirs: test ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N build-depends: base , tasty , tasty-golden , tldr default-language: Haskell2010 tldr-0.9.2/README.md0000644000000000000000000000623614113433347012146 0ustar0000000000000000# tldr [![Build Status](https://dev.azure.com/psibi2000/tldr-hs/_apis/build/status/psibi.tldr-hs?branchName=master)](https://dev.azure.com/psibi2000/tldr-hs/_build/latest?definitionId=5?branchName=master) [![Hackage](https://img.shields.io/hackage/v/tldr.svg)](https://hackage.haskell.org/package/tldr) [![Stackage Nightly](http://stackage.org/package/tldr/badge/nightly)](http://stackage.org/nightly/package/tldr) [![Stackage LTS](http://stackage.org/package/tldr/badge/lts)](http://stackage.org/lts/package/tldr) Haskell client for tldr **Table of Contents** - [tldr](#tldr) - [Installation](#installation) - [Usage](#usage) - [Offline caching](#offline-caching) - [Snapshot](#snapshot) ## Installation See Github releases: https://github.com/psibi/tldr-hs/releases Executables are available for all the three major platforms: Linux, Windows and MacOS. Or 1. [Install stack](https://docs.haskellstack.org/en/stable/README/#how-to-install) 2. `stack install tldr` ## Usage ``` shellsession $ tldr --help tldr - Simplified and community-driven man pages Usage: tldr [-v|--version] ((-u|--update) | [-p|--platform PLATFORM] [-L|--language LOCALE] COMMAND | (-a|--about)) tldr Client program Available options: -h,--help Show this help text -v,--version Show version -u,--update Update offline cache of tldr pages -p,--platform PLATFORM Prioritize a specific platform while searching. Valid values include linux, osx, windows, sunos -L,--language LOCALE Preferred language for the page returned COMMAND name of the command -a,--about About this program --auto-update-interval DAYS Perform an automatic update if the cache is older than DAYS ``` 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}} ``` ## Offline caching On the first run, this program caches all available tldr pages. Since the number of available tldr pages rises quickly, it is recommended to regularly update the cache. Such an update can be run manually with: ``` shellsession $ tldr --update ``` Starting with version `0.9.0`, users of this client can enable automatic updates by running it with the option `--auto-update-interval DAYS` specified. The client will then check whether the cached version of the tldr pages is older than `DAYS` days and perform an update in that case. To enable this functionality permanently, users can put the line `alias tldr="tldr --auto-update-interval DAYS"` in their shell configuration file (e.g. `.bashrc`, `.zshrc`) with the desired update interval specified. ## Snapshot ![tldr](https://cloud.githubusercontent.com/assets/737477/24076451/2a5a604c-0c57-11e7-9bf7-13d76e8e7f12.png) tldr-0.9.2/CHANGELOG.md0000644000000000000000000000422314132455243012472 0ustar0000000000000000# 0.9.2 * [Apply better coloring](https://github.com/psibi/tldr-hs/pull/43 "https://github.com/psibi/tldr-hs/pull/43") # 0.9.1 * When the [`NO_COLOR`](https://no-color.org/) environment variable is set, the client will not color the output. * Added `--[no-]color` options which enable/disable output coloring (overrides `NO_COLOR`). # 0.9.0 * When pages are updated, the client now shows the download location. * Add optional auto-update functionality (`--auto-update-interval`) # 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. # 0.7.0 * Make it obey --language (-L) option. # 0.6.4 * Fix cabal file # 0.6.3 * Drop `-optl-static` for linux builds # 0.6.2 * package.yaml support for configuring package * CI releases binary now # 0.6.1 * Implement --about option # 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 # 0.5.0 * Obey XdgData for storing the files. * Also search pages from sunos directory now. * Support subcommands ie. tldr git submodule will now work. # 0.4.0.2 * Fix double initialization bug. Credits to @Kove-W-O-Salter # 0.4.0 * Add proper coloring back * Update gitignore rule * Update travis and appveyor configuration # 0.3.1 * Add golden testing using tasty * Fix grep render [#11](https://github.com/psibi/tldr-hs/issues/11) * Fixes [#2](https://github.com/psibi/tldr-hs/issues/2) # 0.3.0 * Add default completion support from optparse-applicative * Add windows support. Credits to @ShrykeWindgrace. # 0.2.5 * Fix eager cloning # 0.2.4 * Don't do cloning unnecessarily [#7](https://github.com/psibi/tldr-hs/issues/7) * Fix Paths_tldr warning from cabal # 0.2.3 * Fix coloring bug under bash during some circumstances [#6](https://github.com/psibi/tldr-hs/pull/6/files) # 0.2.2 * Fix `--version` option # 0.2.1 * Fix background color [bug](https://github.com/psibi/tldr-hs/pull/3) # 0.2.0 * Compliance with the tldr spec * Fix `--update` flag bug * Backported till GHC 7.8.3 and lts-2.22 tldr-0.9.2/test/data/grep.golden0000644000000000000000000000150614132453662014704 0ustar0000000000000000grep Matches patterns in input text. Supports simple patterns and regular expressions. - Search for an exact string: grep search_string path/to/file - Search in case-insensitive mode: grep -i search_string path/to/file - Search recursively (ignoring non-text files) in current directory for an exact string: grep -RI search_string . - Use extended regular expressions (supporting ?, +, {}, () and |): grep -E ^regex$ path/to/file - Print 3 lines of [C]ontext around, [B]efore, or [A]fter each match: grep -C|B|A 3 search_string path/to/file - Print file name with the corresponding line number for each match: grep -Hn search_string path/to/file - Use the standard input instead of a file: cat path/to/file | grep search_string - Invert match for excluding specific strings: grep -v search_string tldr-0.9.2/test/data/ls.golden0000644000000000000000000000071414113433347014362 0ustar0000000000000000ls List directory contents. - List files one per line: ls -1 - List all files, including hidden files: ls -a - Long format list (permissions, ownership, size and modification date) of all files: ls -la - Long format list with size displayed using human readable units (KB, MB, GB): ls -lh - Long format list sorted by size (descending): ls -lS - Long format list of all files, sorted by modification date (oldest first): ls -ltr tldr-0.9.2/test/data/ps.golden0000644000000000000000000000071414132453662014371 0ustar0000000000000000ps Information about running processes. - List all running processes: ps aux - List all running processes including the full command string: ps auxww - Search for a process that matches a string: ps aux | grep string - List all processes of the current user in extra full format: ps --user $(id -u) -F - List all processes of the current user as a tree: ps --user $(id -u) f - Get the parent pid of a process: ps -o ppid= -p pid tldr-0.9.2/test/data/grep.md0000644000000000000000000000161214113433347014027 0ustar0000000000000000# grep > Matches patterns in input text. > Supports simple patterns and regular expressions. - Search for an exact string: `grep {{search_string}} {{path/to/file}}` - Search in case-insensitive mode: `grep -i {{search_string}} {{path/to/file}}` - Search recursively (ignoring non-text files) in current directory for an exact string: `grep -RI {{search_string}} .` - Use extended regular expressions (supporting `?`, `+`, `{}`, `()` and `|`): `grep -E {{^regex$}} {{path/to/file}}` - Print 3 lines of [C]ontext around, [B]efore, or [A]fter each match: `grep -{{C|B|A}} 3 {{search_string}} {{path/to/file}}` - Print file name with the corresponding line number for each match: `grep -Hn {{search_string}} {{path/to/file}}` - Use the standard input instead of a file: `cat {{path/to/file}} | grep {{search_string}}` - Invert match for excluding specific strings: `grep -v {{search_string}}` tldr-0.9.2/test/data/ls.md0000644000000000000000000000071214113433347013510 0ustar0000000000000000# ls > List directory contents. - List files one per line: `ls -1` - List all files, including hidden files: `ls -a` - Long format list (permissions, ownership, size and modification date) of all files: `ls -la` - Long format list with size displayed using human readable units (KB, MB, GB): `ls -lh` - Long format list sorted by size (descending): `ls -lS` - Long format list of all files, sorted by modification date (oldest first): `ls -ltr` tldr-0.9.2/test/data/ps.md0000644000000000000000000000072214113433347013515 0ustar0000000000000000# ps > Information about running processes. - List all running processes: `ps aux` - List all running processes including the full command string: `ps auxww` - Search for a process that matches a string: `ps aux | grep {{string}}` - List all processes of the current user in extra full format: `ps --user $(id -u) -F` - List all processes of the current user as a tree: `ps --user $(id -u) f` - Get the parent pid of a process: `ps -o ppid= -p {{pid}}`