------------------------------------------------------------------------------
-- |
-- 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 :: String
version = String
"hr-haskell " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
Project.version

------------------------------------------------------------------------------
-- $Parts

-- | Text parts of a horizontal rule
--
-- @since 0.3.0.0
data Parts
  = Parts
    { Parts -> Text
leftPart  :: !Text  -- ^ text before the first note
    , Parts -> Text
midPart   :: !Text  -- ^ text between notes
    , Parts -> Text
rightPart :: !Text  -- ^ text after the last note
    , Parts -> Char
fillPart  :: !Char  -- ^ fill character
    }

-- | ASCII text parts of a horizontal rule
--
-- @since 0.3.0.0
asciiParts :: Parts
asciiParts :: Parts
asciiParts = Parts :: Text -> Text -> Text -> Char -> Parts
Parts
    { leftPart :: Text
leftPart  = Text
"--|"
    , midPart :: Text
midPart   = Text
"|-|"
    , rightPart :: Text
rightPart = Text
"|--"
    , fillPart :: Char
fillPart  = Char
'-'
    }

-- | Unicode text parts of a horizontal rule
--
-- @since 0.3.0.0
unicodeParts :: Parts
unicodeParts :: Parts
unicodeParts = Parts :: Text -> Text -> Text -> Char -> Parts
Parts
    { leftPart :: Text
leftPart  = Text
"━━┫"
    , midPart :: Text
midPart   = Text
"┣━┫"
    , rightPart :: Text
rightPart = Text
"┣━━"
    , fillPart :: Char
fillPart  = Char
'━'
    }

------------------------------------------------------------------------------
-- $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 -> Int -> [Text] -> Text
render Parts{Char
Text
fillPart :: Char
rightPart :: Text
midPart :: Text
leftPart :: Text
fillPart :: Parts -> Char
rightPart :: Parts -> Text
midPart :: Parts -> Text
leftPart :: Parts -> Text
..} Int
width = \case
    [] -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
width Char
fillPart
    [Text]
notes ->
      let rule :: Text
rule = [Text] -> Text
T.concat
            [ Text
leftPart
            , Text -> [Text] -> Text
T.intercalate Text
midPart [Text]
notes
            , Text
rightPart
            ]
      in  case Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
rule) of
            Int
0         -> Text
rule
            Int
fillWidth -> Text
rule Text -> Text -> Text
`T.append` String -> Text
T.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
fillWidth Char
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 :: Int -> [Text] -> Text
renderAscii = Parts -> Int -> [Text] -> Text
render Parts
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 :: Int -> [Text] -> Text
renderUnicode = Parts -> Int -> [Text] -> Text
render Parts
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 -> Int -> [Text] -> m ()
put Parts
parts Int
width = Text -> m ()
forall (m :: * -> *). MonadTerminal m => Text -> m ()
Terminal.putStrLn (Text -> m ()) -> ([Text] -> Text) -> [Text] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parts -> Int -> [Text] -> Text
render Parts
parts Int
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 :: Int -> [Text] -> m ()
putAscii = Parts -> Int -> [Text] -> m ()
forall (m :: * -> *).
MonadTerminal m =>
Parts -> Int -> [Text] -> m ()
put Parts
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 :: Int -> [Text] -> m ()
putUnicode = Parts -> Int -> [Text] -> m ()
forall (m :: * -> *).
MonadTerminal m =>
Parts -> Int -> [Text] -> m ()
put Parts
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 -> Int -> [Text] -> m ()
putAuto Parts
parts Int
defaultWidth [Text]
notes = do
    Int
width <- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defaultWidth (Maybe Int -> Int) -> m (Maybe Int) -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe Int)
forall (m :: * -> *). MonadTerminal m => m (Maybe Int)
Terminal.getWidth
    Text -> m ()
forall (m :: * -> *). MonadTerminal m => Text -> m ()
Terminal.putStrLn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Parts -> Int -> [Text] -> Text
render Parts
parts Int
width [Text]
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 :: Int -> [Text] -> m ()
putAutoAscii = Parts -> Int -> [Text] -> m ()
forall (m :: * -> *).
MonadTerminal m =>
Parts -> Int -> [Text] -> m ()
putAuto Parts
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 :: Int -> [Text] -> m ()
putAutoUnicode = Parts -> Int -> [Text] -> m ()
forall (m :: * -> *).
MonadTerminal m =>
Parts -> Int -> [Text] -> m ()
putAuto Parts
unicodeParts