tldr-0.6.4/app/0000755000000000000000000000000013640274733011445 5ustar0000000000000000tldr-0.6.4/src/0000755000000000000000000000000013552643653011457 5ustar0000000000000000tldr-0.6.4/test/0000755000000000000000000000000013552626303011640 5ustar0000000000000000tldr-0.6.4/test/data/0000755000000000000000000000000013552370477012561 5ustar0000000000000000tldr-0.6.4/src/Tldr.hs0000644000000000000000000000655413552643653012732 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Tldr ( parsePage , renderPage , ConsoleSetting(..) , defConsoleSetting , headingSetting , toSGR , renderNode , changeConsoleSetting ) where 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 } 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 :: ConsoleSetting -> [SGR] toSGR cons = [ SetItalicized (italic cons) , SetConsoleIntensity (consoleIntensity cons) , SetUnderlining (underline cons) , SetBlinkSpeed (blink cons) , SetColor Foreground (fgIntensity cons) (fgColor cons) ] renderNode :: NodeType -> Handle -> IO () 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 () changeConsoleSetting :: NodeType -> IO () changeConsoleSetting (HEADING _) = setSGR $ toSGR headingSetting changeConsoleSetting BLOCK_QUOTE = setSGR $ toSGR headingSetting changeConsoleSetting ITEM = setSGR $ toSGR $ defConsoleSetting {fgColor = Green} changeConsoleSetting (CODE _) = setSGR $ toSGR $ 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 _ 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 -> IO () handleNode (Node _ PARAGRAPH xs) handle = 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 setSGR [Reset] parsePage :: FilePath -> IO Node parsePage fname = do page <- TIO.readFile fname let node = commonmarkToNode [] page return node renderPage :: FilePath -> Handle -> IO () renderPage fname handle = do node <- parsePage fname handleNode node handle tldr-0.6.4/app/Main.hs0000644000000000000000000001221613611002220012641 0ustar0000000000000000{-# 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 GHC.IO.Handle.FD (stdout) import Options.Applicative import Paths_tldr (version) import System.Directory import System.Environment (getArgs, getExecutablePath) import System.FilePath import System.Process.Typed 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 } deriving (Show, Eq, Ord) 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 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" 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 :: 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") 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 TldrOpts {..} = do case tldrAction of UpdateIndex -> updateTldrPages About -> handleAboutFlag 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 _) -> handleParseResult failOpts >> return () Success opts -> handleTldrOpts opts compOpts@(CompletionInvoked _) -> handleParseResult compOpts >> return () tldr-0.6.4/test/Spec.hs0000644000000000000000000000210113535631576013071 0ustar0000000000000000import Tldr 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) -- 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.6.4/LICENSE0000644000000000000000000000277013535631576011705 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.6.4/Setup.hs0000644000000000000000000000005613535631576012327 0ustar0000000000000000import Distribution.Simple main = defaultMain tldr-0.6.4/tldr.cabal0000644000000000000000000000366513640274741012627 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack -- -- hash: 6d6a28bd0b56fd00a272f305ae388900bd3a5e235b44afb32bd4e758846bf2f7 name: tldr version: 0.6.4 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 library exposed-modules: Tldr other-modules: Paths_tldr hs-source-dirs: src build-depends: ansi-terminal , base >=4.7 && <5 , bytestring , cmark , text default-language: Haskell2010 executable tldr main-is: Main.hs other-modules: Paths_tldr hs-source-dirs: app build-depends: base , containers , directory , filepath , optparse-applicative , semigroups , tldr , typed-process if os(linux) ghc-options: -threaded -optl-pthread -rtsopts -with-rtsopts=-N else ghc-options: -threaded -rtsopts -with-rtsopts=-N 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: -threaded -rtsopts -with-rtsopts=-N build-depends: base , tasty , tasty-golden , tldr default-language: Haskell2010 tldr-0.6.4/README.md0000644000000000000000000000350213613315621012134 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 ## 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] COMMAND) 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 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 ![tldr](https://cloud.githubusercontent.com/assets/737477/24076451/2a5a604c-0c57-11e7-9bf7-13d76e8e7f12.png) tldr-0.6.4/CHANGELOG.md0000644000000000000000000000265413640274727012510 0ustar0000000000000000# 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.6.4/test/data/grep.golden0000644000000000000000000000160013535631576014706 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.6.4/test/data/ls.golden0000644000000000000000000000071313535631576014373 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.6.4/test/data/ps.golden0000644000000000000000000000072313535631576014400 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.6.4/test/data/grep.md0000644000000000000000000000161213535631576014041 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.6.4/test/data/ls.md0000644000000000000000000000071213535631576013522 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.6.4/test/data/ps.md0000644000000000000000000000072213535631576013527 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}}`