diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/src/Tldr.hs b/src/Tldr.hs --- a/src/Tldr.hs +++ b/src/Tldr.hs @@ -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) diff --git a/src/Tldr/App.hs b/src/Tldr/App.hs new file mode 100644 --- /dev/null +++ b/src/Tldr/App.hs @@ -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 diff --git a/src/Tldr/App/Constant.hs b/src/Tldr/App/Constant.hs new file mode 100644 --- /dev/null +++ b/src/Tldr/App/Constant.hs @@ -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"] diff --git a/src/Tldr/App/Handler.hs b/src/Tldr/App/Handler.hs new file mode 100644 --- /dev/null +++ b/src/Tldr/App/Handler.hs @@ -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 diff --git a/src/Tldr/Types.hs b/src/Tldr/Types.hs new file mode 100644 --- /dev/null +++ b/src/Tldr/Types.hs @@ -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) diff --git a/test/data/grep.golden b/test/data/grep.golden --- a/test/data/grep.golden +++ b/test/data/grep.golden @@ -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}} diff --git a/test/data/ls.golden b/test/data/ls.golden --- a/test/data/ls.golden +++ b/test/data/ls.golden @@ -1,4 +1,5 @@ ls + List directory contents. - List files one per line: diff --git a/test/data/ps.golden b/test/data/ps.golden --- a/test/data/ps.golden +++ b/test/data/ps.golden @@ -1,4 +1,5 @@ ps + Information about running processes. - List all running processes: diff --git a/tldr.cabal b/tldr.cabal --- a/tldr.cabal +++ b/tldr.cabal @@ -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