packages feed

tldr 0.7.1 → 0.8.0

raw patch · 11 files changed

+312/−255 lines, 11 files

Files

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