{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module HR
(
version
, Parts(..)
, asciiParts
, unicodeParts
, render
, renderAscii
, renderUnicode
, put
, putAscii
, putUnicode
, putAuto
, putAutoAscii
, putAutoUnicode
) where
import Data.Maybe (fromMaybe)
import Data.Version (showVersion)
import qualified Data.Text as T
import Data.Text (Text)
import qualified HR.Monad.Terminal as Terminal
import HR.Monad.Terminal (MonadTerminal)
import qualified Paths_horizontal_rule as Project
version :: String
version :: String
version = String
"hr-haskell " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
Project.version
data Parts
= Parts
{ Parts -> Text
leftPart :: !Text
, Parts -> Text
midPart :: !Text
, Parts -> Text
rightPart :: !Text
, Parts -> Char
fillPart :: !Char
}
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
'-'
}
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
'━'
}
render
:: Parts
-> Int
-> [Text]
-> 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)
renderAscii
:: Int
-> [Text]
-> Text
renderAscii :: Int -> [Text] -> Text
renderAscii = Parts -> Int -> [Text] -> Text
render Parts
asciiParts
renderUnicode
:: Int
-> [Text]
-> Text
renderUnicode :: Int -> [Text] -> Text
renderUnicode = Parts -> Int -> [Text] -> Text
render Parts
unicodeParts
put
:: MonadTerminal m
=> Parts
-> Int
-> [Text]
-> 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
putAscii
:: MonadTerminal m
=> Int
-> [Text]
-> m ()
putAscii :: Int -> [Text] -> m ()
putAscii = Parts -> Int -> [Text] -> m ()
forall (m :: * -> *).
MonadTerminal m =>
Parts -> Int -> [Text] -> m ()
put Parts
asciiParts
putUnicode
:: MonadTerminal m
=> Int
-> [Text]
-> m ()
putUnicode :: Int -> [Text] -> m ()
putUnicode = Parts -> Int -> [Text] -> m ()
forall (m :: * -> *).
MonadTerminal m =>
Parts -> Int -> [Text] -> m ()
put Parts
unicodeParts
putAuto
:: MonadTerminal m
=> Parts
-> Int
-> [Text]
-> 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
putAutoAscii
:: MonadTerminal m
=> Int
-> [Text]
-> m ()
putAutoAscii :: Int -> [Text] -> m ()
putAutoAscii = Parts -> Int -> [Text] -> m ()
forall (m :: * -> *).
MonadTerminal m =>
Parts -> Int -> [Text] -> m ()
putAuto Parts
asciiParts
putAutoUnicode
:: MonadTerminal m
=> Int
-> [Text]
-> m ()
putAutoUnicode :: Int -> [Text] -> m ()
putAutoUnicode = Parts -> Int -> [Text] -> m ()
forall (m :: * -> *).
MonadTerminal m =>
Parts -> Int -> [Text] -> m ()
putAuto Parts
unicodeParts