------------------------------------------------------------------------------ -- | -- Module : Main -- Description : hr: a horizontal rule for terminals -- Copyright : Copyright (c) 2019-2022 Travis Cardwell -- License : MIT -- -- See the README for details. ------------------------------------------------------------------------------ {-# LANGUAGE RecordWildCards #-} module Main (main) where -- https://hackage.haskell.org/package/ansi-wl-pprint import Text.PrettyPrint.ANSI.Leijen (Doc) -- https://hackage.haskell.org/package/base import Control.Applicative (many, optional) import Data.Maybe (maybeToList) import System.Timeout (timeout) -- https://hackage.haskell.org/package/optparse-applicative import qualified Options.Applicative as OA -- https://hackage.haskell.org/package/text import qualified Data.Text as T -- https://hackage.haskell.org/package/time import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.LocalTime (getZonedTime) -- (horizontal-rule) import qualified HR -- (horizontal-rule:executable) import qualified LibOA ------------------------------------------------------------------------------ -- $Constants defaultWidth :: Int defaultWidth = 80 defaultFormat :: String defaultFormat = "%Y-%m-%d %H:%M:%S" defaultTimeout :: Int defaultTimeout = 500 ------------------------------------------------------------------------------ -- $Options data Options = Options { optWidth :: !(Maybe Int) , optDefault :: !Int , optAscii :: !Bool , optTime :: !Bool , optFormat :: !String , optInput :: !Bool , optTimeout :: !Int , optNote :: !(Maybe String) } options :: OA.Parser Options options = Options <$> optional widthOption <*> defaultOption <*> asciiOption <*> timeOption <*> formatOption <*> inputOption <*> timeoutOption <*> noteArguments widthOption :: OA.Parser Int widthOption = OA.option OA.auto $ mconcat [ OA.long "width" , OA.short 'w' , OA.metavar "CHARS" , OA.help "target rule width (default: terminal width)" ] defaultOption :: OA.Parser Int defaultOption = OA.option OA.auto $ mconcat [ OA.long "default" , OA.short 'd' , OA.metavar "CHARS" , OA.value defaultWidth , OA.showDefault , OA.help "default target rule width" ] asciiOption :: OA.Parser Bool asciiOption = OA.switch $ mconcat [ OA.long "ascii" , OA.short 'a' , OA.help "use ASCII lines (default: use Unicode lines)" ] timeOption :: OA.Parser Bool timeOption = OA.switch $ mconcat [ OA.long "time" , OA.short 't' , OA.help "show time" ] formatOption :: OA.Parser String formatOption = OA.strOption $ mconcat [ OA.long "format" , OA.short 'f' , OA.metavar "FORMAT" , OA.value defaultFormat , OA.showDefaultWith id , OA.help "time format" ] inputOption :: OA.Parser Bool inputOption = OA.switch $ mconcat [ OA.long "input" , OA.short 'i' , OA.help "read note from STDIN within MS milliseconds" ] timeoutOption :: OA.Parser Int timeoutOption = OA.option OA.auto $ mconcat [ OA.long "timeout" , OA.metavar "MS" , OA.value defaultTimeout , OA.showDefault , OA.help "timeout in milliseconds" ] noteArguments :: OA.Parser (Maybe String) noteArguments = fmap mjoin . many . OA.strArgument $ mconcat [ OA.metavar "NOTE ..." , OA.help "show a note" ] where mjoin :: [String] -> Maybe String mjoin [] = Nothing mjoin ss = Just $ unwords ss ------------------------------------------------------------------------------ -- $Main main :: IO () main = do Options{..} <- OA.execParser pinfo mTime <- if optTime then Just . formatTime defaultTimeLocale optFormat <$> getZonedTime else pure Nothing mInput <- if optInput then timeout (optTimeout * 1000) getLine else pure Nothing let hr = case (optWidth, optAscii) of (Nothing, False) -> HR.putAutoUnicode optDefault (Nothing, True) -> HR.putAutoAscii optDefault (Just width, False) -> HR.putUnicode width (Just width, True) -> HR.putAscii width hr . map T.pack $ concat [ maybeToList mTime , maybeToList optNote , maybeToList mInput ] where pinfo :: OA.ParserInfo Options pinfo = OA.info (LibOA.helper <*> LibOA.versioner HR.version <*> options) $ mconcat [ OA.fullDesc , OA.progDesc "horizontal rule for the terminal" , OA.failureCode 2 , OA.footerDoc $ Just formatHelp ] formatHelp :: Doc formatHelp = LibOA.section "FORMAT codes:" $ LibOA.table_ 2 [ ["%Y", "four-digit year"] , ["%y", "two-digit year"] , ["%m", "two-digit month"] , ["%d", "two-digit day"] , ["%H", "two-digit hour using 24-hour clock"] , ["%I", "two-digit hour using 12-hour clock"] , ["%p", "locale equivalent of AM or PM"] , ["%M", "two-digit minute"] , ["%S", "two-digit second"] , ["%q", "twelve-digit picosecond"] , ["%z", "UTC offset"] ]