cli/Hcompta/Lib/Data/Text/Buildable.hs

   1 {-# LANGUAGE FlexibleInstances #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE RankNTypes #-}
   4 {-# OPTIONS_GHC -fno-warn-tabs #-}
   5 {-# OPTIONS_GHC -fno-warn-orphans #-}
   6 module Hcompta.Lib.Data.Text.Buildable where
   7 import Data.Function (($), (.))
   8 import Data.Functor ((<$>))
   9 import Data.Foldable (Foldable(..))
  10 import Data.Monoid (Monoid(..), (<>))
  11 import qualified Data.List as List
  12 import Data.String (String)
  13 import Data.Text (Text)
  14 import Data.Eq (Eq(..))
  15 import qualified  Data.Text as Text
  16 import Data.Text.Buildable (Buildable(..))
  17 import qualified Data.Text.Lazy as TL
  18 import qualified Data.Text.Lazy.Builder as Build
  19 import Data.Text.Lazy.Builder (Builder)
  20
  21 string :: Buildable a => a -> String
  22 string = TL.unpack . Build.toLazyText . build
  23
  24 text :: Buildable a => a -> Text
  25 text = TL.toStrict . Build.toLazyText . build
  26
  27 tuple :: (Foldable f, Buildable a) => f a -> Builder
  28 tuple f = "(" <> mconcat (List.intersperse ", " $ foldr ((:) . build) [] f) <> ")"
  29
  30 list :: (Foldable f, Buildable a) => f a -> Builder
  31 list f = "[" <> mconcat (List.intersperse ", " $ foldr ((:) . build) [] f) <> "]"
  32
  33 words :: (Foldable f, Buildable a) => f a -> Builder
  34 words f = mconcat (List.intersperse " " $ foldr ((:). build) [] f)
  35
  36 words_quoted :: (Foldable f, Buildable a) => f a -> Builder
  37 words_quoted f =
  38         mconcat (List.intersperse " " $
  39                 foldr ((:) . quote) [] f)
  40         where quote a =
  41                 let t = text a in
  42                 if Text.any (== ' ') t
  43                 then "'"<>build t<>"'"
  44                 else build t
  45
  46 unlines :: (Foldable f, Buildable a) => f a -> Builder
  47 unlines = mconcat . List.intersperse "\n" . foldr ((:) . build) []
  48
  49 indent :: Buildable a => Builder -> a -> Builder
  50 indent prefix =
  51         mconcat . List.intersperse "\n" .
  52         ((prefix <>) . build <$>) . TL.lines .
  53         Build.toLazyText . build
  54
  55 parens :: Buildable a => a -> Builder
  56 parens a = "(" <> build a <> ")"
  57
  58 {-
  59 instance Buildable a => Buildable [a] where
  60         build = list
  61 -}