fmt 0.0.0.2 → 0.0.0.3

raw patch · 6 files changed

+1770/−137 lines, 6 filesdep +base16-bytestringdep +base64-bytestringdep +bytestringdep ~hspecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: base16-bytestring, base64-bytestring, bytestring, containers, microlens, neat-interpolation, vector

Dependency ranges changed: hspec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +25/−0
• fmt.cabal +13/−5
• lib/Fmt.hs +1070/−109
• lib/Fmt/IO.hs +0/−20
• lib/Fmt/Internal.hs +192/−0
• tests/Main.hs +470/−3

@@ -1,3 +1,28 @@+# 0.0.0.3++* Wrote documentation.++* Added some formatters:++    * `indent`+    * formatters for lists, maps and tuples (`listF`, etc)+    * `octF`, `binF`, `baseF` and floating-point formatters+    * `hexF` which works on both numbers and bytestrings+    * `ordinalF` and `commaizeF`+    * padding and trimming formatters+    * `base64F` and `base64UrlF`+    * conditionals (`whenF` and `unlessF`)++* Merged `Fmt.IO` with `Fmt` because orphan instances are controversial.++* Exported internal classes and functions from `Fmt.Internal`.++* Added `fmt` and `fmtLn`.++* Made all operators associate to the right (`Builder` documentation says it's faster than the opposite).++* Reexported `Buildable` and `Builder`.+ # 0.0.0.2  * Added `>%%<` so that it'd be possible to write `%<a>%%<b>%` instead of weird `%<a%<b>%`.

@@ -1,5 +1,5 @@ name:                fmt-version:             0.0.0.2+version:             0.0.0.3 synopsis:            Nice formatting library description:   Nice formatting library@@ -22,10 +22,12 @@  library   exposed-modules:     Fmt-                       Fmt.IO-  -- other-modules:       -  -- other-extensions:    +                       Fmt.Internal   build-depends:       base >=4.6 && <5,+                       base16-bytestring,+                       base64-bytestring,+                       bytestring,+                       microlens >= 0.3,                        text,                        text-format >= 0.3   ghc-options:         -Wall -fno-warn-unused-do-bind@@ -36,9 +38,15 @@   main-is:             Main.hs   type:                exitcode-stdio-1.0   build-depends:       base >=4.6 && <5+                     , bytestring+                     , containers                      , fmt-                     , hspec >= 2.2 && < 2.4+                     , hspec >= 2.2 && < 2.5+                     , neat-interpolation                      , text+                     , vector   ghc-options:         -Wall -fno-warn-unused-do-bind   hs-source-dirs:      tests   default-language:    Haskell2010+  if impl(ghc < 7.10)+    buildable: False

