Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Split library and fix multiple line bug #27

Merged
merged 5 commits into from
Aug 8, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -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.
Expand Down
234 changes: 3 additions & 231 deletions app/Main.hs
Original file line number Diff line number Diff line change
@@ -1,234 +1,6 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns #-}
module Main where

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

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
15 changes: 7 additions & 8 deletions package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -25,14 +25,19 @@ flags:

library:
source-dirs: src
exposed-modules:
- Tldr
dependencies:
- base >=4.7 && <5
- cmark
- text
- bytestring
- ansi-terminal
- optparse-applicative
- directory
- filepath
- typed-process
- semigroups
- containers


executables:
tldr:
Expand All @@ -48,12 +53,6 @@ executables:
dependencies:
- base
- tldr
- optparse-applicative
- directory
- filepath
- typed-process
- semigroups
- containers

tests:
tldr-test:
Expand Down
19 changes: 5 additions & 14 deletions src/Tldr.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,21 +14,11 @@ module Tldr
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 =
Expand All @@ -55,7 +45,7 @@ toSGR cons =
]

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
Expand All @@ -81,6 +71,7 @@ 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)

Expand Down
Loading