packages feed

horizontal-rule (empty) → 0.5.0.0

raw patch · 12 files changed

+1225/−0 lines, 12 filesdep +HMockdep +ansi-wl-pprintdep +basesetup-changed

Dependencies added: HMock, ansi-wl-pprint, base, horizontal-rule, optparse-applicative, tasty, tasty-hunit, terminal-size, text, time

Files

+ CHANGELOG.md view
@@ -0,0 +1,110 @@+# `hr-haskell` Changelog++This project follows the [Haskell package versioning policy][PVP], with+versions in `A.B.C.D` format.  `A` may be incremented arbitrarily for+non-technical reasons, but [semantic versioning][SemVer] is otherwise+followed, where `A.B` is the major version, `C` is the minor version, and `D`+is the patch version.  Initial development uses versions `0.0.0.D`, for which+every version is considered breaking.++[PVP]: <https://pvp.haskell.org/>+[SemVer]: <https://semver.org/>++The format of this changelog is based on [Keep a Changelog][KaC], with the+following conventions:++* Level-two heading `Unreleased` is used to track changes that have not been+  released.+* Other level-two headings specify the release in `A.B.C.D (YYYY-MM-DD)`+  format, with newer versions above older versions.+* Level-three headings are used to categorize changes as follows:+    1. Breaking+    2. Non-Breaking+* Changes are listed in arbitrary order and present tense.++[KaC]: <https://keepachangelog.com/en/1.0.0/>++## 0.5.0.0 (2022-03-01)++### Breaking++* Rename Haskell package to `horizontal-rule`+* Refactor API to use `MonadTerminal` instead of `IO` directly++### Non-Breaking++* Add mock tests+* Bump `text` dependency version upper bound+* Bump `time` dependency version upper bound+* Bump `optparse-applicative` dependency version upper bound++## 0.4.0.0 (2021-06-25)++### Breaking++* Fix `--help` when using `optparse-applicative` `0.16`++### Non-Breaking++* Refactor Nix configuration++## 0.3.0.1 (2021-05-28)++### Non-Breaking++* Add library usage example++## 0.3.0.0 (2021-05-28)++### Breaking++* Add library+* Add `--width` and `--default` CLI options+* Add `--input` and `--timeout` CLI options++## 0.2.0.1 (2021-05-27)++### Non-Breaking++* Fix link in README+* Fix formatting in RPM description++## 0.2.0.0 (2021-05-26)++### Breaking++* Add support for `optparse-applicative` `0.16`++### Non-Breaking++* Add `.deb` and `.rpm` packaging+* Add Cabal support to `Makefile`+* Add Cabal tests to GitHub Actions+* Add [stan](https://hackage.haskell.org/package/stan) static analysis++## 0.1.0.3 (2020-11-21)++### Non-Breaking++* Use GitHub Actions instead of Travis CI++## 0.1.0.2 (2020-11-05)++### Non-Breaking++* Rename Git default branch to `main`+* Refactor `Makefile`, add `STACK_NIX_PATH` support+* Add `test-all` command to `Makefile`+* Add Nix configuration++## 0.1.0.1 (2019-12-29)++### Non-Breaking++* Fix operator for compatibility with GHC 8.2.2++## 0.1.0.0 (2019-12-29)++### Breaking++* Initial public release
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License++Copyright (c) 2019-2022 Travis Cardwell++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,186 @@+# hr++[![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active)+[![GitHub CI](https://github.com/ExtremaIS/hr-haskell/workflows/CI/badge.svg?branch=main)](https://github.com/ExtremaIS/hr-haskell/actions)+[![Hackage](https://img.shields.io/hackage/v/horizontal-rule.svg)](https://hackage.haskell.org/package/horizontal-rule)+[![Stackage LTS](https://stackage.org/package/horizontal-rule/badge/lts)](https://stackage.org/package/horizontal-rule)+[![Stackage Nightly](https://stackage.org/package/horizontal-rule/badge/nightly)](https://stackage.org/nightly/package/horizontal-rule)++* [Overview](#overview)+* [CLI](#cli)+    * [Requirements](#requirements)+    * [Installation](#installation)+        * [`.deb` Package Installation](#deb-package-installation)+        * [`.rpm` Package Installation](#rpm-package-installation)+        * [Installation From Hackage](#installation-from-hackage)+        * [Installation From Stackage](#installation-from-stackage)+    * [Usage](#usage)+        * [Examples](#examples)+* [Library](#library)+* [Project](#project)+    * [Links](#links)+    * [Tags](#tags)+    * [Contribution](#contribution)+    * [License](#license)++## Overview++`hr` is a utility for displaying a horizontal rule in a terminal.++It is useful for marking a position in your terminal so that you can easily+find it again.  For example, use `hr` to display a horizontal rule before each+build of a project so that you can easily find the beginning of the output of+the last build.++## CLI++### Requirements++`hr` has only been tested on Linux.  It *might* work on Windows and macOS.++### Installation++#### `.deb` Package Installation++Check the [Releases][] page for `.deb` packages.++[Releases]: <https://github.com/ExtremaIS/hr-haskell/releases>++#### `.rpm` Package Installation++Check the [Releases][] page for `.rpm` packages.++#### Installation From Hackage++Install `hr` from [Hackage][] using [Cabal][] as follows:++```+$ cabal v2-install horizontal-rule+```++[Hackage]: <https://hackage.haskell.org/package/horizontal-rule>+[Cabal]: <https://www.haskell.org/cabal/>++#### Installation From Stackage++Install `hr` from [Stackage][] using [Stack][] as follows:++```+$ stack install horizontal-rule+```++[Stackage]: <https://www.stackage.org/package/horizontal-rule>+[Stack]: <https://haskellstack.org/>++### Usage++See the [`hr` man page](doc/hr.1.md) for usage information.++#### Examples++The rule fills with width of the terminal by default:++```+$ hr+━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━+```++In cases when the terminal width cannot be determined, a default width is+used.  This default width can be set with an option:++```+$ hr -d 78+━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━+```++If desired, the rule width can be specified:++```+$ hr -w 60+━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━+```++In cases where the terminal cannot display Unicode, ASCII may be used:++```+$ hr -a+------------------------------------------------------------------------------+```++The rule can include the current time:++```+$ hr -t+━━┫2021-05-27 19:26:09┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━+```++The time format can be specified:++```+$ hr -t -f "%H:%M:%S.%q"+━━┫19:30:44.861779179000┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━+```++The first line read from `STDIN` can be used as a note:++```+$ uname -m | hr -i+━━┫x86_64┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━+```++When input is read, a timeout is used to ensure that `hr` does not "hang" when+there is no input.  The timeout (in milliseconds) can be specified:++```+$ uname -m | hr -i --timeout 100+━━┫x86_64┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━+```++A note can be specified as one or more arguments:++```+$ hr unit tests+━━┫unit tests┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━+```++Different types of notes can be combined:++```+$ uname -m | hr -it unit tests+━━┫2021-05-27 19:48:48┣━┫unit tests┣━┫x86_64┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━+```++## Library++You can easily include horizontal rules in the output of your own Haskell+software by using the library.  The Haskell package is named `horizontal-rule`+in [Hackage][] and [Stackage][] because there is an existing package named+[`hR`](https://hackage.haskell.org/package/hR).++## Project++### Links++* Hackage: <https://hackage.haskell.org/package/horizontal-rule>+* Stackage: <https://www.stackage.org/package/horizontal-rule>+* GitHub: <https://github.com/ExtremaIS/hr-haskell>+* GitHub Actions CI: <https://github.com/ExtremaIS/hr-haskell/actions>++### Tags++All releases are tagged in the `main` branch.  Release tags are signed using+the+[`security@extrema.is` GPG key](http://keys.gnupg.net/pks/lookup?op=vindex&fingerprint=on&search=0x1D484E4B4705FADF).++### Contribution++Issues and feature requests are tracked on GitHub:+<https://github.com/ExtremaIS/hr-haskell/issues>++Issues may also be submitted via email to <bugs@extrema.is>.++### License++This project is released under the+[MIT License](https://opensource.org/licenses/MIT) as specified in the+[`LICENSE`](LICENSE) file.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/LibOA.hs view
@@ -0,0 +1,141 @@+------------------------------------------------------------------------------+-- |+-- Module      : LibOA+-- Description : supplementary functions for optparse-applicative+-- Copyright   : Copyright (c) 2019-2022 Travis Cardwell+-- License     : MIT+--+-- This is a collection of functions that I often use with+-- @optparse-applicative@.  I do not feel that it is worth maintaining yet+-- another helper package on Hackage, so I just copy the code to different+-- projects as required.  If the library grows to a substantial size or others+-- with to use it, I will reconsider.+--+-- Revision: 2022-01-02+------------------------------------------------------------------------------++{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}++module LibOA+  ( -- * Options+    -- $Options+    helper+  , versioner+    -- * Utilities+  , commands+    -- * Help+  , (<||>)+  , section+  , table+  , table_+  , vspace+  ) where++-- https://hackage.haskell.org/package/ansi-wl-pprint+import qualified Text.PrettyPrint.ANSI.Leijen as Doc+import Text.PrettyPrint.ANSI.Leijen (Doc)++-- https://hackage.haskell.org/package/base+import Data.List (intersperse, transpose)+import Data.Maybe (fromMaybe)+#if !MIN_VERSION_base (4,11,0)+import Data.Monoid ((<>))+#endif++-- https://hackage.haskell.org/package/optparse-applicative+import qualified Options.Applicative as OA+#if MIN_VERSION_optparse_applicative (0,16,0)+import qualified Options.Applicative.Builder.Internal as OABI+#endif+import qualified Options.Applicative.Common as OAC+import qualified Options.Applicative.Types as OAT++------------------------------------------------------------------------------+-- $Options+--+-- Option descriptions are not capitalized.++-- | A hidden @-h@ / @--help@ option that always fails, showing the help+--+-- This is the same as 'OA.helper' except that it has a different help+-- message.+helper :: OA.Parser (a -> a)+#if MIN_VERSION_optparse_applicative (0,16,0)+helper = OA.option helpReader $ mconcat+    [ OA.short 'h'+    , OA.long "help"+    , OA.value id+    , OA.metavar ""+    , OABI.noGlobal+    , OA.noArgError (OA.ShowHelpText Nothing)+    , OA.help "show this help text"+    , OA.hidden+    ]+  where+    helpReader = do+      potentialCommand <- OAT.readerAsk+      OA.readerAbort $ OA.ShowHelpText (Just potentialCommand)+#else+helper = OA.abortOption OA.ShowHelpText $ mconcat+    [ OA.short 'h'+    , OA.long "help"+    , OA.help "show help and exit"+    , OA.hidden+    ]+#endif++-- | A hidden @--version@ option that always fails, showing the version+versioner+  :: String  -- ^ version string+  -> OA.Parser (a -> a)+versioner verStr = OA.infoOption verStr $ mconcat+    [ OA.long "version"+    , OA.help "show version and exit"+    , OA.hidden+    ]++------------------------------------------------------------------------------+-- $Utilities++-- | Get a list of commands for a parser+commands :: OA.Parser a -> [String]+commands =+    let go _ opt = case OAT.optMain opt of+           OAT.CmdReader _ cmds _ -> reverse cmds+           _otherReader           -> []+    in  concat . OAC.mapParser go++------------------------------------------------------------------------------+-- $Help++-- | Insert a blank line between two documents+(<||>) :: Doc -> Doc -> Doc+d1 <||> d2 = d1 <> Doc.line <> Doc.line <> d2+infixr 5 <||>++-- | Create a section with a title and indented body+section :: String -> Doc -> Doc+section title = (Doc.text title Doc.<$$>) . Doc.indent 2++-- | Create a table, with formatting+table :: Int -> [[(String, Doc -> Doc)]] -> Doc+table sep rows = Doc.vcat $+    map (fromMaybe Doc.empty . foldr go Nothing . zip lengths) rows+  where+    lengths :: [Int]+    lengths = map ((+) sep . maximum . map (length . fst)) $ transpose rows++    go :: (Int, (String, Doc -> Doc)) -> Maybe Doc -> Maybe Doc+    go (len, (s, f)) = Just . \case+      Just doc -> Doc.fill len (f $ Doc.string s) <> doc+      Nothing  -> f $ Doc.string s++-- | Create a table, without formatting+table_ :: Int -> [[String]] -> Doc+table_ sep = table sep . (map . map) (, id)++-- | Vertically space documents with blank lines between them+vspace :: [Doc] -> Doc+vspace = mconcat . intersperse (Doc.line <> Doc.line)
+ app/Main.hs view
@@ -0,0 +1,192 @@+------------------------------------------------------------------------------+-- |+-- 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"]+      ]
+ horizontal-rule.cabal view
@@ -0,0 +1,92 @@+name:           horizontal-rule+version:        0.5.0.0+category:       Utils+synopsis:       horizontal rule for the terminal+description:+  This package provides a utility for displaying a horizontal rule in a+  terminal.  Please see the README on GitHub at+  <https://github.com/ExtremaIS/hr-haskell#readme>.++homepage:       https://github.com/ExtremaIS/hr-haskell#readme+bug-reports:    https://github.com/ExtremaIS/hr-haskell/issues+author:         Travis Cardwell <travis.cardwell@extrema.is>+maintainer:     Travis Cardwell <travis.cardwell@extrema.is>+copyright:      Copyright (c) 2019-2022 Travis Cardwell+license:        MIT+license-file:   LICENSE++cabal-version:  1.24+build-type:     Simple+tested-with:+  GHC ==8.2.2+   || ==8.4.4+   || ==8.6.5+   || ==8.8.4+   || ==8.10.7+   || ==9.0.2+   || ==9.2.1++extra-source-files:+  CHANGELOG.md+  README.md++source-repository head+  type: git+  location: https://github.com/ExtremaIS/hr-haskell.git++flag write-hie+  description: write .hie files+  default: False++library+  hs-source-dirs: src+  exposed-modules:+      HR+    , HR.Monad.Terminal+  other-modules:+      Paths_horizontal_rule+  build-depends:+      base >=4.7 && <5+    , terminal-size >=0.3 && <0.4+    , text >=1.2.3 && <2.1+  default-language: Haskell2010+  default-extensions:+      OverloadedStrings+  if flag(write-hie)+    ghc-options: -Wall -fwrite-ide-info -hiedir=.hie+  else+    ghc-options: -Wall++executable hr+  hs-source-dirs: app+  main-is: Main.hs+  other-modules:+      LibOA+  build-depends:+      ansi-wl-pprint >=0.6 && <0.7+    , base+    , horizontal-rule+    , optparse-applicative >=0.14 && <0.18+    , text+    , time >=1.8 && <1.13+  default-language: Haskell2010+  ghc-options: -Wall++test-suite horizontal-rule-test+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  other-modules:+      HR.Test+  build-depends:+      base+    , horizontal-rule+    , tasty >=1.0 && <1.5+    , tasty-hunit >=0.10 && <0.11+  if impl(ghc >= 8.6.1)+    other-modules:+        HR.Mock+    build-depends:+        HMock >=0.5.1 && <0.6+  default-language: Haskell2010+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+ src/HR.hs view
@@ -0,0 +1,222 @@+------------------------------------------------------------------------------+-- |+-- Module      : HR+-- Description : horizontal rule for terminals+-- Copyright   : Copyright (c) 2019-2022 Travis Cardwell+-- License     : MIT+--+-- This library is meant to be imported qualified, as follows:+--+-- @+-- import qualified HR+-- @+------------------------------------------------------------------------------++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module HR+  ( -- * Constants+    version+    -- * Parts+  , Parts(..)+  , asciiParts+  , unicodeParts+    -- * API+    -- ** Pure+  , render+  , renderAscii+  , renderUnicode+    -- ** IO+  , put+  , putAscii+  , putUnicode+  , putAuto+  , putAutoAscii+  , putAutoUnicode+  ) where++-- https://hackage.haskell.org/package/base+import Data.Maybe (fromMaybe)+import Data.Version (showVersion)++-- https://hackage.haskell.org/package/text+import qualified Data.Text as T+import Data.Text (Text)++-- (horizontal-rule)+import qualified HR.Monad.Terminal as Terminal+import HR.Monad.Terminal (MonadTerminal)++-- (horizontal-rule:cabal)+import qualified Paths_horizontal_rule as Project++------------------------------------------------------------------------------+-- $Constants++-- | hr version string (\"@hr-haskell X.X.X.X@\")+--+-- @since 0.3.0.0+version :: String+version = "hr-haskell " ++ showVersion Project.version++------------------------------------------------------------------------------+-- $Parts++-- | Text parts of a horizontal rule+--+-- @since 0.3.0.0+data Parts+  = Parts+    { leftPart  :: !Text  -- ^ text before the first note+    , midPart   :: !Text  -- ^ text between notes+    , rightPart :: !Text  -- ^ text after the last note+    , fillPart  :: !Char  -- ^ fill character+    }++-- | ASCII text parts of a horizontal rule+--+-- @since 0.3.0.0+asciiParts :: Parts+asciiParts = Parts+    { leftPart  = "--|"+    , midPart   = "|-|"+    , rightPart = "|--"+    , fillPart  = '-'+    }++-- | Unicode text parts of a horizontal rule+--+-- @since 0.3.0.0+unicodeParts :: Parts+unicodeParts = Parts+    { leftPart  = "━━┫"+    , midPart   = "┣━┫"+    , rightPart = "┣━━"+    , fillPart  = '━'+    }++------------------------------------------------------------------------------+-- $API++-- | Render a horizontal rule+--+-- Note that the rendered horizontal rule maybe longer than the specified rule+-- width if the provided notes is too wide.+--+-- @since 0.3.0.0+render+  :: Parts+  -> Int     -- ^ rule width (characters)+  -> [Text]  -- ^ notes+  -> Text+render Parts{..} width = \case+    [] -> T.pack $ replicate width fillPart+    notes ->+      let rule = T.concat+            [ leftPart+            , T.intercalate midPart notes+            , rightPart+            ]+      in  case max 0 (width - T.length rule) of+            0         -> rule+            fillWidth -> rule `T.append` T.pack (replicate fillWidth fillPart)++-- | Render an ASCII horizontal rule+--+-- Note that the rendered horizontal rule maybe longer than the specified rule+-- width if the provided notes is too wide.+--+-- @since 0.3.0.0+renderAscii+  :: Int     -- ^ rule width (characters)+  -> [Text]  -- ^ notes+  -> Text+renderAscii = render asciiParts++-- | Render a Unicode horizontal rule+--+-- Note that the rendered horizontal rule maybe longer than the specified rule+-- width if the provided notes is too wide.+--+-- @since 0.3.0.0+renderUnicode+  :: Int     -- ^ rule width (characters)+  -> [Text]  -- ^ notes+  -> Text+renderUnicode = render unicodeParts++------------------------------------------------------------------------------++-- | Write a horizontal rule to the standard output device+--+-- @since 0.5.0.0+put+  :: MonadTerminal m+  => Parts+  -> Int     -- ^ rule width (characters)+  -> [Text]  -- ^ notes+  -> m ()+put parts width = Terminal.putStrLn . render parts width++-- | Write an ASCII horizontal rule to the standard output device+--+-- @since 0.5.0.0+putAscii+  :: MonadTerminal m+  => Int     -- ^ rule width (characters)+  -> [Text]  -- ^ notes+  -> m ()+putAscii = put asciiParts++-- | Write a Unicode horizontal rule to the standard output device+--+-- @since 0.5.0.0+putUnicode+  :: MonadTerminal m+  => Int     -- ^ rule width (characters)+  -> [Text]  -- ^ notes+  -> m ()+putUnicode = put unicodeParts++------------------------------------------------------------------------------++-- | Write a full-width horizontal rule to the standard output device+--+-- The default rule width is used if the terminal width cannot be determined.+--+-- @since 0.5.0.0+putAuto+  :: MonadTerminal m+  => Parts+  -> Int     -- ^ default rule width (characters)+  -> [Text]  -- ^ notes+  -> m ()+putAuto parts defaultWidth notes = do+    width <- fromMaybe defaultWidth <$> Terminal.getWidth+    Terminal.putStrLn $ render parts width notes++-- | Write a full-width ASCII horizontal rule to the standard output device+--+-- The default rule width is used if the terminal width cannot be determined.+--+-- @since 0.5.0.0+putAutoAscii+  :: MonadTerminal m+  => Int     -- ^ default rule width (characters)+  -> [Text]  -- ^ notes+  -> m ()+putAutoAscii = putAuto asciiParts++-- | Write a full-width Unicode horizontal rule to the standard output device+--+-- The default rule width is used if the terminal width cannot be determined.+--+-- @since 0.5.0.0+putAutoUnicode+  :: MonadTerminal m+  => Int     -- ^ default rule width (characters)+  -> [Text]  -- ^ notes+  -> m ()+putAutoUnicode = putAuto unicodeParts
+ src/HR/Monad/Terminal.hs view
@@ -0,0 +1,39 @@+------------------------------------------------------------------------------+-- |+-- Module      : HR.Monad.Terminal+-- Description : terminal output+-- Copyright   : Copyright (c) 2019-2022 Travis Cardwell+-- License     : MIT+------------------------------------------------------------------------------++module HR.Monad.Terminal+  ( -- * MonadTerminal+    MonadTerminal(..)+  ) where++-- https://hackage.haskell.org/package/terminal-size+import qualified System.Console.Terminal.Size as TS++-- https://hackage.haskell.org/package/text+import Data.Text (Text)+import qualified Data.Text.IO as TIO++------------------------------------------------------------------------------+-- $MonadTerminal++-- | Terminal output+--+-- @since 0.5.0.0+class Monad m => MonadTerminal m where+  -- | Get the width of the terminal, if possible+  getWidth :: m (Maybe Int)++  -- | Write a string to @STDOUT@, appending a newline+  putStrLn :: Text -> m ()++instance MonadTerminal IO where+  getWidth = fmap TS.width <$> TS.size+  {-# INLINE getWidth #-}++  putStrLn = TIO.putStrLn+  {-# INLINE putStrLn #-}
+ test/HR/Mock.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module HR.Mock (tests) where++-- https://hackage.haskell.org/package/HMock+import qualified Test.HMock as HMock+import Test.HMock ((|->))++-- https://hackage.haskell.org/package/tasty+import Test.Tasty (TestTree, testGroup)++-- https://hackage.haskell.org/package/tasty-hunit+import Test.Tasty.HUnit (testCase)++-- (horizontal-rule)+import qualified HR+import HR.Monad.Terminal (MonadTerminal(..))++------------------------------------------------------------------------------++HMock.makeMockable [t|MonadTerminal|]++------------------------------------------------------------------------------++parts :: HR.Parts+parts = HR.Parts+    { HR.leftPart  = "══╣"+    , HR.midPart   = "╠═╣"+    , HR.rightPart = "╠══"+    , HR.fillPart  = '═'+    }++------------------------------------------------------------------------------++testPutAscii :: TestTree+testPutAscii = testCase "putAscii" . HMock.runMockT $ do+    HMock.expect $ PutStrLn "--|test|------------" |-> ()+    HR.putAscii 20 ["test"]++------------------------------------------------------------------------------++testPutUnicode :: TestTree+testPutUnicode = testCase "putUnicode" . HMock.runMockT $ do+    HMock.expect $ PutStrLn "━━┫test┣━━━━━━━━━━━━" |-> ()+    HR.putUnicode 20 ["test"]++------------------------------------------------------------------------------++testPut :: TestTree+testPut = testCase "put" . HMock.runMockT $ do+    HMock.expect $ PutStrLn "══╣test╠════════════" |-> ()+    HR.put parts 20 ["test"]++------------------------------------------------------------------------------++testPutAutoAscii :: TestTree+testPutAutoAscii = testGroup "putAutoAscii"+    [ testCase "auto" . HMock.runMockT $ do+        HMock.expect $ GetWidth |-> Just 20+        HMock.expect $ PutStrLn "--|test|------------" |-> ()+        HR.putAutoAscii 30 ["test"]+    , testCase "default" . HMock.runMockT $ do+        HMock.expect $ GetWidth |-> Nothing+        HMock.expect $ PutStrLn "--|test|--" |-> ()+        HR.putAutoAscii 10 ["test"]+    ]++------------------------------------------------------------------------------++testPutAutoUnicode :: TestTree+testPutAutoUnicode = testGroup "putAutoUnicode"+    [ testCase "auto" . HMock.runMockT $ do+        HMock.expect $ GetWidth |-> Just 20+        HMock.expect $ PutStrLn "━━┫test┣━━━━━━━━━━━━" |-> ()+        HR.putAutoUnicode 30 ["test"]+    , testCase "default" . HMock.runMockT $ do+        HMock.expect $ GetWidth |-> Nothing+        HMock.expect $ PutStrLn "━━┫test┣━━" |-> ()+        HR.putAutoUnicode 10 ["test"]+    ]++------------------------------------------------------------------------------++testPutAuto :: TestTree+testPutAuto = testGroup "putAuto"+    [ testCase "auto" . HMock.runMockT $ do+        HMock.expect $ GetWidth |-> Just 20+        HMock.expect $ PutStrLn "══╣test╠════════════" |-> ()+        HR.putAuto parts 30 ["test"]+    , testCase "default" . HMock.runMockT $ do+        HMock.expect $ GetWidth |-> Nothing+        HMock.expect $ PutStrLn "══╣test╠══" |-> ()+        HR.putAuto parts 10 ["test"]+    ]++------------------------------------------------------------------------------++tests :: TestTree+tests = testGroup "HR:Mock"+    [ testPutAscii+    , testPutUnicode+    , testPut+    , testPutAutoAscii+    , testPutAutoUnicode+    , testPutAuto+    ]
+ test/HR/Test.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}++module HR.Test (tests) where++-- https://hackage.haskell.org/package/tasty+import Test.Tasty (TestTree, testGroup)++-- https://hackage.haskell.org/package/tasty-hunit+import Test.Tasty.HUnit ((@=?), testCase)++-- (horizontal-rule)+import qualified HR++------------------------------------------------------------------------------++testRenderAscii :: TestTree+testRenderAscii = testGroup "renderAscii"+    [ testCase "fill" $+        "----------------------------------------" @=?+          HR.renderAscii 40 []+    , testCase "oneNote" $+        "--|test|--------------------------------" @=?+          HR.renderAscii 40 ["test"]+    , testCase "twoNotes" $+        "--|2021-05-27 17:29:42|-|test|----------" @=?+          HR.renderAscii 40 ["2021-05-27 17:29:42", "test"]+    , testCase "long" $+        "--|2021-05-27 17:29:42|-|this note is long|--" @=?+          HR.renderAscii 40 ["2021-05-27 17:29:42", "this note is long"]+    ]++------------------------------------------------------------------------------++testRenderUnicode :: TestTree+testRenderUnicode = testGroup "renderUnicode"+    [ testCase "fill" $+        "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━" @=?+          HR.renderUnicode 40 []+    , testCase "oneNote" $+        "━━┫test┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━" @=?+          HR.renderUnicode 40 ["test"]+    , testCase "twoNotes" $+        "━━┫2021-05-27 17:29:42┣━┫test┣━━━━━━━━━━" @=?+          HR.renderUnicode 40 ["2021-05-27 17:29:42", "test"]+    , testCase "long" $+        "━━┫2021-05-27 17:29:42┣━┫this note is long┣━━" @=?+          HR.renderUnicode 40 ["2021-05-27 17:29:42", "this note is long"]+    ]++------------------------------------------------------------------------------++testRender :: TestTree+testRender = testGroup "render"+    [ testCase "fill" $+        "════════════════════════════════════════" @=?+          HR.render parts 40 []+    , testCase "oneNote" $+        "══╣test╠════════════════════════════════" @=?+          HR.render parts 40 ["test"]+    , testCase "twoNotes" $+        "══╣2021-05-27 17:29:42╠═╣test╠══════════" @=?+          HR.render parts 40 ["2021-05-27 17:29:42", "test"]+    , testCase "long" $+        "══╣2021-05-27 17:29:42╠═╣this note is long╠══" @=?+          HR.render parts 40 ["2021-05-27 17:29:42", "this note is long"]+    ]+  where+    parts :: HR.Parts+    parts = HR.Parts+      { HR.leftPart  = "══╣"+      , HR.midPart   = "╠═╣"+      , HR.rightPart = "╠══"+      , HR.fillPart  = '═'+      }++------------------------------------------------------------------------------++tests :: TestTree+tests = testGroup "HR"+    [ testRenderAscii+    , testRenderUnicode+    , testRender+    ]
+ test/Spec.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}++module Main (main) where++-- https://hackage.haskell.org/package/tasty+import Test.Tasty (defaultMain, testGroup)++-- (horizontal-rule:test)+import qualified HR.Test+#if __GLASGOW_HASKELL__ >= 806+import qualified HR.Mock+#endif++------------------------------------------------------------------------------++main :: IO ()+main = defaultMain $ testGroup "test"+    [ HR.Test.tests+#if __GLASGOW_HASKELL__ >= 806+    , HR.Mock.tests+#endif+    ]