{-# LANGUAGE OverloadedStrings #-}
module LambdaCube.Common.PrettyPrinter
  ( wrapIfSpaced
  , wrapIf
  , wrap

  , spaced
  ) where

import           Data.Text (Text)
import qualified Data.Text as Text

wrapIfSpaced :: Bool -> [Text] -> Text
wrapIfSpaced :: Bool -> [Text] -> Text
wrapIfSpaced Bool
b = Bool -> Text -> Text
wrapIf Bool
b (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
spaced

wrapIf :: Bool -> Text -> Text
wrapIf :: Bool -> Text -> Text
wrapIf Bool
True  = Text -> Text
wrap
wrapIf Bool
False = Text -> Text
forall a. a -> a
id

wrap :: Text -> Text
wrap :: Text -> Text
wrap Text
t = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

spaced :: [Text] -> Text
spaced :: [Text] -> Text
spaced = Text -> [Text] -> Text
Text.intercalate Text
" "