tldr-0.4.0.1/app/0000755000000000000000000000000013351452332011566 5ustar0000000000000000tldr-0.4.0.1/src/0000755000000000000000000000000013351501476011601 5ustar0000000000000000tldr-0.4.0.1/test/0000755000000000000000000000000013351471127011770 5ustar0000000000000000tldr-0.4.0.1/test/data/0000755000000000000000000000000013351471131012674 5ustar0000000000000000tldr-0.4.0.1/src/Tldr.hs0000644000000000000000000000661213351501455013044 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Tldr ( parsePage , renderPage , ConsoleSetting(..) , defConsoleSetting , headingSetting , toSGR , renderNode , 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 GHC.IO.Handle (Handle) 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_ (flip 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.4.0.1/app/Main.hs0000644000000000000000000000643413351452332013015 0ustar0000000000000000{-#LANGUAGE CPP#-} {-#LANGUAGE ScopedTypeVariables#-} module Main where import Tldr import Options.Applicative hiding ((<>)) import Data.Semigroup ((<>)) import Control.Monad import System.Directory import System.FilePath import System.Process.Typed import System.Environment (getArgs, withArgs) import GHC.IO.Handle.FD (stdout) import Paths_tldr (version) import Data.Version (showVersion) data TldrOpts = TldrOpts { pageName :: String } deriving (Show) tldrDirName :: String tldrDirName = ".tldr" repoHttpsUrl :: String repoHttpsUrl = "https://github.com/tldr-pages/tldr.git" checkDirs :: [String] checkDirs = ["common", "linux", "osx"] tldrInitialized :: IO Bool tldrInitialized = do homeDir <- getHomeDirectory let dir1 = homeDir tldrDirName dir2 = homeDir tldrDirName "tldr" pages = homeDir tldrDirName "tldr" "pages" exists <- mapM doesDirectoryExist [dir1, dir2, pages] return $ all (== True) exists initializeTldrPages :: IO () initializeTldrPages = do initialized <- tldrInitialized initialized <- tldrInitialized unless initialized $ do homeDir <- getHomeDirectory let cloneDir = homeDir tldrDirName runProcess_ $ proc "mkdir" [cloneDir] runProcess_ $ setWorkingDir cloneDir $ proc "git" ["clone", repoHttpsUrl] updateTldrPages :: IO () updateTldrPages = do homeDir <- getHomeDirectory let repoDir = homeDir tldrDirName "tldr" repoExists <- doesDirectoryExist repoDir when repoExists $ do runProcess_ $ setWorkingDir repoDir $ proc "git" ["pull", "origin", "master"] updateOption :: Parser (a -> a) updateOption = infoOption "update" (long "update" <> help "Update tldr pages") tldrParserInfo :: ParserInfo TldrOpts tldrParserInfo = info (helper <*> versionOption <*> updateOption <*> 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") programOptions :: Parser TldrOpts programOptions = (TldrOpts <$> strArgument (metavar "COMMAND" <> help "name of the command")) pageExists :: FilePath -> IO (Maybe FilePath) pageExists fname = do exists <- doesFileExist fname if exists then return $ Just fname else return Nothing getPagePath :: String -> IO (Maybe FilePath) getPagePath page = do homeDir <- getHomeDirectory let pageDir = homeDir tldrDirName "tldr" "pages" x@(f1:f2:f3:[]) = map (\x -> pageDir x page <.> "md") checkDirs #if MIN_VERSION_base(4,7,0) f1' <- pageExists f1 f2' <- pageExists f2 f3' <- pageExists f3 return $ f1' <|> f2' <|> f3' #else pageExists f1 <|> pageExists f2 <|> pageExists f3 #endif main :: IO () main = do args <- getArgs case execParserPure (prefs noBacktrack) tldrParserInfo args of failOpts@(Failure _) | args == ["--update"] -> updateTldrPages | otherwise -> handleParseResult failOpts >> return () Success opts -> do initializeTldrPages let page = pageName opts fname <- getPagePath page maybe (putStrLn ("No tldr entry for " <> page)) (flip renderPage stdout) fname compOpts@(CompletionInvoked _) -> handleParseResult compOpts >> return () tldr-0.4.0.1/test/Spec.hs0000644000000000000000000000210113351471127013210 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.4.0.1/LICENSE0000644000000000000000000000277013351443165012025 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.4.0.1/Setup.hs0000644000000000000000000000005613351443165012447 0ustar0000000000000000import Distribution.Simple main = defaultMain tldr-0.4.0.1/tldr.cabal0000644000000000000000000000323413373606161012746 0ustar0000000000000000name: tldr version: 0.4.0.1 synopsis: Haskell tldr client description: Haskell tldr client with support for updating and viewing tldr pages. homepage: https://github.com/psibi/tldr-hs#readme license: BSD3 license-file: LICENSE author: Sibi maintainer: sibi@psibi.in copyright: 2017 Sibi category: Web build-type: Simple extra-source-files: README.md, CHANGELOG.md, test/data/*.golden, test/data/*.md cabal-version: >=1.10 library hs-source-dirs: src exposed-modules: Tldr build-depends: base >= 4.7 && < 5, cmark, text, bytestring, ansi-terminal default-language: Haskell2010 executable tldr hs-source-dirs: app main-is: Main.hs other-modules: Paths_tldr ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , tldr , optparse-applicative , directory , filepath , typed-process , semigroups default-language: Haskell2010 test-suite tldr-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs build-depends: base , tldr , tasty , tasty-golden ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 source-repository head type: git location: https://github.com/psibi/tldr-hs tldr-0.4.0.1/README.md0000644000000000000000000000231513351443165012272 0ustar0000000000000000# tldr [![Linux build](https://travis-ci.org/psibi/tldr-hs.svg?branch=master)](https://travis-ci.org/psibi/tldr-hs) [![Window build](https://ci.appveyor.com/api/projects/status/wlqa2ndsquk1psqs/branch/master?svg=true)](https://ci.appveyor.com/project/psibi/tldr-hs/branch/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 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] [--update] COMMAND tldr Client program Available options: -h,--help Show this help text -v,--version Show version --update Update tldr pages COMMAND name of the command ``` ## Snapshot ![tldr](https://cloud.githubusercontent.com/assets/737477/24076451/2a5a604c-0c57-11e7-9bf7-13d76e8e7f12.png) tldr-0.4.0.1/CHANGELOG.md0000644000000000000000000000170313373607324012627 0ustar0000000000000000# 0.4.0.1 * 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.4.0.1/test/data/grep.golden0000644000000000000000000000160013351471117015024 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.4.0.1/test/data/ls.golden0000644000000000000000000000071313351454521014511 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.4.0.1/test/data/ps.golden0000644000000000000000000000072313351460645014522 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.4.0.1/test/data/ps.md0000644000000000000000000000072213351460622013644 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}}` tldr-0.4.0.1/test/data/ls.md0000644000000000000000000000071213351454577013653 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.4.0.1/test/data/grep.md0000644000000000000000000000161213351454715014164 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}}`