]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/Lib/Data/Text/Buildable.hs
Adapte hcompta-cli.
[comptalang.git] / 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 -}