@@ -1,109 +1,1070 @@-{-# LANGUAGE FlexibleInstances #-}--module Fmt-(-  (%<),-  (>%),-  (>%%<),--  (%<<),-  (>>%),-  (>>%%<<),--  (>%%<<),-  (>>%%<),--  FromBuilder(..),-)-where--import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import Data.Text.Lazy.Builder hiding (fromString)-import Data.Monoid-import Data.Text.Buildable--------------------------------------------------------------------------------- Operators with 'Buildable'-------------------------------------------------------------------------------(%<) :: (Buildable a, FromBuilder b) => Builder -> a -> b-(%<) x a = fromBuilder (x <> build a)--(>%) :: (FromBuilder b) => Builder -> Builder -> b-(>%) x a = fromBuilder (x <> a)--(>%%<) :: (Buildable a, FromBuilder b) => Builder -> a -> b-(>%%<) x a = fromBuilder (x <> build a)--infixl 1 %<-infixl 1 >%-infixl 1 >%%<--------------------------------------------------------------------------------- Operators with 'Show'-------------------------------------------------------------------------------(%<<) :: (Show a, FromBuilder b) => Builder -> a -> b-(%<<) x a = x %< show a-{-# INLINE (%<<) #-}--(>>%) :: (FromBuilder b) => Builder -> Builder -> b-(>>%) x a = x >% a-{-# INLINE (>>%) #-}--(>>%%<<) :: (Show a, FromBuilder b) => Builder -> a -> b-(>>%%<<) x a = x %< show a-{-# INLINE (>>%%<<) #-}--infixl 1 %<<-infixl 1 >>%-infixl 1 >>%%<<--------------------------------------------------------------------------------- Combinations-------------------------------------------------------------------------------(>>%%<) :: (Buildable a, FromBuilder b) => Builder -> a -> b-(>>%%<) x a = x >%%< a-{-# INLINE (>>%%<) #-}--(>%%<<) :: (Show a, FromBuilder b) => Builder -> a -> b-(>%%<<) x a = x >>%%<< a-{-# INLINE (>%%<<) #-}--infixl 1 >>%%<-infixl 1 >%%<<---- TODO: something for indentation--- TODO: something to format a record nicely (with generics, probably)--- TODO: something like https://hackage.haskell.org/package/groom--- TODO: reexport Buildable--- TODO: write docs--- TODO: mention printf in description so that it would be findable--- TODO: mention things that work (<n+1>, <f n>, <show n>)--- TODO: colors?--- TODO: add NL for newline?--- TODO: have to decide on whether it would be >%< or >%%< or maybe >|<--- TODO: actually, what about |< and >|?--- TODO: what effect does it have on compilation time? what effect do---       other formatting libraries have on compilation time?--class FromBuilder a where-  fromBuilder :: Builder -> a--instance FromBuilder Builder where-  fromBuilder = id-  {-# INLINE fromBuilder #-}--instance FromBuilder String where-  fromBuilder = TL.unpack . toLazyText-  {-# INLINE fromBuilder #-}--instance FromBuilder T.Text where-  fromBuilder = TL.toStrict . toLazyText-  {-# INLINE fromBuilder #-}--instance FromBuilder TL.Text where-  fromBuilder = toLazyText-  {-# INLINE fromBuilder #-}+{- Acknowledgements+~~~~~~~~~~~~~~~~~~~++* 'prefixF', 'suffixF', 'padCenterF', 'groupInt' are taken from+      <https://hackage.haskell.org/package/formatting>+  Written by Github user @mwm+      <https://github.com/mwm>++* 'ordinalF' is taken from+      <https://hackage.haskell.org/package/formatting>+  Written by Chris Done+      <https://github.com/chrisdone>++* 'atBase' is taken from+      <https://hackage.haskell.org/package/formatting>, originally from+      <https://hackage.haskell.org/package/lens>+  Seems to be written by Johan Kiviniemi+      <https://github.com/ion1>+-}++{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}++module Fmt+(+  -- * Overloaded strings+  -- $overloadedstrings++  -- * Examples+  -- $examples++  -- * Basic formatting+  -- $brackets++  -- ** Ordinary brackets+  (%<),+  (>%),+  -- ** 'Show' brackets+  (%<<),+  (>>%),+  -- ** Combinations+  (>%%<),+  (>>%%<<),+  (>%%<<),+  (>>%%<),++  -- * Helper functions+  fmt,+  fmtLn,++  Builder,+  Buildable(..),++  -- * Formatters+  indent, indent',+  nameF,++  -- ** Lists+  listF, listF',+  blockListF, blockListF',+  jsonListF, jsonListF',++  -- ** Maps+  mapF, mapF',+  blockMapF, blockMapF',+  jsonMapF, jsonMapF',++  -- ** Tuples+  tupleF,+  tupleLikeF,++  -- ** ADTs+  maybeF,+  eitherF,++  -- ** Padding/trimming+  prefixF,+  suffixF,+  padLeftF,+  padRightF,+  padCenterF,++  -- ** Hex+  hexF,++  -- ** Bytestrings+  base64F,+  base64UrlF,++  -- ** Integers+  ordinalF,+  commaizeF,+  -- *** Base conversion+  octF,+  binF,+  baseF,++  -- ** Floating-point+  floatF,+  exptF,+  precF,+  fixedF,++  -- ** Conditional formatting+  whenF,+  unlessF,+)+where++-- Generic useful things+import Data.List+import Data.Monoid+import Lens.Micro+-- Text+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+-- 'Buildable' and text-format+import Data.Text.Buildable+import qualified Data.Text.Format as TF+-- Text 'Builder'+import Data.Text.Lazy.Builder hiding (fromString)+-- 'Foldable' and 'IsList' for list/map formatters+import Data.Foldable (toList)+#if __GLASGOW_HASKELL__ >= 708+import GHC.Exts (IsList, Item)+import qualified GHC.Exts as IsList (toList)+#endif++#if __GLASGOW_HASKELL__ < 710+import Data.Foldable (Foldable)+#endif++import Fmt.Internal+++{- $overloadedstrings++You need @OverloadedStrings@ enabled to use this library. There are three ways to do it:++  * __In GHCi:__ do @:set -XOverloadedStrings@.++  * __In a module:__ add @\{\-\# LANGUAGE OverloadedStrings \#\-\}@+    to the beginning of your module.++  * __In a project:__ add @OverloadedStrings@ to the @default-extensions@+    section of your @.cabal@ file.+-}++{- $examples++Here's a bunch of examples because some people learn better by looking at+examples.++Insert some variables into a string:++>>> let (a, b, n) = ("foo", "bar", 25)+>>> ("Here are some words: "%<a>%", "%<b>%"\nAlso a number: "%<n>%"") :: String+"Here are some words: foo, bar\nAlso a number: 25"++Print it:++>>> fmtLn ("Here are some words: "%<a>%", "%<b>%"\nAlso a number: "%<n>%"")+Here are some words: foo, bar+Also a number: 25++Format a list in various ways:++>>> let xs = ["John", "Bob"]++>>> fmtLn ("Using show: "%<<xs>>%"\nUsing listF: "%<listF xs>%"")+Using show: ["John","Bob"]+Using listF: [John, Bob]++>>> fmt ("YAML-like:\n"%<blockListF xs>%"")+YAML-like:+- John+- Bob++>>> fmt ("JSON-like: "%<jsonListF xs>%"")+JSON-like: [+  John+, Bob+]++-}++----------------------------------------------------------------------------+-- Operators with 'Buildable'+----------------------------------------------------------------------------++{- $brackets++To format strings, put variables between ('%<') and ('>%'):++>>> let name = "Alice"+>>> "Meet "%<name>%"!" :: String+"Meet Alice!"++Of course, 'Text' is supported as well:++>>> "Meet "%<name>%"!" :: Text+"Meet Alice!"++You don't actually need any type signatures; however, if you're toying with+this library in GHCi, it's recommended to either add a type signature or use+'fmtLn':++>>> fmtLn ("Meet "%<name>%"!")+Meet Alice!++Otherwise the type of the formatted string would be resolved to @IO ()@ and+printed without a newline, which is not very convenient when you're in+GHCi. On the other hand, it's useful for quick-and-dirty scripts:++@+main = do+  [fin, fout] \<- words \<$\> getArgs+  __"Reading data from "%\<fin\>%"\\n"__+  xs \<- readFile fin+  __"Writing processed data to "%\<fout\>%"\\n"__+  writeFile fout (show (process xs))+@++Anyway, let's proceed. Anything 'Buildable', including numbers, booleans,+characters and dates, can be put between ('%<') and ('>%'):++>>> let starCount = "173"+>>> fmtLn ("Meet "%<name>%"! She's got "%<starCount>%" stars on Github.")+"Meet Alice! She's got 173 stars on Github."++Since the only thing ('%<') and ('>%') do is concatenate strings and do+conversion, you can use any functions you want inside them. In this case,+'length':++>>> fmtLn (""%<name>%"'s name has "%<length name>%" letters")+Alice's name has 5 letters++If something isn't 'Buildable', just use 'show' on it:++>>> let pos = (3, 5)+>>> fmtLn ("Character's position: "%<show pos>%"")+Character's position: (3,5)++Or one of many formatters provided by this library – for instance, for tuples+of various sizes there's 'tupleF':++>>> fmtLn ("Character's position: "%<tupleF pos>%"")+Character's position: (3, 5)++Finally, for convenience there's the ('>%%<') operator, which can be used if+you've got one variable following the other:++>>> let (a, op, b, res) = (2, "*", 2, 4)+>>> fmtLn (""%<a>%%<op>%%<b>%" = "%<res>%"")+2*2 = 4++Also, since in some codebases there are /lots/ of types which aren't+'Buildable', there are operators ('%<<') and ('>>%'), which use 'show'+instead of 'build':++@+(""%\<show foo\>%%\<show bar\>%"")    ===    (""%\<\<foo\>\>%%\<\<bar\>\>%"")+@+-}++(%<) :: (FromBuilder b) => Builder -> Builder -> b+(%<) str rest = fromBuilder (str <> rest)++(>%) :: (Buildable a, FromBuilder b) => a -> Builder -> b+(>%) a rest = fromBuilder (build a <> rest)++(>%%<) :: (Buildable a, FromBuilder b) => a -> Builder -> b+(>%%<) a rest = fromBuilder (build a <> rest)++infixr 1 %<+infixr 1 >%+infixr 1 >%%<++----------------------------------------------------------------------------+-- Operators with 'Show'+----------------------------------------------------------------------------++(%<<) :: (FromBuilder b) => Builder -> Builder -> b+(%<<) str rest = str %< rest+{-# INLINE (%<<) #-}++(>>%) :: (Show a, FromBuilder b) => a -> Builder -> b+(>>%) a rest = show a >% rest+{-# INLINE (>>%) #-}++(>>%%<<) :: (Show a, FromBuilder b) => a -> Builder -> b+(>>%%<<) a rest = show a >% rest+{-# INLINE (>>%%<<) #-}++infixr 1 %<<+infixr 1 >>%+infixr 1 >>%%<<++----------------------------------------------------------------------------+-- Combinations+----------------------------------------------------------------------------++(>>%%<) :: (Buildable a, FromBuilder b) => a -> Builder -> b+(>>%%<) a rest = a >%%< rest+{-# INLINE (>>%%<) #-}++(>%%<<) :: (Show a, FromBuilder b) => a -> Builder -> b+(>%%<<) a rest = a >>%%<< rest+{-# INLINE (>%%<<) #-}++infixr 1 >>%%<+infixr 1 >%%<<++----------------------------------------------------------------------------+-- Main functions+----------------------------------------------------------------------------++{- | 'fmt' converts things to 'String', 'Text' or 'Builder'.++Most of the time you won't need it, as strings produced with ('%<') and+('>%') can already be used as 'String', 'Text', etc. However, combinators+like 'listF' can only produce 'Builder' (for better type inference), and you+need to use 'fmt' on them.++Also, 'fmt' can do printing:++>>> fmt "Hello world!\n"+Hello world!+-}+fmt :: FromBuilder b => Builder -> b+fmt = fromBuilder+{-# INLINE fmt #-}++{- | Like 'fmt', but appends a newline.+-}+fmtLn :: FromBuilder b => Builder -> b+fmtLn = fromBuilder . (<> "\n")+{-# INLINE fmtLn #-}++----------------------------------------------------------------------------+-- Formatters+----------------------------------------------------------------------------++{- | Attach a name to anything:++>>> fmt $ nameF "clients" $ blockListF ["Alice", "Bob", "Zalgo"]+clients:+  - Alice+  - Bob+  - Zalgo+-}+nameF :: Builder -> Builder -> Builder+nameF k v = case TL.lines (toLazyText v) of+    []  -> k <> ":\n"+    [l] -> k <> ": " <> fromLazyText l <> "\n"+    ls  -> k <> ":\n" <>+           mconcat ["  " <> fromLazyText s <> "\n" | s <- ls]++----------------------------------------------------------------------------+-- List formatters+----------------------------------------------------------------------------++{- | A simple comma-separated list formatter.++>>> listF ["hello", "world"]+"[hello, world]"+-}+listF :: (Foldable f, Buildable a) => f a -> Builder+listF = listF' build+{-# INLINE listF #-}++{- | A version of 'listF' that lets you supply your own building function for+list elements.++For instance, to format a list of lists you'd have to do this (since there's+no 'Buildable' instance for lists):++>>> listF' listF [[1,2,3],[4,5,6]]+"[[1, 2, 3], [4, 5, 6]]"+-}+listF' :: (Foldable f) => (a -> Builder) -> f a -> Builder+listF' fbuild xs = mconcat $+  "[" :+  intersperse ", " (map fbuild (toList xs)) +++  ["]"]++{-# SPECIALIZE listF' :: (a -> Builder) -> [a] -> Builder #-}++{- Note [Builder appending]+~~~~~~~~~~~~~~~~~~~~~~~~~~~++The documentation for 'Builder' says that it's preferrable to associate+'Builder' appends to the right (i.e. @a <> (b <> c)@). The maximum possible+association-to-the-right is achieved when we avoid appending builders+until the last second (i.e. in the latter scenario):++    -- (a1 <> x) <> (a2 <> x) <> ...+    mconcat [a <> x | a <- as]++    -- a1 <> x <> a2 <> x <> ...+    mconcat $ concat [[a, x] | a <- as]++However, benchmarks have shown that the former way is actually faster.+-}++{- | A multiline formatter for lists.++>>> fmt $ blockListF [1,2,3]+- 1+- 2+- 3++It automatically handles multiline list elements:++@+>>> fmt $ blockListF ["hello\nworld", "foo\nbar\nquix"]+- hello+  world++- foo+  bar+  quix+@+-}+blockListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder+blockListF = blockListF' build+{-# INLINE blockListF #-}++{- | A version of 'blockListF' that lets you supply your own building function+for list elements.+-}+blockListF' :: forall f a. (Foldable f) => (a -> Builder) -> f a -> Builder+blockListF' fbuild xs+  | null items      = "[]\n"+  | True `elem` mls = mconcat (intersperse "\n" items)+  | otherwise       = mconcat items+  where+    (mls, items) = unzip $ map buildItem (toList xs)+    -- Returns 'True' if the item is multiline+    buildItem :: a -> (Bool, Builder)+    buildItem x = case TL.lines (toLazyText (fbuild x)) of+      []     -> (False, "-\n")+      (l:ls) -> (not (null ls),+                 "- " <> fromLazyText l <> "\n" <>+                     mconcat ["  " <> fromLazyText s <> "\n" | s <- ls])++{-# SPECIALIZE blockListF' :: (a -> Builder) -> [a] -> Builder #-}++{- | A JSON-style formatter for lists.++>>> fmt $ jsonListF [1,2,3]+[+  1+, 2+, 3+]++Like 'blockListF', it handles multiline elements well:++>>> fmt $ jsonListF ["hello\nworld", "foo\nbar\nquix"]+[+  hello+  world+, foo+  bar+  quix+]++(Note that, unlike 'blockListF', it doesn't add blank lines in such cases.)+-}+jsonListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder+jsonListF = jsonListF' build+{-# INLINE jsonListF #-}++{- | A version of 'jsonListF' that lets you supply your own building function+for list elements.+-}+jsonListF' :: forall f a. (Foldable f) => (a -> Builder) -> f a -> Builder+jsonListF' fbuild xs+  | null items = "[]\n"+  | otherwise  = "[\n" <> mconcat items <> "]\n"+  where+    items = zipWith buildItem (True : repeat False) (toList xs)+    -- Item builder+    buildItem :: Bool -> a -> Builder+    buildItem isFirst x =+      case map fromLazyText (TL.lines (toLazyText (fbuild x))) of+        [] | isFirst   -> "\n"+           | otherwise -> ",\n"+        ls ->+            mconcat . map (<> "\n") $+              ls & _head %~ (if isFirst then ("  " <>) else (", " <>))+                 & _tail.each %~ ("  " <>)++{-# SPECIALIZE jsonListF' :: (a -> Builder) -> [a] -> Builder #-}++----------------------------------------------------------------------------+-- Map formatters+----------------------------------------------------------------------------++#if __GLASGOW_HASKELL__ >= 708+#  define MAPTOLIST IsList.toList+#else+#  define MAPTOLIST id+#endif++{- | A simple JSON-like map formatter; works for Map, HashMap, etc, as well as+ordinary lists of pairs. Doesn't handle multiline elements (for that you need 'blockMapF' or 'jsonMapF').++>>> mapF [("a", 1), ("b", 4)]+"{a: 1, b: 4}"+-}+mapF ::+#if __GLASGOW_HASKELL__ >= 708+    (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder+#else+    (Buildable k, Buildable v) => [(k, v)] -> Builder+#endif+mapF = mapF' build build+{-# INLINE mapF #-}++{- | A version of 'mapF' that lets you supply your own building function for+keys and values.+-}+mapF' ::+#if __GLASGOW_HASKELL__ >= 708+    (IsList t, Item t ~ (k, v)) =>+    (k -> Builder) -> (v -> Builder) -> t -> Builder+#else+    (k -> Builder) -> (v -> Builder) -> [(k, v)] -> Builder+#endif+mapF' fbuild_k fbuild_v xs =+  "{" <> mconcat (intersperse ", " (map buildPair (MAPTOLIST xs))) <> "}"+  where+    buildPair (k, v) = fbuild_k k <> ": " <> fbuild_v v++{- | A YAML-like map formatter:++>>> fmt $ blockMapF [("Odds", blockListF [1,3]), ("Evens", blockListF [2,4])]+Odds:+  - 1+  - 3+Evens:+  - 2+  - 4+-}+blockMapF ::+#if __GLASGOW_HASKELL__ >= 708+    (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder+#else+    (Buildable k, Buildable v) => [(k, v)] -> Builder+#endif+blockMapF = blockMapF' build build+{-# INLINE blockMapF #-}++{- | A version of 'blockMapF' that lets you supply your own building function+for keys and values.+-}+blockMapF' ::+#if __GLASGOW_HASKELL__ >= 708+    (IsList t, Item t ~ (k, v)) =>+    (k -> Builder) -> (v -> Builder) -> t -> Builder+#else+    (k -> Builder) -> (v -> Builder) -> [(k, v)] -> Builder+#endif+blockMapF' fbuild_k fbuild_v xs+  | null items = "{}\n"+  | otherwise  = mconcat items+  where+    items = map (\(k, v) -> nameF (fbuild_k k) (fbuild_v v)) (MAPTOLIST xs)++{- | A JSON-like map formatter (unlike 'mapF', always multiline):++>>> fmt $ jsonMapF [("Odds", jsonListF [1,3]), ("Evens", jsonListF [2,4])]+{+  Odds:+    [+      1+    , 3+    ]+, Evens:+    [+      2+    , 4+    ]+}+-}+jsonMapF ::+#if __GLASGOW_HASKELL__ >= 708+    (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder+#else+    (Buildable k, Buildable v) => [(k, v)] -> Builder+#endif+jsonMapF = jsonMapF' build build+{-# INLINE jsonMapF #-}++{- | A version of 'jsonMapF' that lets you supply your own building function+for keys and values.+-}+jsonMapF' ::+#if __GLASGOW_HASKELL__ >= 708+    forall t k v.+    (IsList t, Item t ~ (k, v)) =>+    (k -> Builder) -> (v -> Builder) -> t -> Builder+#else+    forall k v.+    (k -> Builder) -> (v -> Builder) -> [(k, v)] -> Builder+#endif+jsonMapF' fbuild_k fbuild_v xs+  | null items = "{}\n"+  | otherwise  = "{\n" <> mconcat items <> "}\n"+  where+    items = zipWith buildItem (True : repeat False) (MAPTOLIST xs)+    -- Item builder+    buildItem :: Bool -> (k, v) -> Builder+    buildItem isFirst (k, v) = do+      let kb = (if isFirst then "  " else ", ") <> fbuild_k k+      case map fromLazyText (TL.lines (toLazyText (fbuild_v v))) of+        []  -> kb <> ":\n"+        [l] -> kb <> ": " <> l <> "\n"+        ls  -> kb <> ":\n" <>+               mconcat ["    " <> s <> "\n" | s <- ls]++----------------------------------------------------------------------------+-- Tuple formatters+----------------------------------------------------------------------------++class TupleF a where+  {- |+Format a tuple (of up to 8 elements):++>>> tupleF (1,2,"hi")+"(1, 2, hi)"++If any of the elements takes several lines, an alternate format is used:++@+>>> fmt $ tupleF ("test","foo\nbar","more test")+( test+,+  foo+  bar+,+  more test )+@+  -}+  tupleF :: a -> Builder++instance (Buildable a1, Buildable a2)+  => TupleF (a1, a2) where+  tupleF (a1, a2) = tupleLikeF+    [build a1, build a2]++instance (Buildable a1, Buildable a2, Buildable a3)+  => TupleF (a1, a2, a3) where+  tupleF (a1, a2, a3) = tupleLikeF+    [build a1, build a2, build a3]++instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4)+  => TupleF (a1, a2, a3, a4) where+  tupleF (a1, a2, a3, a4) = tupleLikeF+    [build a1, build a2, build a3, build a4]++instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4,+          Buildable a5)+  => TupleF (a1, a2, a3, a4, a5) where+  tupleF (a1, a2, a3, a4, a5) = tupleLikeF+    [build a1, build a2, build a3, build a4,+     build a5]++instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4,+          Buildable a5, Buildable a6)+  => TupleF (a1, a2, a3, a4, a5, a6) where+  tupleF (a1, a2, a3, a4, a5, a6) = tupleLikeF+    [build a1, build a2, build a3, build a4,+     build a5, build a6]++instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4,+          Buildable a5, Buildable a6, Buildable a7)+  => TupleF (a1, a2, a3, a4, a5, a6, a7) where+  tupleF (a1, a2, a3, a4, a5, a6, a7) = tupleLikeF+    [build a1, build a2, build a3, build a4,+     build a5, build a6, build a7]++instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4,+          Buildable a5, Buildable a6, Buildable a7, Buildable a8)+  => TupleF (a1, a2, a3, a4, a5, a6, a7, a8) where+  tupleF (a1, a2, a3, a4, a5, a6, a7, a8) = tupleLikeF+    [build a1, build a2, build a3, build a4,+     build a5, build a6, build a7, build a8]++{- |+Format a list like a tuple. (This function is used to define 'tupleF'.)+-}+tupleLikeF :: [Builder] -> Builder+tupleLikeF xs+  | True `elem` mls = mconcat (intersperse ",\n" items)+  | otherwise = "(" <> mconcat (intersperse ", " xs) <> ")"+  where+    (mls, items) = unzip $ zipWith3 buildItem+                             xs (set _head True falses) (set _last True falses)+    -- A list of 'False's which has the same length as 'xs'+    falses = map (const False) xs+    -- Returns 'True' if the item is multiline+    buildItem :: Builder+              -> Bool              -- ^ Is the item the first?+              -> Bool              -- ^ Is the item the last?+              -> (Bool, Builder)+    buildItem x isFirst isLast =+      case map fromLazyText (TL.lines (toLazyText x)) of+        [] | isFirst && isLast -> (False, "()\n")+           | isFirst           -> (False, "(\n")+           |            isLast -> (False, "  )\n")+           | otherwise         -> (False, "")+        ls ->+           (not (null (tail ls)),+            mconcat . map (<> "\n") $+              ls & _head %~ (if isFirst then ("( " <>) else ("  " <>))+                 & _tail.each %~ ("  " <>)+                 & _last %~ (if isLast then (<> " )") else id))++----------------------------------------------------------------------------+-- ADT formatters+----------------------------------------------------------------------------++{- |+Like 'build' for 'Maybe', but displays 'Nothing' as @<Nothing>@ instead of an empty string.++'build':++>>> build (Nothing :: Maybe Int)+""+>>> build (Just 1 :: Maybe Int)+"1"++'maybeF':++>>> maybeF (Nothing :: Maybe Int)+"<Nothing>"+>>> maybeF (Just 1 :: Maybe Int)+"1"+-}+maybeF :: Buildable a => Maybe a -> Builder+maybeF = maybe "<Nothing>" build++{- |+Format an 'Either':++>>> eitherF (Right 1)+"<Right>: 1"+-}+eitherF :: (Buildable a, Buildable b) => Either a b -> Builder+eitherF = either (\x -> "<Left>: " <> build x) (\x -> "<Right>: " <> build x)++----------------------------------------------------------------------------+-- Other formatters+----------------------------------------------------------------------------++{- |+Take the first N characters:++>>> prefixF 3 "hello"+"hel"+-}+prefixF :: Buildable a => Int -> a -> Builder+prefixF size =+  fromLazyText . TL.take (fromIntegral size) . toLazyText . build++{- |+Take the last N characters:++>>> suffixF 3 "hello"+"llo"+-}+suffixF :: Buildable a => Int -> a -> Builder+suffixF size =+  fromLazyText .+  (\t -> TL.drop (TL.length t - fromIntegral size) t) .+  toLazyText . build++{- |+@padLeftF n c@ pads the string with character @c@ from the left side until it+becomes @n@ characters wide (and does nothing if the string is already that+long, or longer):++>>> padLeftF 5 '0' 12+"00012"+>>> padLeftF 5 '0' 123456+"123456"+-}+padLeftF :: Buildable a => Int -> Char -> a -> Builder+padLeftF = TF.left++{- |+@padRightF n c@ pads the string with character @c@ from the right side until+it becomes @n@ characters wide (and does nothing if the string is already+that long, or longer):++>>> padRightF 5 ' ' "foo"+"foo  "+>>> padRightF 5 ' ' "foobar"+"foobar"+-}+padRightF :: Buildable a => Int -> Char -> a -> Builder+padRightF = TF.right++{- |+@padCenterF n c@ pads the string with character @c@ from both sides until+it becomes @n@ characters wide (and does nothing if the string is already+that long, or longer):++>>> padCenterF 5 '=' "foo"+"=foo="+>>> padCenterF 5 '=' "foobar"+"foobar"++When padding can't be distributed equally, the left side is preferred:++>>> padCenter 8 '=' "foo"+"===foo=="+-}+padCenterF :: Buildable a => Int -> Char -> a -> Builder+padCenterF i c =+  fromLazyText . TL.center (fromIntegral i) c . toLazyText . build++{- |+Add an ordinal suffix to a number:++>>> ordinalF 15+"15th"+>>> ordinalF 22+"22nd"+-}+ordinalF :: (Buildable a, Integral a) => a -> Builder+ordinalF n+  | tens > 3 && tens < 21 = build n <> "th"+  | otherwise = build n <> case n `mod` 10 of+                             1 -> "st"+                             2 -> "nd"+                             3 -> "rd"+                             _ -> "th"+  where+    tens = n `mod` 100++{- |+Break digits in a number:++>>> commaizeF 15830000+"15,830,000"+-}+commaizeF :: (Buildable a, Integral a) => a -> Builder+commaizeF = groupInt 3 ','++{- |+Format a number as octal:++>>> listF' octF [7,8,9,10]+"[7, 10, 11, 12]"+-}+octF :: Integral a => a -> Builder+octF = baseF 8++{- |+Format a number as binary:++>>> listF' binF [7,8,9,10]+"[111, 1000, 1001, 1010]"+-}+binF :: Integral a => a -> Builder+binF = baseF 2++{- |+Format a number in arbitrary base (up to 36):++>>> baseF 3 10000+"111201101"+>>> baseF 7 10000+"41104"+>>> baseF 36 10000+"7ps"+-}+baseF :: Integral a => Int -> a -> Builder+baseF numBase = build . atBase numBase++{- |+Format a floating-point number:++>>> floatF 3.1415+"3.1415"++Numbers bigger than 1e21 or smaller than 1e-6 will be displayed using+scientific notation:++>>> listF' floatF [1e-6,9e-7]+"[0.000001, 9e-7]"+>>> listF' floatF [9e20,1e21]+"[900000000000000000000, 1e21]"+-}+floatF :: Real a => a -> Builder+floatF = TF.shortest++{- |+Format a floating-point number using scientific notation, with given amount+of precision:++>>> listF' (exptF 5) [pi,0.1,10]+"[3.14159e0, 1.00000e-1, 1.00000e1]"+-}+exptF :: Real a => Int -> a -> Builder+exptF = TF.expt++{- |+Format a floating-point number with given amount of precision.++For small numbers, it uses scientific notation for everything smaller than+1e-6:++> listF' (precF 3) [1e-5,1e-6,1e-7]+"[0.0000100, 0.00000100, 1.00e-7]"++For large numbers, it uses scientific notation for everything larger than+1eN, where N is the precision:++> listF' (precF 4) [1e3,5e3,1e4]+"[1000, 5000, 1.000e4]"+-}+precF :: Real a => Int -> a -> Builder+precF = TF.prec++{- |+Format a floating-point number without scientific notation:++>>> listF' (fixedF 5) [pi,0.1,10]+"[3.14159, 0.10000, 10.00000]"+-}+fixedF :: Real a => Int -> a -> Builder+fixedF = TF.fixed++----------------------------------------------------------------------------+-- Conditional formatters+----------------------------------------------------------------------------++{- |+Display something only if the condition is 'True' (empty string otherwise).++@+>>> "Hello!" <> whenF showDetails (", details: "%<foobar>%"")+@++Note that it can only take a 'Builder' (because otherwise it would be+unusable with ('%<')-formatted strings which can resolve to any 'FromBuilder'). Thus, use 'fmt' if you need just one value:++@+>>> "Maybe here's a number: "%<whenF cond (fmt n)>%""+@+-}+whenF :: Bool -> Builder -> Builder+whenF True  x = x+whenF False _ = mempty+{-# INLINE whenF #-}++{- |+Display something only if the condition is 'False' (empty string otherwise).+-}+unlessF :: Bool -> Builder -> Builder+unlessF False x = x+unlessF True  _ = mempty+{-# INLINE unlessF #-}++----------------------------------------------------------------------------+-- Utilities+----------------------------------------------------------------------------++{- |+Indent already formatted text.++>>> fmt $ "This is a list:\n" <> indent 4 (blockListF [1,2,3])+This is a list:+    - 1+    - 2+    - 3+-}+indent :: Int -> Builder -> Builder+indent n a = go (toLazyText a)+  where+    spaces = fromText (T.replicate n (T.singleton ' '))+    -- We don't use 'lines' because it doesn't distinguish between trailing+    -- newline being present/absent. We want the following behavior:+    --     >>> indent 2 "hi"+    --     "  hi"+    --     >>> indent 2 "hi\n"+    --     "  hi\n"+    go t | TL.null t = mempty+    go t = let (l, t') = TL.break ((==) '\n') t+           in spaces <> if TL.null t'+                          then fromLazyText l+                          else fromLazyText l <> singleton '\n' <>+                               go (TL.tail t')++----------------------------------------------------------------------------+-- TODOs+----------------------------------------------------------------------------++{- add these:++* something that would cut a string by adding ellipsis to the center+* 'time' that would use hackage.haskell.org/package/time/docs/Data-Time-Format.html#t:FormatTime+* something that would show time and date in a standard way+* something to format a floating-point number without any scientific notation+-}++{- list/map:++* maybe add something like blockMapF_ and blockListF_ that would add+  a blank line automatically? or `---` and `:::` or something?+* should also add something to _not_ add a blank line between list+  entries (e.g. when they are 'name'd and can be clearly differentiated)+* should also add something that would truncate lists in the middle+  (and maybe not in the middle as well)+* the problem is that the user might want to combine them so I guess+  we can't make a separate combinator for each+* there don't seem to be any cases when 'listF' is better than 'jsonListF',+  so we'd want to leave only one of those, but there are cases when 'mapF' is+  better than 'jsonMapF' (i.e. when you want everything to be on one+  line). What to do? Maybe rename 'jsonMapF' to 'mapF' and 'mapF' to ???+  (can't think of a name)?+-}++{- docs++* add an examples section in the beginning+* provide a formatting→fmt transition table+* mention that fmt doesn't do the neat thing that formatting does with (<>)+  (or maybe it does? there's a monoid instance for functions after all,+  though I might also have to write a IsString instance for (a -> Builder))+* write that if %< >% are hated or if it's inconvenient in some cases,+  you can just use provided formatters and <> (add Fmt.DIY for that?)+  (e.g. "pub:" <> base16F foo)+* write that it can be used in parallel with formatting?+* mention printf in cabal description so that it would be findable+* clarify philosophy (“take a free spot in design space; write the+  best possible library around it, not just a proof of concept”)+* clarify what exactly is hard about writing `formatting` formatters+* write that [(a,b)] works too and could be used+-}++{- others++* rename 'padCenterF'+* change indentation to always add newlines+* something to format a record nicely (with generics, probably)+* something like https://hackage.haskell.org/package/groom+* something for wrapping lists (not indenting, just hard-wrapping)+* reexport (<>)? don't know whether to use Semigroup or Monoid, though+* colors?+* should it be called 'listBlock' or 'blockList'?+* add NL or _NL for newline? or (<\>) or (<>\)? and also (>%\)?+* have to decide on whether it would be >%< or >%%< or maybe >|<+* actually, what about |< and >|?+* what effect does it have on compilation time? what effect do+  other formatting libraries have on compilation time?+* use 4 spaces instead of 2?+* change tuples to correspond to jsonList+* be consistent about newlines after tuples/maps/lists+* find some way to use IO inside %<>% brackets+-}

@@ -1,20 +0,0 @@-{-# LANGUAGE GADTs #-}--{-# OPTIONS_GHC -fno-warn-orphans #-}---module Fmt.IO-(-  module Fmt,-)-where---import Fmt-import qualified Data.Text.Lazy.Builder as TL-import qualified Data.Text.Lazy.IO as TL---instance (a ~ ()) => FromBuilder (IO a) where-  fromBuilder = TL.putStr . TL.toLazyText-  {-# INLINE fromBuilder #-}

@@ -0,0 +1,192 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE CPP #-}++-- for FormatAsHex+#if __GLASGOW_HASKELL__ < 710+{-# LANGUAGE OverlappingInstances #-}+#endif++{- | A module providing access to internals (in case you really need them). Can+change at any time, though probably won't.+-}+module Fmt.Internal+(+  -- * Classes+  FromBuilder(..),+  FormatAsHex(..),+  FormatAsBase64(..),++  -- * Helpers+  groupInt,+  atBase,+  showSigned',+  intToDigit',+  indent',+)+where++-- Generic useful things+import Data.Monoid+import Numeric+import Data.Char+-- Text+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL+import qualified Data.Text.Lazy.Encoding as TL+-- 'Buildable' and text-format+import Data.Text.Buildable+import qualified Data.Text.Format as TF+-- Text 'Builder'+import Data.Text.Lazy.Builder hiding (fromString)+-- Bytestring+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+-- Formatting bytestrings+import qualified Data.ByteString.Base16          as B16+import qualified Data.ByteString.Base16.Lazy     as B16L+import qualified Data.ByteString.Base64          as B64+import qualified Data.ByteString.Base64.Lazy     as B64L+import qualified Data.ByteString.Base64.URL      as B64U+import qualified Data.ByteString.Base64.URL.Lazy as B64UL++----------------------------------------------------------------------------+-- FromBuilder+----------------------------------------------------------------------------++class FromBuilder a where+  fromBuilder :: Builder -> a++instance FromBuilder Builder where+  fromBuilder = id+  {-# INLINE fromBuilder #-}++instance (a ~ Char) => FromBuilder [a] where+  fromBuilder = TL.unpack . toLazyText+  {-# INLINE fromBuilder #-}++instance FromBuilder T.Text where+  fromBuilder = TL.toStrict . toLazyText+  {-# INLINE fromBuilder #-}++instance FromBuilder TL.Text where+  fromBuilder = toLazyText+  {-# INLINE fromBuilder #-}++instance (a ~ ()) => FromBuilder (IO a) where+  fromBuilder = TL.putStr . toLazyText+  {-# INLINE fromBuilder #-}++----------------------------------------------------------------------------+-- Hex+----------------------------------------------------------------------------++class FormatAsHex a where+  {- |+Format a number or bytestring as hex:++>>> hexF 3635+"e33"+  -}+  hexF :: a -> Builder++instance FormatAsHex BS.ByteString where+  hexF = fromText . T.decodeLatin1 . B16.encode++instance FormatAsHex BSL.ByteString where+  hexF = fromLazyText . TL.decodeLatin1 . B16L.encode++#if __GLASGOW_HASKELL__ >= 710+instance {-# OVERLAPPABLE #-} Integral a => FormatAsHex a where+  hexF = TF.hex+#else+instance Integral a => FormatAsHex a where+  hexF = TF.hex+#endif++----------------------------------------------------------------------------+-- Base64+----------------------------------------------------------------------------++class FormatAsBase64 a where+  {- |+Convert a bytestring to base64:++>>> base64F ("\0\50\63\80" :: BS.ByteString)+"ADI/UA=="+  -}+  base64F    :: a -> Builder+  {- |+Convert a bytestring to base64url (a variant of base64 which omits @\/@ and+thus can be used in URLs):++>>> base64UrlF ("\0\50\63\80" :: BS.ByteString)+"ADI_UA=="+  -}+  base64UrlF :: a -> Builder++instance FormatAsBase64 BS.ByteString where+  base64F    = fromText . T.decodeLatin1 . B64.encode+  base64UrlF = fromText . T.decodeLatin1 . B64U.encode++instance FormatAsBase64 BSL.ByteString where+  base64F    = fromLazyText . TL.decodeLatin1 . B64L.encode+  base64UrlF = fromLazyText . TL.decodeLatin1 . B64UL.encode++----------------------------------------------------------------------------+-- Helpers+----------------------------------------------------------------------------++groupInt :: (Buildable a, Integral a) => Int -> Char -> a -> Builder+groupInt 0 _ n = build n+groupInt i c n =+    fromLazyText . TL.reverse .+    foldr merge "" .+    TL.zip (zeros <> cycle' zeros') .+    TL.reverse .+    toLazyText . build+      $ n+  where+    zeros = TL.replicate (fromIntegral i) (TL.singleton '0')+    zeros' = TL.singleton c <> TL.tail zeros+    merge (f, c') rest+      | f == c = TL.singleton c <> TL.singleton c' <> rest+      | otherwise = TL.singleton c' <> rest+    cycle' xs = xs <> cycle' xs+    -- Suppress the warning about redundant Integral constraint+    _ = toInteger n++atBase :: Integral a => Int -> a -> String+atBase b _ | b < 2 || b > 36 = error ("baseF: Invalid base " ++ show b)+atBase b n =+  showSigned' (showIntAtBase (toInteger b) intToDigit') (toInteger n) ""+{-# INLINE atBase #-}++showSigned' :: Real a => (a -> ShowS) -> a -> ShowS+showSigned' f n+  | n < 0     = showChar '-' . f (negate n)+  | otherwise = f n++intToDigit' :: Int -> Char+intToDigit' i+  | i >= 0  && i < 10 = chr (ord '0' + i)+  | i >= 10 && i < 36 = chr (ord 'a' + i - 10)+  | otherwise = error ("intToDigit': Invalid int " ++ show i)++-- assumes that the prefix doesn't contain newlines+indent' :: Int -> T.Text -> Builder -> Builder+indent' n pref a = go True (toLazyText a)+  where+    spaces = fromText (T.replicate n (T.singleton ' '))+    go isFirst t+      | TL.null t = if isFirst then fromText pref else ""+      | otherwise = let (l, t') = TL.break ((==) '\n') t+                    in (if isFirst then fromText pref else spaces) <>+                        if TL.null t'+                          then fromLazyText l+                          else fromLazyText l <> singleton '\n' <>+                               go False (TL.tail t')

@@ -1,5 +1,6 @@ {-# LANGUAGE-OverloadedStrings+OverloadedStrings,+QuasiQuotes   #-}  @@ -10,8 +11,16 @@ import Data.Monoid ((<>)) -- Text import Data.Text (Text)+import qualified Data.Text as T import qualified Data.Text.Lazy as TL-import Data.Text.Lazy.Builder (Builder)+import NeatInterpolation+-- Various data structures+import qualified Data.Vector as V+import Data.Vector (Vector)+import qualified Data.Map as M+import Data.Map (Map)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL -- Tests import Test.Hspec @@ -21,7 +30,7 @@  main :: IO () main = hspec $ do-  let n = 25 :: Int+  let n = 25 :: Integer       s = "!" :: String    it "simple examples" $ do@@ -62,9 +71,467 @@     it "Builder" $       ("a"%<n>%"b" :: Builder) `shouldBe` "a25b" ++  describe "formatters" $ do+    describe "'indent'" $ do+      it "simple examples" $ do+        indent 0 "hi" ==#> "hi"+        indent 0 "\nhi\n\n" ==#> "\nhi\n\n"+        indent 2 "hi" ==#> "  hi"+        indent 2 "hi\n" ==#> "  hi\n"+        indent 2 "" ==#> ""+        indent 2 "hi\nbye" ==#> "  hi\n  bye"+        indent 2 "hi\nbye\n" ==#> "  hi\n  bye\n"+      it "formatting a block" $ do+        ("Some numbers:\n"<>+         indent 2 (+           "odd: "%<n>%"\n"<>+           "even: "%<n+1>%"")) ==#> "Some numbers:\n  odd: 25\n  even: 26"++    describe "'listF'" $ do+      it "simple examples" $ do+        listF ([] :: [Int]) ==#> "[]"+        listF [n] ==#> "[25]"+        listF [n,n+1] ==#> "[25, 26]"+        listF [s,s<>s,"",s<>s<>s] ==#> "[!, !!, , !!!]"+      it "different Foldables" $ do+        listF ([1,2,3] :: [Int]) ==#> "[1, 2, 3]"+        listF (V.fromList [1,2,3] :: Vector Int) ==#> "[1, 2, 3]"+        listF (M.fromList [(1,2),(3,4),(5,6)] :: Map Int Int) ==#> "[2, 4, 6]"++    describe "'blockListF'" $ do+      it "empty list" $ do+        blockListF ([] :: [Int]) ==#> "[]\n"+      it "null elements" $ do+        blockListF ([""] :: [Text]) ==#> [text|+          -+          |]+        blockListF (["",""] :: [Text]) ==#> [text|+          -+          -+          |]+        blockListF (["","a",""] :: [Text]) ==#> [text|+          -+          - a+          -+          |]+      it "single-line elements" $ do+        blockListF (["a"] :: [Text]) ==#> [text|+          - a+          |]+        blockListF (["a","b"] :: [Text]) ==#> [text|+          -_a+          -_b+          |]+        blockListF (["a","b","ccc"] :: [Text]) ==#> [text|+          - a+          - b+          - ccc+          |]+      it "multi-line elements" $ do+        blockListF (["a\nx"] :: [Text]) ==#> [text|+          - a+            x+          |]+        blockListF (["a\n x"] :: [Text]) ==#> [text|+          - a+             x+          |]+        blockListF (["a\n x"," b\nxx\ny y ","c\n\n"] :: [Text]) ==#> [text|+          - a+             x++          -  b+            xx+            y y_++          - c+          __+          |]+      it "mix of single-line and multi-line" $ do+        blockListF (["a\nx","b"] :: [Text]) ==#> [text|+          - a+            x++          - b+          |]+        blockListF (["a\nx","b\n"] :: [Text]) ==#> [text|+          - a+            x++          - b+          |]+        blockListF (["a"," b\nxx\ny y ","c\n\n"] :: [Text]) ==#> [text|+          - a++          -  b+            xx+            y y_++          - c+          __+          |]+    describe "'jsonListF'" $ do+      it "empty list" $ do+        jsonListF ([] :: [Int]) ==#> "[]\n"+      it "null elements" $ do+        jsonListF ([""] :: [Text]) ==#> [text|+          [++          ]+          |]+        jsonListF (["",""] :: [Text]) ==#> [text|+          [++          ,+          ]+          |]+        jsonListF (["","a",""] :: [Text]) ==#> [text|+          [++          , a+          ,+          ]+          |]+      it "single-line elements" $ do+        jsonListF (["a"] :: [Text]) ==#> [text|+          [+            a+          ]+          |]+        jsonListF (["a","b"] :: [Text]) ==#> [text|+          [+            a+          , b+          ]+          |]+        jsonListF (["a","b","ccc"] :: [Text]) ==#> [text|+          [+            a+          , b+          , ccc+          ]+          |]+      it "multi-line elements" $ do+        jsonListF (["a\nx"] :: [Text]) ==#> [text|+          [+            a+            x+          ]+          |]+        jsonListF (["a\n x"] :: [Text]) ==#> [text|+          [+            a+             x+          ]+          |]+        jsonListF (["a\n x"," b\nxx\ny y ","c\n\n"] :: [Text]) ==#> [text|+          [+            a+             x+          ,  b+            xx+            y y_+          , c+          __+          ]+          |]+      it "mix of single-line and multi-line" $ do+        jsonListF (["a\nx","b"] :: [Text]) ==#> [text|+          [+            a+            x+          , b+          ]+          |]+        jsonListF (["a\nx","b\n"] :: [Text]) ==#> [text|+          [+            a+            x+          , b+          ]+          |]+        jsonListF (["a"," b\nxx\ny y ","c\n\n"] :: [Text]) ==#> [text|+          [+            a+          ,  b+            xx+            y y_+          , c+          __+          ]+          |]++    describe "'mapF'" $ do+      it "simple examples" $ do+        mapF ([] :: [(Int, Int)]) ==#> "{}"+        mapF [(n,n+1)] ==#> "{25: 26}"+        mapF [(s,n)] ==#> "{!: 25}"+        mapF [('a',True),('b',False),('c',True)] ==#>+          "{a: True, b: False, c: True}"+      it "different map types" $ do+        let m = [('a',True),('b',False),('d',False),('c',True)]+        mapF m ==#> "{a: True, b: False, d: False, c: True}"+        mapF (M.fromList m) ==#> "{a: True, b: False, c: True, d: False}"++    describe "'blockMapF'" $ do+      it "empty map" $ do+        blockMapF ([] :: [(Int, Int)]) ==#> "{}\n"+      it "complex example" $ do+        blockMapF ([("hi", ""),+                    ("foo"," a\n  b"),+                    ("bar","a"),+                    ("baz","a\ng")] :: [(Text, Text)]) ==#> [text|+          hi:+          foo:+             a+              b+          bar: a+          baz:+            a+            g+          |]++    describe "'jsonMapF'" $ do+      it "empty map" $ do+        jsonMapF ([] :: [(Int, Int)]) ==#> "{}\n"+      it "complex example" $ do+        jsonMapF ([("hi", ""),+                   ("foo"," a\n  b"),+                   ("bar","a"),+                   ("baz","a\ng")] :: [(Text, Text)]) ==#> [text|+          {+            hi:+          , foo:+               a+                b+          , bar: a+          , baz:+              a+              g+          }+          |]++    describe "tuples" $ do+      it "tupleF" $ do+        -- we don't need complicated tests here, they're all tested in+        -- 'tupleLikeF' tests+        tupleF (n, s) ==#> "(25, !)"+        tupleF (n, s, n, s) ==#> "(25, !, 25, !)"+        tupleF (n, s, n, s, 'a', 'b', 'c', 'd') ==#>+          "(25, !, 25, !, a, b, c, d)"+      describe "tupleLikeF" $ do+        describe "one-line" $ do+          it "()" $ do+            tupleLikeF [] ==#> "()"+          it "('')" $ do+            tupleLikeF [""] ==#> "()"+          it "(a)" $ do+            tupleLikeF ["a"] ==#> "(a)"+          it "(a,b)" $ do+            tupleLikeF ["a", "b"] ==#> "(a, b)"+          it "(a,'')" $ do+            tupleLikeF ["a", ""] ==#> "(a, )"+          it "('',b)" $ do+            tupleLikeF ["", "b"] ==#> "(, b)"+          it "('','')" $ do+            tupleLikeF ["", ""] ==#> "(, )"+          it "(a,b,c)" $ do+            tupleLikeF ["a", "ba", "caba"] ==#> "(a, ba, caba)"+        it "weird case" $ do+          -- not sure whether I should fix it or not+          tupleLikeF ["a\n"] ==#> "(a\n)"+        describe "multiline" $ do+          describe "all non-empty" $ do+            it "1 element (2 lines)" $ do+              tupleLikeF ["a\nx"] ==#> [text|+                ( a+                  x )+                |]+              tupleLikeF ["a\n x"] ==#> [text|+                ( a+                   x )+                |]+              tupleLikeF [" a\nx\n"] ==#> [text|+                (  a+                  x )+                |]+            it "1 element (3 lines)" $ do+              tupleLikeF ["a\nb\nc"] ==#> [text|+                ( a+                  b+                  c )+                |]+            it "2 elements (1 line + 2 lines)" $ do+              tupleLikeF ["a", "b\nc"] ==#> [text|+                ( a+                ,+                  b+                  c )+                |]+            it "2 elements (2 lines + 1 line)" $ do+              tupleLikeF ["a\nb", "c"] ==#> [text|+                ( a+                  b+                ,+                  c )+                |]+            it "3 elements (each has 2 lines)" $ do+              tupleLikeF ["a\nb", "c\nd", "e\nf"] ==#> [text|+                ( a+                  b+                ,+                  c+                  d+                ,+                  e+                  f )+                |]+          describe "some empty" $ do+            it "2 elements (0 + 2)" $ do+              tupleLikeF ["", "a\nb"] ==#> [text|+                (+                ,+                  a+                  b )+                |]+            it "2 elements (2 + 0)" $ do+              tupleLikeF ["a\nb", ""] ==#> [text|+                ( a+                  b+                ,+                  )+                |]+            it "3 elements (0 + 2 + 0)" $ do+              tupleLikeF ["", "a\nb", ""] ==#> [text|+                (+                ,+                  a+                  b+                ,+                  )+                |]+            it "3 elements (2 + 0 + 2)" $ do+              tupleLikeF ["a\nb", "", "c\nd"] ==#> [text|+                ( a+                  b+                ,+                ,+                  c+                  d )+                |]+            it "4 elements (2 + 0 + 0 + 2)" $ do+              tupleLikeF ["a\nb", "", "", "c\nd"] ==#> [text|+                ( a+                  b+                ,+                ,+                ,+                  c+                  d )+                |]++    describe "ADTs" $ do+      it "maybeF" $ do+        maybeF (Nothing :: Maybe Int) ==#> "<Nothing>"+        maybeF (Just 3 :: Maybe Int) ==#> "3"+      it "eitherF" $ do+        eitherF (Left 1 :: Either Int Int) ==#> "<Left>: 1"+        eitherF (Right 1 :: Either Int Int) ==#> "<Right>: 1"++    describe "padding" $ do+      it "prefixF" $ do+        prefixF (-1) ("hello" :: Text) ==#> ""+        prefixF   0  ("hello" :: Text) ==#> ""+        prefixF   1  ("hello" :: Text) ==#> "h"+        prefixF   2  ("hello" :: Text) ==#> "he"+        prefixF   3  ("hello" :: Text) ==#> "hel"+        prefixF   5  ("hello" :: Text) ==#> "hello"+        prefixF 1000 ("hello" :: Text) ==#> "hello"+        prefixF 1000 (""      :: Text) ==#> ""+      it "suffixF" $ do+        suffixF (-1) ("hello" :: Text) ==#> ""+        suffixF   0  ("hello" :: Text) ==#> ""+        suffixF   1  ("hello" :: Text) ==#> "o"+        suffixF   2  ("hello" :: Text) ==#> "lo"+        suffixF   3  ("hello" :: Text) ==#> "llo"+        suffixF   5  ("hello" :: Text) ==#> "hello"+        suffixF 1000 ("hello" :: Text) ==#> "hello"+        suffixF 1000 (""      :: Text) ==#> ""+      it "padLeftF" $ do+        padLeftF (-1) '!' ("hello" :: Text) ==#> "hello"+        padLeftF   0  '!' ("hello" :: Text) ==#> "hello"+        padLeftF   1  '!' ("hello" :: Text) ==#> "hello"+        padLeftF   5  '!' ("hello" :: Text) ==#> "hello"+        padLeftF   6  '!' ("hello" :: Text) ==#> "!hello"+        padLeftF   7  '!' ("hello" :: Text) ==#> "!!hello"+        padLeftF   7  '!' (""      :: Text) ==#> "!!!!!!!"+      it "padRightF" $ do+        padRightF (-1) '!' ("hello" :: Text) ==#> "hello"+        padRightF   0  '!' ("hello" :: Text) ==#> "hello"+        padRightF   1  '!' ("hello" :: Text) ==#> "hello"+        padRightF   5  '!' ("hello" :: Text) ==#> "hello"+        padRightF   6  '!' ("hello" :: Text) ==#> "hello!"+        padRightF   7  '!' ("hello" :: Text) ==#> "hello!!"+        padRightF   7  '!' (""      :: Text) ==#> "!!!!!!!"+      it "padCenterF" $ do+        padCenterF (-1) '!' ("hello" :: Text) ==#> "hello"+        padCenterF   0  '!' ("hello" :: Text) ==#> "hello"+        padCenterF   1  '!' ("hello" :: Text) ==#> "hello"+        padCenterF   5  '!' ("hello" :: Text) ==#> "hello"+        padCenterF   6  '!' ("hello" :: Text) ==#> "!hello"+        padCenterF   7  '!' ("hello" :: Text) ==#> "!hello!"+        padCenterF   7  '!' ("hell"  :: Text) ==#> "!!hell!"+        padCenterF   7  '!' ("hel"   :: Text) ==#> "!!hel!!"+        padCenterF   8  '!' ("hell"  :: Text) ==#> "!!hell!!"+        padCenterF   8  '!' ("hel"   :: Text) ==#> "!!!hel!!"+        padCenterF   8  '!' (""      :: Text) ==#> "!!!!!!!!"++    describe "integer" $ do+      it "octF" $ do+        octF n ==#> "31"+      it "binF" $ do+        binF n ==#> "11001"+      it "baseF" $ do+        baseF 36 (n^n) ==#> "54kbbzw21jhueg5jb0ggr4p"+      it "-baseF" $ do+        baseF 36 (-(n^n)) ==#> "-54kbbzw21jhueg5jb0ggr4p"++    describe "floating-point" $ do+      let f1_3 = 1.2999999999999998 :: Double+      it "floatF" $ do+        floatF f1_3 ==#> "1.2999999999999998"+      it "exptF" $ do+        exptF 2 f1_3 ==#> "1.30e0"+      it "fixedF" $ do+        fixedF 2 f1_3 ==#> "1.30"+      it "precF" $ do+        precF 2 f1_3 ==#> "1.3"++    describe "conditionals" $ do+      it "whenF" $ do+        whenF True "hi" ==#> "hi"+        whenF False "hi" ==#> ""+      it "unlessF" $ do+        unlessF True "hi" ==#> ""+        unlessF False "hi" ==#> "hi"++    describe "'hexF'" $ do+      it "Int" $ do+        hexF n ==#> "19"+      it "-Int" $ do+        hexF (-n) ==#> "-19"+      it "strict ByteString" $ do+        hexF (BS.pack [15,250]) ==#> "0ffa"+      it "lazy ByteString" $ do+        hexF (BSL.pack [15,250]) ==#> "0ffa"+ ---------------------------------------------------------------------------- -- Utilities ----------------------------------------------------------------------------  (==%>) :: Text -> Text -> Expectation (==%>) = shouldBe++(==#>) :: Builder -> Text -> Expectation+(==#>) a b = a `shouldBe` build (T.replace "_" " " b)