fmt 0.5.0.0 → 0.6

raw patch · 15 files changed

+1733/−1644 lines, 15 filesdep +call-stackdep +doctestdep +semigroupsdep −base16-bytestringdep −text-formatdep ~basedep ~formattingPVP ok

version bump matches the API change (PVP)

Dependencies added: call-stack, doctest, semigroups

Dependencies removed: base16-bytestring, text-format

Dependency ranges changed: base, formatting

API changes (from Hackage documentation)

Files

• CHANGELOG.md +21/−0
• bench/Main.hs +9/−18
• fmt.cabal +31/−11
• lib/Fmt.hs +323/−1300
• lib/Fmt/Internal.hs +24/−218
• lib/Fmt/Internal/Core.hs +119/−0
• lib/Fmt/Internal/Formatters.hs +471/−0
• lib/Fmt/Internal/Generic.hs +230/−0
• lib/Fmt/Internal/Numeric.hs +168/−0
• lib/Fmt/Internal/Template.hs +113/−0
• lib/Fmt/Internal/Tuple.hs +114/−0
• lib/Fmt/Time.hs +78/−70
• tests/Main.hs +28/−27
• tests/doctest-config.json +3/−0
• tests/doctests.hs +1/−0

@@ -1,3 +1,24 @@+# 0.6++* Switched to `Buildable` from `formatting` (since `text-format` is+  unmaintained).++* Removed the `double-conversion` dependency (which was sometimes causing+  compilation issues). As the result, `exptF`, `fixedF` and `floatF` have+  become slower.++* The `precF` formatter was removed completely because its semantics was too+  confusing. You can use `Numeric.showGFloat` to achieve a similar effect.++* `floatF` now always prints a point, even if the number is integral.++* `tupleLikeF` has been removed. `TupleF` now has an additional instance+  that lets `tupleF` be used to format lists.++* The `base16-bytestring` dependency was removed.++* Compatibility with GHC 7.6 and 7.8 was dropped.+ # 0.5.0.0  * From this version on, `blockListF` never puts blank lines between items.

@@ -10,10 +10,7 @@ import           Data.String.Interpolate (i) import           Data.Text               (Text) import qualified Data.Text               as T-import qualified Data.Text.Format        as TF-import           Data.Text.Format.Params as TF-import qualified Data.Text.Lazy          as LT-import           Fmt                     ((+|), (|+))+import           Fmt                     ((+|), (|+), format) import           Formatting              (Format, formatToString, int, sformat, stext,                                           string, (%)) import           Text.Printf             (printf)@@ -25,12 +22,6 @@ -- Format utility functions ---------------------------------------------------------------------------- -format' :: TF.Params ps => TF.Format -> ps -> Text-format' f = LT.toStrict . TF.format f--formatS :: TF.Params ps => TF.Format -> ps -> String-formatS f = LT.unpack . TF.format f- -- Shorter alias for @formatToString@. fs :: Format String a -> a fs = formatToString@@ -69,10 +60,10 @@     [ bTextGroup (1 :: Int, 2 :: Int)       [ taggedB "fmt" $           \(a,b) -> "hello "+|a|+" world "+|b|+""+      , taggedB "fmt old-style" $+          \(a,b) -> format "hello {} world {}" a b :: Text       , taggedB "formatting" $           \(a,b) -> sformat ("hello "%int%" world "%int) a b-      , taggedB "text-format" $-          format' "hello {} world {}"       , taggedB "interpolate" $           \(a,b) -> T.pack [i|hello #{a} world #{b}|]       , taggedB "show" $@@ -83,10 +74,10 @@     , bStringGroup (1 :: Int, 2 :: Int)       [ taggedB "fmt" $           \(a,b) -> "hello "+|a|+" world "+|b|+""+      , taggedB "fmt old-style" $+          \(a,b) -> format "hello {} world {}" a b :: String       , taggedB "formatting" $           \(a,b) -> fs ("hello "%int%" world "%int) a b-      , taggedB "text-format" $-          formatS "hello {} world {}"       , taggedB "interpolate" $           \(a,b) -> [i|hello #{a} world #{b}|]       , taggedB "show" $@@ -100,10 +91,10 @@     [ bTextGroup (9 :: Int, "Beijing" :: Text)       [ taggedB "fmt" $           \(n,city) -> "There are "+|n|+" million bicycles in "+|city|+"."+      , taggedB "fmt old-style" $+          \(n,city) -> format "There are {} million bicycles in {}." n city :: Text       , taggedB "formatting" $           \(n,city) -> sformat ("There are "%int%" million bicycles in "%stext%".") n city-      , taggedB "text-format" $-          format' "There are {} million bicycles in {}."       , taggedB "interpolate" $           \(n,city) -> T.pack [i|There are #{n} million bicycles in #{city}.|]       , taggedB "show" $@@ -114,10 +105,10 @@     , bStringGroup (9 :: Int, "Beijing" :: String)       [ taggedB "fmt" $           \(n,city) -> "There are "+|n|+" million bicycles in "+|city|+"."+      , taggedB "fmt old-style" $+          \(n,city) -> format "There are {} million bicycles in {}." n city :: String       , taggedB "formatting" $           \(n,city) -> fs ("There are "%int%" million bicycles in "%string%".") n city-      , taggedB "text-format" $-          formatS "There are {} million bicycles in {}."       , taggedB "interpolate" $           \(n,city) -> [i|There are #{n} million bicycles in #{city}.|]       , taggedB "show" $

@@ -1,5 +1,5 @@ name:                fmt-version:             0.5.0.0+version:             0.6 synopsis:            A new formatting library description:   A new formatting library that tries to be simple to understand while still@@ -16,7 +16,7 @@     compile-time if you pass wrong arguments or not enough of them.   .   * <https://hackage.haskell.org/package/text-format text-format> takes a-    formatting string with angle brackets denoting places where arguments+    formatting string with curly braces denoting places where arguments     would be substituted (the arguments themselves are provided via a     tuple). If you want to apply formatting to some of the arguments, you     have to use one of the provided formatters. Like @printf@, it can fail at@@ -46,9 +46,10 @@ maintainer:          yom@artyom.me -- copyright: category:            Text-tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.2.1+tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1 build-type:          Simple extra-source-files:  CHANGELOG.md+                     tests/doctest-config.json cabal-version:       >=1.10  source-repository head@@ -57,39 +58,61 @@  library   exposed-modules:     Fmt-                       Fmt.Internal                        Fmt.Time+                       Fmt.Internal+                       Fmt.Internal.Core+                       Fmt.Internal.Formatters+                       Fmt.Internal.Template+                       Fmt.Internal.Tuple+                       Fmt.Internal.Numeric+                       Fmt.Internal.Generic+   build-depends:       base >=4.6 && <5,-                       base16-bytestring,                        base64-bytestring,                        bytestring,                        containers,+                       formatting >= 6.3.4,                        microlens >= 0.3,                        text,-                       text-format >= 0.3,                        time,                        time-locale-compat+   ghc-options:         -Wall -fno-warn-unused-do-bind   if impl(ghc > 8.0)     ghc-options:       -Wno-redundant-constraints   hs-source-dirs:      lib   default-language:    Haskell2010+  if !impl(ghc >= 8.0)+    build-depends: semigroups == 0.18.*  test-suite tests   main-is:             Main.hs   type:                exitcode-stdio-1.0   build-depends:       base >=4.6 && <5                      , bytestring+                     , call-stack                      , containers                      , fmt-                     , hspec >= 2.2 && < 2.5+                     , hspec >= 2.2 && < 2.6                      , neat-interpolation                      , text                      , vector+   ghc-options:         -Wall -fno-warn-unused-do-bind+   hs-source-dirs:      tests   default-language:    Haskell2010-  if impl(ghc < 7.10)++test-suite doctests+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  ghc-options:         -threaded+  hs-source-dirs:      tests+  main-is:             doctests.hs+  build-depends:       base >=4.6 && <5+                     , doctest+  build-tool-depends:  doctest-discover:doctest-discover+  if impl(ghc < 8.0)     buildable: False  benchmark benches@@ -105,9 +128,6 @@                      , formatting                      , interpolate                      , text-                     , text-format                      , vector   ghc-options:         -Wall   default-language:    Haskell2010-  if impl(ghc < 7.10)-    buildable: False

@@ -18,1306 +18,329 @@       <https://github.com/ion1> -} -{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-#  define _OVERLAPPING_-#  define _OVERLAPPABLE_-#  define _OVERLAPS_-#else-#  define _OVERLAPPING_ {-# OVERLAPPING #-}-#  define _OVERLAPPABLE_ {-# OVERLAPPABLE #-}-#  define _OVERLAPS_ {-# OVERLAPS #-}-#endif--{-# OPTIONS_GHC -fno-warn-orphans #-}--module Fmt-(-  -- * Overloaded strings-  -- $overloadedstrings--  -- * Examples-  -- $examples--  -- * Migration guide from @formatting@-  -- $migration--  -- * Basic formatting-  -- $brackets--  -- ** Ordinary brackets-  -- $god1-  (+|),-  (|+),-  -- ** 'Show' brackets-  -- $god2-  (+||),-  (||+),-  -- ** Combinations-  -- $god3-  (|++|),-  (||++||),-  (|++||),-  (||++|),--  -- * Old-style formatting-  format,-  formatLn,-  TF.Format,--  -- * Helper functions-  fmt,-  fmtLn,--  Builder,-  Buildable(..),--  -- * Formatters--  -- ** Time-  module Fmt.Time,--  -- ** Text-  indentF, indentF',-  nameF,-  unwordsF,-  unlinesF,--  -- ** 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,-  padBothF,--  -- ** Hex-  hexF,--  -- ** Bytestrings-  base64F,-  base64UrlF,--  -- ** Integers-  ordinalF,-  commaizeF,-  -- *** Base conversion-  octF,-  binF,-  baseF,--  -- ** Floating-point-  floatF,-  exptF,-  precF,-  fixedF,--  -- ** Conditional formatting-  whenF,-  unlessF,--  -- ** Generic formatting-  genericF,-)-where---- Generic useful things-import Data.List-import Data.Monoid-import Lens.Micro--- Containers-import Data.Map (Map)-import qualified Data.Map as Map-import Data.Set (Set)-import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap-import Data.IntSet (IntSet)-import qualified Data.IntSet as IntSet-import Data.Sequence (Seq)--- 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--- Generics-import GHC.Generics--#if __GLASGOW_HASKELL__ < 710-import Data.Foldable (Foldable)-#endif--#if MIN_VERSION_base(4,9,0)-import Data.List.NonEmpty (NonEmpty)-#endif--import Fmt.Internal-import Fmt.Time---{- $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-]---}--{- $migration--Instead of using @%@, surround variables with '+|' and '|+'. You don't have-to use @sformat@ or anything else, and also where you were using @build@,-@int@, @text@, etc in @formatting@, you don't have to use anything in @fmt@:--@-formatting    __sformat ("Foo: "%build%", bar: "%int) foo bar__-       fmt    __"Foo: "+|foo|+", bar: "+|bar|+""__-@--The resulting formatted string is polymorphic and can be used as 'String',-'Text', 'Builder' or even 'IO' (i.e. the string will be printed to the-screen). However, when printing it is recommended to use 'fmt' or 'fmtLn'-for clarity.--@fmt@ provides lots of formatters (which are simply functions that produce-'Builder'):--@-formatting    __sformat ("Got another byte ("%hex%")") x__-       fmt    __"Got another byte ("+|hexF x|+")"__-@--Instead of the @shown@ formatter, either just use 'show' or double brackets:--@-formatting    __sformat ("This uses Show: "%shown%") foo__-    fmt #1    __"This uses Show: "+|show foo|+""__-    fmt #2    __"This uses Show: "+||foo||+""__-@--Many formatters from @formatting@ have the same names in @fmt@, but with-added “F”: 'hexF', 'exptF', etc. Some have been renamed, though:--@-__Cutting:__-  fitLeft  -\> 'prefixF'-  fitRight -\> 'suffixF'--__Padding:__-  left   -\> 'padLeftF'-  right  -\> 'padRightF'-  center -\> 'padBothF'--__Stuff with numbers:__-  ords   -\> 'ordinalF'-  commas -\> 'commaizeF'-@--Also, some formatters from @formatting@ haven't been added to @fmt@-yet. Specifically:--* @plural@ and @asInt@ (but instead of @asInt@ you can use 'fromEnum')-* @prefixBin@, @prefixOrd@, @prefixHex@, and @bytes@-* formatters that use @Scientific@ (@sci@ and @scifmt@)--They will be added later. (On the other hand, @fmt@ provides some useful-formatters not available in @formatting@, such as 'listF', 'mapF', 'tupleF'-and so on.)--}--------------------------------------------------------------------------------- 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||+"")__-@--}---- $god1--- Operators for the operators god!---- | Concatenate, then convert-(+|) :: (FromBuilder b) => Builder -> Builder -> b-(+|) str rest = fromBuilder (str <> rest)---- | 'build' and concatenate, then convert-(|+) :: (Buildable a, FromBuilder b) => a -> Builder -> b-(|+) a rest = fromBuilder (build a <> rest)--infixr 1 +|-infixr 1 |+--------------------------------------------------------------------------------- Operators with 'Show'--------------------------------------------------------------------------------- $god2--- More operators for the operators god!---- | Concatenate, then convert-(+||) :: (FromBuilder b) => Builder -> Builder -> b-(+||) str rest = str +| rest-{-# INLINE (+||) #-}---- | 'show' and concatenate, then convert-(||+) :: (Show a, FromBuilder b) => a -> Builder -> b-(||+) a rest = show a |+ rest-{-# INLINE (||+) #-}--infixr 1 +||-infixr 1 ||+--------------------------------------------------------------------------------- Combinations-------------------------------------------------------------------------------{- $god3--Z̸͠A̵̕͟͠L̡̀́͠G̶̛O͝ ̴͏̀ I͞S̸̸̢͠  ̢̛͘͢C̷͟͡Ó̧̨̧͞M̡͘͟͞I̷͜N̷̕G̷̀̕--(Though you can just use @""@ between @+| |+@ instead of using these-operators, and Show-brackets don't have to be used at all because there's-'show' available.)--}--(|++|) :: (Buildable a, FromBuilder b) => a -> Builder -> b-(|++|) a rest = fromBuilder (build a <> rest)-{-# INLINE (|++|) #-}--(||++||) :: (Show a, FromBuilder b) => a -> Builder -> b-(||++||) a rest = show a |+ rest-{-# INLINE (||++||) #-}--(||++|) :: (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 ||++||-infixr 1 ||++|-infixr 1 |++||--------------------------------------------------------------------------------- Old-style formatting-------------------------------------------------------------------------------{- | An old-style formatting function taken from @text-format@ (see-"Data.Text.Format"). Unlike 'Data.Text.Format.format' from-"Data.Text.Format", it can produce 'String' and strict 'Text' as well (and-print to console too). Also it's polyvariadic:-->>> format "{} + {} = {}" 2 2 4-"2 + 2 = 4"--You can use arbitrary formatters:-->>> format "0x{} + 0x{} = 0x{}" (hexF 130) (hexF 270) (hexF (130+270))-"0x82 + 0x10e = 0x190"--}-format :: FormatType r => TF.Format -> r-format f = format' f []-{-# INLINE format #-}--{- | Like 'format', but adds a newline.--}-formatLn :: FormatType r => TF.Format -> r-formatLn f = format' (f <> "\n") []-{-# INLINE formatLn #-}--------------------------------------------------------------------------------- Helper 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 #-}--------------------------------------------------------------------------------- Text formatters-------------------------------------------------------------------------------{- |-Indent a block of text.-->>> fmt $ "This is a list:\n" <> indentF 4 (blockListF [1,2,3])-This is a list:-    - 1-    - 2-    - 3--The output will always end with a newline, even when the input doesn't.--}-indentF :: Int -> Builder -> Builder-indentF n a = case TL.lines (toLazyText a) of-    [] -> fromLazyText (spaces <> "\n")-    xs -> fromLazyText $ TL.unlines (map (spaces <>) xs)-  where-    spaces = TL.replicate (fromIntegral n) (TL.singleton ' ')--{- | 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]--{- | Put words between elements.-->>> fmt $ unwordsF ["hello", "world"]-hello world--Of course, it works on anything 'Buildable':-->>> fmt $ unwordsF [1, 2]-1 2--}-unwordsF :: (Foldable f, Buildable a) => f a -> Builder-unwordsF = mconcat . intersperse " " . map build . toList--{-# SPECIALIZE unwordsF :: Buildable a => [a] -> Builder #-}--{- | Arrange elements on separate lines.-->>> fmt $ unlines ["hello", "world"]-hello-world--}-unlinesF :: (Foldable f, Buildable a) => f a -> Builder-unlinesF = mconcat . map (nl . build) . toList-  where-    nl x | "\n" `TL.isSuffixOf` toLazyText x = x-         | otherwise = x <> "\n"--{-# SPECIALIZE unlinesF :: Buildable a => [a] -> Builder #-}--------------------------------------------------------------------------------- List formatters-------------------------------------------------------------------------------{- | A simple comma-separated list formatter.-->>> listF ["hello", "world"]-"[hello, world]"--For multiline output, use 'jsonListF'.--}-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--Multi-line elements are indented correctly:--@->>> __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 (instead of 'build') and choose the bullet character-(instead of @"-"@).--}-blockListF'-  :: forall f a. Foldable f-  => T.Text                     -- ^ Bullet-  -> (a -> Builder)             -- ^ Builder for elements-  -> f a                        -- ^ Structure with elements-  -> Builder-blockListF' bullet fbuild xs = if null items then "[]\n" else mconcat items-  where-    items = map buildItem (toList xs)-    spaces = mconcat $ replicate (T.length bullet + 1) (singleton ' ')-    buildItem x = case TL.lines (toLazyText (fbuild x)) of-      []     -> bullet |+ "\n"-      (l:ls) -> bullet |+ " " +| l |+ "\n" <>-                mconcat [spaces <> fromLazyText s <> "\n" | s <- ls]--{-# SPECIALIZE blockListF' :: T.Text -> (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-]--}-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.-->>> mapF [("a", 1), ("b", 4)]-"{a: 1, b: 4}"--For multiline output, use 'jsonMapF'.--}-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-------------------------------------------------------------------------------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--{- |-@padBothF 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):-->>> padBothF 5 '=' "foo"-"=foo="->>> padBothF 5 '=' "foobar"-"foobar"--When padding can't be distributed equally, the left side is preferred:-->>> padBoth 8 '=' "foo"-"===foo=="--}-padBothF :: Buildable a => Int -> Char -> a -> Builder-padBothF i c =-  fromLazyText . TL.center (fromIntegral i) c . toLazyText . build--{- |-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--------------------------------------------------------------------------------- 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 #-}--------------------------------------------------------------------------------- Generic formatting-------------------------------------------------------------------------------{- | Format an arbitrary value without requiring a 'Buildable' instance:--@-data Foo = Foo { x :: Bool, y :: [Int] }-  deriving Generic-@-->>> fmt (genericF (Foo True [1,2,3]))-Foo:-  x: True-  y: [1, 2, 3]--It works for non-record constructors too:--@-data Bar = Bar Bool [Int]-  deriving Generic-@-->>> fmtLn (genericF (Bar True [1,2,3]))-<Bar: True, [1, 2, 3]>--Any fields inside the type must either be 'Buildable' or one of the following-types:--* a function-* a tuple (up to 8-tuples)-* list, 'NonEmpty', 'Seq'-* 'Map', 'IntMap', 'Set', 'IntSet'-* 'Maybe', 'Either'--The exact format of 'genericF' might change in future versions, so don't rely-on it. It's merely a convenience function.--}-genericF :: (Generic a, GBuildable (Rep a)) => a -> Builder-genericF = gbuild . from--instance GBuildable a => GBuildable (M1 D d a) where-  gbuild (M1 x) = gbuild x--instance (GetFields a, Constructor c) => GBuildable (M1 C c a) where-  -- A note on fixity:-  --   * Ordinarily e.g. "Foo" is prefix and e.g. ":|" is infix-  --   * However, "Foo" can be infix when defined as "a `Foo` b"-  --   * And ":|" can be prefix when defined as "(:|) a b"-  gbuild c@(M1 x) = case conFixity c of-    Infix _ _-      | [a, b] <- fields -> format "({} {} {})" a infixName b-      -- this case should never happen, but still-      | otherwise        -> format "<{}: {}>"-                              prefixName-                              (mconcat (intersperse ", " fields))-    Prefix-      | isTuple -> tupleLikeF fields-      | conIsRecord c -> nameF (build prefixName) (blockMapF fieldsWithNames)-      | null (getFields x) -> build prefixName-      -- I believe that there will be only one field in this case-      | null (conName c) -> mconcat (intersperse ", " fields)-      | otherwise -> format "<{}: {}>"-                       prefixName-                       (mconcat (intersperse ", " fields))-    where-      (prefixName, infixName)-        | ":" `isPrefixOf` conName c = ("(" ++ conName c ++ ")", conName c)-        | otherwise                  = (conName c, "`" ++ conName c ++ "`")-      fields          = map snd (getFields x)-      fieldsWithNames = getFields x-      isTuple         = "(," `isPrefixOf` prefixName--instance Buildable' c => GBuildable (K1 i c) where-  gbuild (K1 a) = build' a--instance (GBuildable a, GBuildable b) => GBuildable (a :+: b) where-  gbuild (L1 x) = gbuild x-  gbuild (R1 x) = gbuild x--instance (GetFields a, GetFields b) => GetFields (a :*: b) where-  getFields (a :*: b) = getFields a ++ getFields b--instance (GBuildable a, Selector c) => GetFields (M1 S c a) where-  getFields s@(M1 a) = [(selName s, gbuild a)]--instance GBuildable a => GetFields (M1 D c a) where-  getFields (M1 a) = [("", gbuild a)]--instance GBuildable a => GetFields (M1 C c a) where-  getFields (M1 a) = [("", gbuild a)]--instance GetFields U1 where-  getFields _ = []--------------------------------------------------------------------------------- A more powerful Buildable used for genericF-------------------------------------------------------------------------------instance Buildable' () where-  build' _ = "()"--instance (Buildable' a1, Buildable' a2)-  => Buildable' (a1, a2) where-  build' (a1, a2) = tupleLikeF-    [build' a1, build' a2]--instance (Buildable' a1, Buildable' a2, Buildable' a3)-  => Buildable' (a1, a2, a3) where-  build' (a1, a2, a3) = tupleLikeF-    [build' a1, build' a2, build' a3]--instance (Buildable' a1, Buildable' a2, Buildable' a3, Buildable' a4)-  => Buildable' (a1, a2, a3, a4) where-  build' (a1, a2, a3, a4) = tupleLikeF-    [build' a1, build' a2, build' a3, build' a4]--instance (Buildable' a1, Buildable' a2, Buildable' a3, Buildable' a4,-          Buildable' a5)-  => Buildable' (a1, a2, a3, a4, a5) where-  build' (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)-  => Buildable' (a1, a2, a3, a4, a5, a6) where-  build' (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)-  => Buildable' (a1, a2, a3, a4, a5, a6, a7) where-  build' (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)-  => Buildable' (a1, a2, a3, a4, a5, a6, a7, a8) where-  build' (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]--instance _OVERLAPPING_ Buildable' [Char] where-  build' = build--instance Buildable' a => Buildable' [a] where-  build' = listF' build'--#if MIN_VERSION_base(4,9,0)-instance Buildable' a => Buildable' (NonEmpty a) where-  build' = listF' build'-#endif--instance Buildable' a => Buildable' (Seq a) where-  build' = listF' build'--instance (Buildable' k, Buildable' v) => Buildable' (Map k v) where-  build' = mapF' build' build' . Map.toList--instance (Buildable' v) => Buildable' (Set v) where-  build' = listF' build'--instance (Buildable' v) => Buildable' (IntMap v) where-  build' = mapF' build' build' . IntMap.toList--instance Buildable' IntSet where-  build' = listF' build' . IntSet.toList--instance (Buildable' a) => Buildable' (Maybe a) where-  build' Nothing  = maybeF (Nothing         :: Maybe Builder)-  build' (Just a) = maybeF (Just (build' a) :: Maybe Builder)--instance (Buildable' a, Buildable' b) => Buildable' (Either a b) where-  build' (Left  a) = eitherF (Left  (build' a) :: Either Builder Builder)-  build' (Right a) = eitherF (Right (build' a) :: Either Builder Builder)--instance Buildable' (a -> b) where-  build' _ = "<function>"--instance _OVERLAPPABLE_ Buildable a => Buildable' a where-  build' = build+module Fmt+(+  -- * Overloaded strings+  -- $overloadedstrings++  -- * Examples+  -- $examples++  -- * Migration guide from @formatting@+  -- $migration++  -- * Basic formatting+  -- $brackets++  -- ** Ordinary brackets+  -- $god1+  (+|),+  (|+),+  -- ** 'Show' brackets+  -- $god2+  (+||),+  (||+),+  -- ** Combinations+  -- $god3+  (|++|),+  (||++||),+  (|++||),+  (||++|),++  -- * Old-style formatting+  format,+  formatLn,+  Format,++  -- * Helper functions+  fmt,+  fmtLn,++  Builder,+  Buildable(..),++  -- * Formatters++  -- ** Time+  module Fmt.Time,++  -- ** Text+  indentF, indentF',+  nameF,+  unwordsF,+  unlinesF,++  -- ** Lists+  listF, listF',+  blockListF, blockListF',+  jsonListF, jsonListF',++  -- ** Maps+  mapF, mapF',+  blockMapF, blockMapF',+  jsonMapF, jsonMapF',++  -- ** Tuples+  tupleF,++  -- ** ADTs+  maybeF,+  eitherF,++  -- ** Padding/trimming+  prefixF,+  suffixF,+  padLeftF,+  padRightF,+  padBothF,++  -- ** Hex+  hexF,++  -- ** Bytestrings+  base64F,+  base64UrlF,++  -- ** Integers+  ordinalF,+  commaizeF,+  -- *** Base conversion+  octF,+  binF,+  baseF,++  -- ** Floating-point+  floatF,+  exptF,+  fixedF,++  -- ** Conditional formatting+  whenF,+  unlessF,++  -- ** Generic formatting+  genericF,+)+where+++import Formatting.Buildable (Buildable(..))+import Data.Text.Lazy.Builder++import Fmt.Internal+import Fmt.Time+++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> :set -XDeriveGeneric+-- >>> import Data.Text (Text)++{- $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+]++-}++{- $migration++Instead of using @%@, surround variables with '+|' and '|+'. You don't have+to use @sformat@ or anything else, and also where you were using @build@,+@int@, @text@, etc in @formatting@, you don't have to use anything in @fmt@:++@+formatting    __sformat ("Foo: "%build%", bar: "%int) foo bar__+       fmt    __"Foo: "+|foo|+", bar: "+|bar|+""__+@++The resulting formatted string is polymorphic and can be used as 'String',+'Text', 'Builder' or even 'IO' (i.e. the string will be printed to the+screen). However, when printing it is recommended to use 'fmt' or 'fmtLn'+for clarity.++@fmt@ provides lots of formatters (which are simply functions that produce+'Builder'):++@+formatting    __sformat ("Got another byte ("%hex%")") x__+       fmt    __"Got another byte ("+|hexF x|+")"__+@++Instead of the @shown@ formatter, either just use 'show' or double brackets:++@+formatting    __sformat ("This uses Show: "%shown%") foo__+    fmt #1    __"This uses Show: "+|show foo|+""__+    fmt #2    __"This uses Show: "+||foo||+""__+@++Many formatters from @formatting@ have the same names in @fmt@, but with+added “F”: 'hexF', 'exptF', etc. Some have been renamed, though:++@+__Cutting:__+  fitLeft  -\> 'prefixF'+  fitRight -\> 'suffixF'++__Padding:__+  left   -\> 'padLeftF'+  right  -\> 'padRightF'+  center -\> 'padBothF'++__Stuff with numbers:__+  ords   -\> 'ordinalF'+  commas -\> 'commaizeF'+@++Also, some formatters from @formatting@ haven't been added to @fmt@+yet. Specifically:++* @plural@ and @asInt@ (but instead of @asInt@ you can use 'fromEnum')+* @prefixBin@, @prefixOrd@, @prefixHex@, and @bytes@+* formatters that use @Scientific@ (@sci@ and @scifmt@)++They will be added later. (On the other hand, @fmt@ provides some useful+formatters not available in @formatting@, such as 'listF', 'mapF', 'tupleF'+and so on.)+-}++----------------------------------------------------------------------------+-- Documentation for operators+----------------------------------------------------------------------------++{- $brackets++To format strings, put variables between ('+|') and ('|+'):++>>> let name = "Alice" :: String+>>> "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':++prop> (""+|show foo|++|show bar|+"") == (""+||foo||++||bar||+"")+-}++-- $god1+-- Operators for the operators god!++-- $god2+-- More operators for the operators god!++{- $god3++Z̸͠A̵̕͟͠L̡̀́͠G̶̛O͝ ̴͏̀ I͞S̸̸̢͠  ̢̛͘͢C̷͟͡Ó̧̨̧͞M̡͘͟͞I̷͜N̷̕G̷̀̕++(Though you can just use @""@ between @+| |+@ instead of using these+operators, and 'Show'-brackets don't have to be used at all because there's+'show' available.)+-}  ---------------------------------------------------------------------------- -- TODOs

@@ -1,109 +1,54 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE CPP #-} --- for FormatAsHex and FormatType-#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-#  define _OVERLAPPING_-#  define _OVERLAPPABLE_-#  define _OVERLAPS_-#else-#  define _OVERLAPPING_ {-# OVERLAPPING #-}-#  define _OVERLAPPABLE_ {-# OVERLAPPABLE #-}-#  define _OVERLAPS_ {-# OVERLAPS #-}-#endif  {- | A module providing access to internals (in case you really need them). Can change at any time, though probably won't.--It also provides some functions that are used in 'Fmt.Time' (so that-'Fmt.Time' wouldn't need to import 'Fmt'). -} module Fmt.Internal (   -- * Classes-  FromBuilder(..),   FormatAsHex(..),   FormatAsBase64(..),-  TupleF(..), -  -- * Classes used for 'genericF'-  GBuildable(..),-  GetFields(..),-  Buildable'(..),--  -- * Polyvariadic 'format'-  FormatType(..),-  -  -- * Helpers-  groupInt,-  atBase,-  showSigned',-  intToDigit',-  indentF',--  -- * Functions used in 'Fmt.Time'-  fixedF,-  ordinalF,+  -- * Reexports+  module Fmt.Internal.Core,+  module Fmt.Internal.Formatters,+  module Fmt.Internal.Template,+  module Fmt.Internal.Tuple,+  module Fmt.Internal.Numeric,+  module Fmt.Internal.Generic, ) 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+-- 'Buildable' and raw 'Builder' formatters+import qualified Formatting.Internal.Raw as F -- Text 'Builder'-import Data.Text.Lazy.Builder hiding (fromString)+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.Builder         as BB 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-  -- | Convert a 'Builder' to something else.-  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 #-}+import Fmt.Internal.Core+import Fmt.Internal.Formatters+import Fmt.Internal.Template+import Fmt.Internal.Tuple+import Fmt.Internal.Numeric+import Fmt.Internal.Generic -instance (a ~ ()) => FromBuilder (IO a) where-  fromBuilder = TL.putStr . toLazyText-  {-# INLINE fromBuilder #-}+-- $setup+-- >>> import Fmt  ---------------------------------------------------------------------------- -- Hex@@ -121,13 +66,13 @@   hexF :: a -> Builder  instance FormatAsHex BS.ByteString where-  hexF = fromText . T.decodeLatin1 . B16.encode+  hexF = fromLazyText . TL.decodeLatin1 . BB.toLazyByteString . BB.byteStringHex  instance FormatAsHex BSL.ByteString where-  hexF = fromLazyText . TL.decodeLatin1 . B16L.encode+  hexF = fromLazyText . TL.decodeLatin1 . BB.toLazyByteString . BB.lazyByteStringHex -instance _OVERLAPPABLE_ Integral a => FormatAsHex a where-  hexF = TF.hex+instance {-# OVERLAPPABLE #-} Integral a => FormatAsHex a where+  hexF = F.hex  ---------------------------------------------------------------------------- -- Base64@@ -157,142 +102,3 @@ instance FormatAsBase64 BSL.ByteString where   base64F    = fromLazyText . TL.decodeLatin1 . B64L.encode   base64UrlF = fromLazyText . TL.decodeLatin1 . B64UL.encode--------------------------------------------------------------------------------- Tuples-------------------------------------------------------------------------------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--------------------------------------------------------------------------------- Classes used for 'genericF'-------------------------------------------------------------------------------class GBuildable f where-  gbuild :: f a -> Builder--class GetFields f where-  -- | Get fields, together with their names if available-  getFields :: f a -> [(String, Builder)]---- | A more powerful 'Buildable' used for 'genericF'. Can build functions,--- tuples, lists, maps, etc., as well as combinations thereof.-class Buildable' a where-  build' :: a -> Builder--------------------------------------------------------------------------------- Classes used for polyvariadic 'format'--------------------------------------------------------------------------------- | Something like 'Text.Printf.PrintfType' in "Text.Printf".-class FormatType r where-  format' :: TF.Format -> [Builder] -> r--instance (Buildable a, FormatType r) => FormatType (a -> r) where-  format' f xs = \x -> format' f (build x : xs)--instance _OVERLAPPABLE_ FromBuilder r => FormatType r where-  format' f xs = fromBuilder $ TF.build f (reverse xs)--------------------------------------------------------------------------------- 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)--{- | Add a prefix to the first line, and indent all lines but the first one.--The output will always end with a newline, even when the input doesn't.--}-indentF' :: Int -> T.Text -> Builder -> Builder-indentF' n pref a = case TL.lines (toLazyText a) of-  []     -> fromText pref <> "\n"-  (x:xs) -> fromLazyText $-            TL.unlines $ (TL.fromStrict pref <> x) : map (spaces <>) xs-  where-    spaces = TL.replicate (fromIntegral n) (TL.singleton ' ')--------------------------------------------------------------------------------- Functions used in Fmt.Time-------------------------------------------------------------------------------{- |-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--{- |-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

@@ -0,0 +1,119 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+++module Fmt.Internal.Core where++#if __GLASGOW_HASKELL__ < 804+import           Data.Monoid ((<>))+#endif+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL+import           Data.Text.Lazy.Builder hiding (fromString)+import           Formatting.Buildable (Buildable(..))+++----------------------------------------------------------------------------+-- Class+----------------------------------------------------------------------------++class FromBuilder a where+  -- | Convert a 'Builder' to something else.+  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 #-}++----------------------------------------------------------------------------+-- Operators+----------------------------------------------------------------------------++-- | Concatenate, then convert.+(+|) :: (FromBuilder b) => Builder -> Builder -> b+(+|) str rest = fromBuilder (str <> rest)++-- | 'build' and concatenate, then convert.+(|+) :: (Buildable a, FromBuilder b) => a -> Builder -> b+(|+) a rest = fromBuilder (build a <> rest)++infixr 1 +|+infixr 1 |+++-- | Concatenate, then convert.+(+||) :: (FromBuilder b) => Builder -> Builder -> b+(+||) str rest = str +| rest+{-# INLINE (+||) #-}++-- | 'show' and concatenate, then convert.+(||+) :: (Show a, FromBuilder b) => a -> Builder -> b+(||+) a rest = show a |+ rest+{-# INLINE (||+) #-}++infixr 1 +||+infixr 1 ||+++(|++|) :: (Buildable a, FromBuilder b) => a -> Builder -> b+(|++|) a rest = fromBuilder (build a <> rest)+{-# INLINE (|++|) #-}++(||++||) :: (Show a, FromBuilder b) => a -> Builder -> b+(||++||) a rest = show a |+ rest+{-# INLINE (||++||) #-}++(||++|) :: (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 ||++||+infixr 1 ||++|+infixr 1 |++||++----------------------------------------------------------------------------+-- 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 #-}

@@ -0,0 +1,471 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+++module Fmt.Internal.Formatters where+++-- Generic useful things+import Data.List+import Lens.Micro+#if __GLASGOW_HASKELL__ < 804+import Data.Monoid ((<>))+#endif+-- Text+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Text (Text)+-- 'Buildable' and text-format stuff+import Formatting.Buildable+import qualified Formatting.Internal.Raw as F+-- Text 'Builder'+import Data.Text.Lazy.Builder hiding (fromString)+-- 'Foldable' and 'IsList' for list/map formatters+import Data.Foldable (toList)+import GHC.Exts (IsList, Item)+import qualified GHC.Exts as IsList (toList)++import Fmt.Internal.Core+++----------------------------------------------------------------------------+-- Text formatters+----------------------------------------------------------------------------++{- |+Indent a block of text.++>>> fmt $ "This is a list:\n" <> indentF 4 (blockListF [1,2,3])+This is a list:+    - 1+    - 2+    - 3++The output will always end with a newline, even when the input doesn't.+-}+indentF :: Int -> Builder -> Builder+indentF n a = case TL.lines (toLazyText a) of+    [] -> fromLazyText (spaces <> "\n")+    xs -> fromLazyText $ TL.unlines (map (spaces <>) xs)+  where+    spaces = TL.replicate (fromIntegral n) (TL.singleton ' ')++{- | Add a prefix to the first line, and indent all lines but the first one.++The output will always end with a newline, even when the input doesn't.+-}+indentF' :: Int -> T.Text -> Builder -> Builder+indentF' n pref a = case TL.lines (toLazyText a) of+  []     -> fromText pref <> "\n"+  (x:xs) -> fromLazyText $+            TL.unlines $ (TL.fromStrict pref <> x) : map (spaces <>) xs+  where+    spaces = TL.replicate (fromIntegral n) (TL.singleton ' ')++{- | 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]++{- | Put words between elements.++>>> fmt $ unwordsF ["hello", "world"]+hello world++Of course, it works on anything 'Buildable':++>>> fmt $ unwordsF [1, 2]+1 2+-}+unwordsF :: (Foldable f, Buildable a) => f a -> Builder+unwordsF = mconcat . intersperse " " . map build . toList++{-# SPECIALIZE unwordsF :: Buildable a => [a] -> Builder #-}++{- | Arrange elements on separate lines.++>>> fmt $ unlinesF ["hello", "world"]+hello+world+-}+unlinesF :: (Foldable f, Buildable a) => f a -> Builder+unlinesF = mconcat . map (nl . build) . toList+  where+    nl x | "\n" `TL.isSuffixOf` toLazyText x = x+         | otherwise = x <> "\n"++{-# SPECIALIZE unlinesF :: Buildable a => [a] -> Builder #-}++----------------------------------------------------------------------------+-- List formatters+----------------------------------------------------------------------------++{- | A simple comma-separated list formatter.++>>> listF ["hello", "world"]+"[hello, world]"++For multiline output, use 'jsonListF'.+-}+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++Multi-line elements are indented correctly:++>>> 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 (instead of 'build') and choose the bullet character+(instead of @"-"@).+-}+blockListF'+  :: forall f a. Foldable f+  => Text                       -- ^ Bullet+  -> (a -> Builder)             -- ^ Builder for elements+  -> f a                        -- ^ Structure with elements+  -> Builder+blockListF' bullet fbuild xs = if null items then "[]\n" else mconcat items+  where+    items = map buildItem (toList xs)+    spaces = mconcat $ replicate (T.length bullet + 1) (singleton ' ')+    buildItem x = case TL.lines (toLazyText (fbuild x)) of+      []     -> bullet |+ "\n"+      (l:ls) -> bullet |+ " " +| l |+ "\n" <>+                mconcat [spaces <> fromLazyText s <> "\n" | s <- ls]++{-# SPECIALIZE blockListF' :: Text -> (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+]+-}+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+----------------------------------------------------------------------------++{- | A simple JSON-like map formatter; works for Map, HashMap, etc, as well as+ordinary lists of pairs.++>>> mapF [("a", 1), ("b", 4)]+"{a: 1, b: 4}"++For multiline output, use 'jsonMapF'.+-}+mapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder+mapF = mapF' build build+{-# INLINE mapF #-}++{- | A version of 'mapF' that lets you supply your own building function for+keys and values.+-}+mapF'+  :: (IsList t, Item t ~ (k, v))+  => (k -> Builder) -> (v -> Builder) -> t -> Builder+mapF' fbuild_k fbuild_v xs =+  "{" <> mconcat (intersperse ", " (map buildPair (IsList.toList 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 :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder+blockMapF = blockMapF' build build+{-# INLINE blockMapF #-}++{- | A version of 'blockMapF' that lets you supply your own building function+for keys and values.+-}+blockMapF'+  :: (IsList t, Item t ~ (k, v))+  => (k -> Builder) -> (v -> Builder) -> t -> Builder+blockMapF' fbuild_k fbuild_v xs+  | null items = "{}\n"+  | otherwise  = mconcat items+  where+    items = map (\(k, v) -> nameF (fbuild_k k) (fbuild_v v)) (IsList.toList 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 :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder+jsonMapF = jsonMapF' build build+{-# INLINE jsonMapF #-}++{- | A version of 'jsonMapF' that lets you supply your own building function+for keys and values.+-}+jsonMapF'+  :: forall t k v.+     (IsList t, Item t ~ (k, v))+  => (k -> Builder) -> (v -> Builder) -> t -> Builder+jsonMapF' fbuild_k fbuild_v xs+  | null items = "{}\n"+  | otherwise  = "{\n" <> mconcat items <> "}\n"+  where+    items = zipWith buildItem (True : repeat False) (IsList.toList 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]++----------------------------------------------------------------------------+-- 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 :: Either Bool Int)+"<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 = F.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 = F.right++{- |+@padBothF 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):++>>> padBothF 5 '=' "foo"+"=foo="+>>> padBothF 5 '=' "foobar"+"foobar"++When padding can't be distributed equally, the left side is preferred:++>>> padBothF 8 '=' "foo"+"===foo=="+-}+padBothF :: Buildable a => Int -> Char -> a -> Builder+padBothF i c =+  fromLazyText . TL.center (fromIntegral i) c . toLazyText . build++----------------------------------------------------------------------------+-- Conditional formatters+----------------------------------------------------------------------------++{- | Display something only if the condition is 'True' (empty string+otherwise).++Note that it can only take a 'Builder' (because otherwise it would be+unusable with ('+|')-formatted strings which can resolve to any+'FromBuilder'). You can use 'build' to convert any value to a 'Builder'.+-}+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 #-}

@@ -0,0 +1,230 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+++module Fmt.Internal.Generic where+++import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet+import Data.Sequence (Seq)+#if MIN_VERSION_base(4,9,0)+import Data.List.NonEmpty (NonEmpty)+#endif++import Data.List+import Data.Text.Lazy.Builder hiding (fromString)+import GHC.Generics+import Formatting.Buildable++import Fmt.Internal.Formatters+import Fmt.Internal.Template+import Fmt.Internal.Tuple+++-- $setup+-- >>> import Fmt++{- | Format an arbitrary value without requiring a 'Buildable' instance:++>>> data Foo = Foo { x :: Bool, y :: [Int] } deriving Generic++>>> fmt (genericF (Foo True [1,2,3]))+Foo:+  x: True+  y: [1, 2, 3]++It works for non-record constructors too:++>>> data Bar = Bar Bool [Int] deriving Generic++>>> fmtLn (genericF (Bar True [1,2,3]))+<Bar: True, [1, 2, 3]>++Any fields inside the type must either be 'Buildable' or one of the following+types:++* a function+* a tuple (up to 8-tuples)+* list, 'NonEmpty', 'Seq'+* 'Map', 'IntMap', 'Set', 'IntSet'+* 'Maybe', 'Either'++The exact format of 'genericF' might change in future versions, so don't rely+on it. It's merely a convenience function.+-}+genericF :: (Generic a, GBuildable (Rep a)) => a -> Builder+genericF = gbuild . from++----------------------------------------------------------------------------+-- GBuildable+----------------------------------------------------------------------------++class GBuildable f where+  gbuild :: f a -> Builder++instance Buildable' c => GBuildable (K1 i c) where+  gbuild (K1 a) = build' a++instance (GBuildable a, GBuildable b) => GBuildable (a :+: b) where+  gbuild (L1 x) = gbuild x+  gbuild (R1 x) = gbuild x++instance GBuildable a => GBuildable (M1 D d a) where+  gbuild (M1 x) = gbuild x++instance (GetFields a, Constructor c) => GBuildable (M1 C c a) where+  -- A note on fixity:+  --   * Ordinarily e.g. "Foo" is prefix and e.g. ":|" is infix+  --   * However, "Foo" can be infix when defined as "a `Foo` b"+  --   * And ":|" can be prefix when defined as "(:|) a b"+  gbuild c@(M1 x) = case conFixity c of+    Infix _ _+      | [a, b] <- fields -> format "({} {} {})" a infixName b+      -- this case should never happen, but still+      | otherwise        -> format "<{}: {}>"+                              prefixName+                              (mconcat (intersperse ", " fields))+    Prefix+      | isTuple -> tupleF fields+      | conIsRecord c -> nameF (build prefixName) (blockMapF fieldsWithNames)+      | null (getFields x) -> build prefixName+      -- I believe that there will be only one field in this case+      | null (conName c) -> mconcat (intersperse ", " fields)+      | otherwise -> format "<{}: {}>"+                       prefixName+                       (mconcat (intersperse ", " fields))+    where+      (prefixName, infixName)+        | ":" `isPrefixOf` conName c = ("(" ++ conName c ++ ")", conName c)+        | otherwise                  = (conName c, "`" ++ conName c ++ "`")+      fields          = map snd (getFields x)+      fieldsWithNames = getFields x+      isTuple         = "(," `isPrefixOf` prefixName++----------------------------------------------------------------------------+-- Buildable'+----------------------------------------------------------------------------++-- | A more powerful 'Buildable' used for 'genericF'. Can build functions,+-- tuples, lists, maps, etc., as well as combinations thereof.+class Buildable' a where+  build' :: a -> Builder++instance Buildable' () where+  build' _ = "()"++instance (Buildable' a1, Buildable' a2)+  => Buildable' (a1, a2) where+  build' (a1, a2) = tupleF+    [build' a1, build' a2]++instance (Buildable' a1, Buildable' a2, Buildable' a3)+  => Buildable' (a1, a2, a3) where+  build' (a1, a2, a3) = tupleF+    [build' a1, build' a2, build' a3]++instance (Buildable' a1, Buildable' a2, Buildable' a3, Buildable' a4)+  => Buildable' (a1, a2, a3, a4) where+  build' (a1, a2, a3, a4) = tupleF+    [build' a1, build' a2, build' a3, build' a4]++instance (Buildable' a1, Buildable' a2, Buildable' a3, Buildable' a4,+          Buildable' a5)+  => Buildable' (a1, a2, a3, a4, a5) where+  build' (a1, a2, a3, a4, a5) = tupleF+    [build' a1, build' a2, build' a3, build' a4,+     build' a5]++instance (Buildable' a1, Buildable' a2, Buildable' a3, Buildable' a4,+          Buildable' a5, Buildable' a6)+  => Buildable' (a1, a2, a3, a4, a5, a6) where+  build' (a1, a2, a3, a4, a5, a6) = tupleF+    [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)+  => Buildable' (a1, a2, a3, a4, a5, a6, a7) where+  build' (a1, a2, a3, a4, a5, a6, a7) = tupleF+    [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)+  => Buildable' (a1, a2, a3, a4, a5, a6, a7, a8) where+  build' (a1, a2, a3, a4, a5, a6, a7, a8) = tupleF+    [build' a1, build' a2, build' a3, build' a4,+     build' a5, build' a6, build' a7, build' a8]++instance {-# OVERLAPPING #-} Buildable' [Char] where+  build' = build++instance Buildable' a => Buildable' [a] where+  build' = listF' build'++#if MIN_VERSION_base(4,9,0)+instance Buildable' a => Buildable' (NonEmpty a) where+  build' = listF' build'+#endif++instance Buildable' a => Buildable' (Seq a) where+  build' = listF' build'++instance (Buildable' k, Buildable' v) => Buildable' (Map k v) where+  build' = mapF' build' build' . Map.toList++instance (Buildable' v) => Buildable' (Set v) where+  build' = listF' build'++instance (Buildable' v) => Buildable' (IntMap v) where+  build' = mapF' build' build' . IntMap.toList++instance Buildable' IntSet where+  build' = listF' build' . IntSet.toList++instance (Buildable' a) => Buildable' (Maybe a) where+  build' Nothing  = maybeF (Nothing         :: Maybe Builder)+  build' (Just a) = maybeF (Just (build' a) :: Maybe Builder)++instance (Buildable' a, Buildable' b) => Buildable' (Either a b) where+  build' (Left  a) = eitherF (Left  (build' a) :: Either Builder Builder)+  build' (Right a) = eitherF (Right (build' a) :: Either Builder Builder)++instance Buildable' (a -> b) where+  build' _ = "<function>"++instance {-# OVERLAPPABLE #-} Buildable a => Buildable' a where+  build' = build++----------------------------------------------------------------------------+-- GetFields+----------------------------------------------------------------------------++class GetFields f where+  -- | Get fields, together with their names if available+  getFields :: f a -> [(String, Builder)]++instance (GetFields a, GetFields b) => GetFields (a :*: b) where+  getFields (a :*: b) = getFields a ++ getFields b++instance (GBuildable a, Selector c) => GetFields (M1 S c a) where+  getFields s@(M1 a) = [(selName s, gbuild a)]++instance GBuildable a => GetFields (M1 D c a) where+  getFields (M1 a) = [("", gbuild a)]++instance GBuildable a => GetFields (M1 C c a) where+  getFields (M1 a) = [("", gbuild a)]++instance GetFields U1 where+  getFields _ = []

@@ -0,0 +1,168 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+++module Fmt.Internal.Numeric where+++#if __GLASGOW_HASKELL__ < 804+import           Data.Monoid ((<>))+#endif+import           Numeric+import           Data.Char+import           Data.Text.Lazy.Builder hiding (fromString)+import           Formatting.Buildable (Buildable(..))+import qualified Formatting.Internal.Raw as F+import qualified Data.Text.Lazy as TL+++-- $setup+-- >>> import Fmt++----------------------------------------------------------------------------+-- Integer+----------------------------------------------------------------------------++{- |+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++----------------------------------------------------------------------------+-- Floating-point+----------------------------------------------------------------------------++{- |+Format a floating-point number:++>>> floatF 3.1415+"3.1415"++Numbers smaller than 1e-6 or bigger-or-equal to 1e21 will be displayed using+scientific notation:++>>> listF' floatF [1e-6,9e-7]+"[0.000001, 9.0e-7]"+>>> listF' floatF [9e20,1e21]+"[900000000000000000000.0, 1.0e21]"+-}+floatF :: Real a => a -> Builder+floatF a | d < 1e-6 || d >= 1e21 = build $ showEFloat Nothing d ""+         | otherwise             = build $ showFFloat Nothing d ""+  where d = realToFrac a :: Double++{- | Format a floating-point number using scientific notation, with the given+amount of decimal places.++>>> listF' (exptF 5) [pi,0.1,10]+"[3.14159e0, 1.00000e-1, 1.00000e1]"+-}+exptF :: Real a => Int -> a -> Builder+exptF decs a = build $ showEFloat (Just decs) (realToFrac a :: Double) ""++{- |+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 = F.fixed++----------------------------------------------------------------------------+-- Other+----------------------------------------------------------------------------++{- |+Break digits in a number:++>>> commaizeF 15830000+"15,830,000"+-}+commaizeF :: (Buildable a, Integral a) => a -> Builder+commaizeF = groupInt 3 ','++{- |+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++----------------------------------------------------------------------------+-- 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)

@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+++-- | Old-style formatting a la @text-format@.+module Fmt.Internal.Template where+++import Data.String (IsString(..))+import Data.Text (Text, splitOn)+import Data.Text.Lazy.Builder hiding (fromString)+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup+#endif+import Formatting.Buildable (Buildable(..))+import Fmt.Internal.Core (FromBuilder(..))+++-- $setup+-- >>> import Fmt++{- | An old-style formatting function taken from @text-format@ (see+"Data.Text.Format"). Unlike 'Data.Text.Format.format' from+"Data.Text.Format", it can produce 'String' and strict 'Text' as well (and+print to console too). Also it's polyvariadic:++>>> format "{} + {} = {}" 2 2 4+2 + 2 = 4++You can use arbitrary formatters:++>>> format "0x{} + 0x{} = 0x{}" (hexF 130) (hexF 270) (hexF (130+270))+0x82 + 0x10e = 0x190+-}+format :: FormatType r => Format -> r+format f = format' f []+{-# INLINE format #-}++{- | Like 'format', but adds a newline.+-}+formatLn :: FormatType r => Format -> r+formatLn f = format' (f <> "\n") []+{-# INLINE formatLn #-}++-- | A format string. This is intentionally incompatible with other+-- string types, to make it difficult to construct a format string by+-- concatenating string fragments (a very common way to accidentally+-- make code vulnerable to malicious data).+--+-- This type is an instance of 'IsString', so the easiest way to+-- construct a query is to enable the @OverloadedStrings@ language+-- extension and then simply write the query in double quotes.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Fmt+-- >+-- > f :: Format+-- > f = "hello {}"+--+-- The underlying type is 'Text', so literal Haskell strings that+-- contain Unicode characters will be correctly handled.+newtype Format = Format { fromFormat :: Text }+  deriving (Eq, Ord, Show)++instance Semigroup Format where+  Format a <> Format b = Format (a <> b)++instance Monoid Format where+  mempty = Format mempty+#if !(MIN_VERSION_base(4,11,0))+  mappend = (<>)+#endif++instance IsString Format where+  fromString = Format . fromString++-- Format strings are almost always constants, and they're expensive+-- to interpret (which we refer to as "cracking" here).  We'd really+-- like to have GHC memoize the cracking of a known-constant format+-- string, so that it occurs at most once.+--+-- To achieve this, we arrange to have the cracked version of a format+-- string let-floated out as a CAF, by inlining the definitions of+-- build and functions that invoke it.  This works well with GHC 7.++-- | Render a format string and arguments to a 'Builder'.+renderFormat :: Format -> [Builder] -> Builder+renderFormat fmt ps = zipParams (crack fmt) ps+{-# INLINE renderFormat #-}++zipParams :: [Builder] -> [Builder] -> Builder+zipParams fragments params = go fragments params+  where go (f:fs) (y:ys) = f <> y <> go fs ys+        go [f] []        = f+        go _ _  = error $ "Fmt.format: there were " <> show (length fragments - 1) <>+                          " sites, but " <> show (length params) <> " parameters"++crack :: Format -> [Builder]+crack = map fromText . splitOn "{}" . fromFormat++-- | Something like 'Text.Printf.PrintfType' in "Text.Printf".+class FormatType r where+  format' :: Format -> [Builder] -> r++instance (Buildable a, FormatType r) => FormatType (a -> r) where+  format' f xs = \x -> format' f (build x : xs)++instance {-# OVERLAPPABLE #-} FromBuilder r => FormatType r where+  format' f xs = fromBuilder $ renderFormat f (reverse xs)

@@ -0,0 +1,114 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+++module Fmt.Internal.Tuple where+++#if __GLASGOW_HASKELL__ < 804+import           Data.Monoid ((<>))+#endif+import           Data.List (intersperse)+import qualified Data.Text.Lazy as TL+import           Data.Text.Lazy.Builder+import           Formatting.Buildable (Buildable, build)+import           Lens.Micro+++-- $setup+-- >>> import Fmt.Internal.Core++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 )++You can also use 'tupleF' on lists to get tuple-like formatting.+  -}+  tupleF :: a -> Builder++instance (Buildable a1, Buildable a2)+  => TupleF (a1, a2) where+  tupleF (a1, a2) = tupleF+    [build a1, build a2]++instance (Buildable a1, Buildable a2, Buildable a3)+  => TupleF (a1, a2, a3) where+  tupleF (a1, a2, a3) = tupleF+    [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) = tupleF+    [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) = tupleF+    [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) = tupleF+    [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) = tupleF+    [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) = tupleF+    [build a1, build a2, build a3, build a4,+     build a5, build a6, build a7, build a8]++instance Buildable a => TupleF [a] where+  tupleF = tupleF . map build++instance {-# OVERLAPPING #-} TupleF [Builder] where+  tupleF 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))

@@ -17,30 +17,39 @@ @<https://hackage.haskell.org/package/formatting/docs/Formatting-Time.html Formatting.Time>@ from the @<https://hackage.haskell.org/package/formatting formatting>@ package. -Most of the time you'll want to use one of these formatters:+Most of the time you'll want to use one of these formatters (all of the+examples below use @"2018-02-14 16:20:45.5 CST"@): -@->>> __'dateTimeF' t                  -- full date and time__-"Sun May 14 16:16:47 MSK 2017"+* 'dateTimeF' – full date and time: ->>> __'hmF' t                        -- hours and minutes__-"16:16"+    >>> dateTimeF t+    "Wed Feb 14 16:20:45 CST 2018" ->>> __'hmsF' t                       -- hours, minutes and seconds__-"16:16:47"+* 'hmF' – hours and minutes: ->>> __'dateDashF' t                  -- date in ISO 8601 format__-"2017-05-14"+    >>> hmF t+    "16:20" ->>> __'diffF' False t                -- time period (convenient for humans)__-"3 seconds"+* 'hmsF' – hours, minutes and seconds: ->>> __'diffF' True t                 -- point in time (convenient for humans)__-"3 seconds ago"-@+    >>> hmsF t+    "16:20:45" -Note that two formatters from @Formatting.Time@ have been renamed:+* 'dateDashF' – date in ISO 8601 format: +    >>> dateDashF t+    "2018-02-14"++* 'diffF' – either a time period or a point in time, in a convenient for+  humans format:++    >>> diffF False 130    -- time period (130 seconds)+    "2 minutes"+    >>> diffF True 130     -- point in time (130 seconds in the future)+    "in 2 minutes"++Note that two formatters from @Formatting.Time@ are called differently here:+ @ pico     -> 'picosecondF' decimals -> 'subsecondF'@@ -116,7 +125,7 @@ import           Data.Monoid             ((<>)) import           Data.Text               (Text) import qualified Data.Text               as T-import           Data.Text.Buildable     (build)+import           Formatting.Buildable    (build) import           Data.Text.Lazy.Builder  (Builder) import           Data.Time @@ -124,8 +133,10 @@ import           Data.Time.Locale.Compat #endif -import           Fmt.Internal            (fixedF, ordinalF)+import           Fmt.Internal.Numeric    (fixedF, ordinalF) +-- $setup+-- >>> let t = read "2018-02-14 16:20:45.5 CST" :: ZonedTime  ---------------------------------------------------------------------------- -- Custom@@ -142,25 +153,24 @@  -- | Timezone offset on the format @-HHMM@. ----- >>> t <- getZonedTime -- >>> t--- 2017-05-14 16:16:47.62135 MSK+-- 2018-02-14 16:20:45.5 CST -- >>> tzF t--- "+0300"+-- "-0600" tzF :: FormatTime a => a -> Builder tzF = timeF "%z"  -- | Timezone name. -- -- >>> tzNameF t--- "MSK"+-- "CST" tzNameF :: FormatTime a => a -> Builder tzNameF = timeF "%Z"  -- | As 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@). -- -- >>> dateTimeF t--- "Sun May 14 16:16:47 MSK 2017"+-- "Wed Feb 14 16:20:45 CST 2018" dateTimeF :: FormatTime a => a -> Builder dateTimeF = timeF "%c" @@ -171,28 +181,28 @@ -- | Same as @%H:%M@. -- -- >>> hmF t--- "16:16"+-- "16:20" hmF :: FormatTime a => a -> Builder hmF = timeF "%R"  -- | Same as @%H:%M:%S@. -- -- >>> hmsF t--- "16:16:47"+-- "16:20:45" hmsF :: FormatTime a => a -> Builder hmsF = timeF "%T"  -- | As 'timeFmt' @locale@ (e.g. @%H:%M:%S@). -- -- >>> hmsLF t--- "16:16:47"+-- "16:20:45" hmsLF :: FormatTime a => a -> Builder hmsLF = timeF "%X"  -- | As 'time12Fmt' @locale@ (e.g. @%I:%M:%S %p@). -- -- >>> hmsPLF t--- "04:16:47 PM"+-- "04:20:45 PM" hmsPLF :: FormatTime a => a -> Builder hmsPLF = timeF "%r" @@ -214,10 +224,7 @@ -- -- >>> hour24F t -- "16"--- >>> let nightT = read "2017-05-14 00:21:32.714083 UTC" :: UTCTime--- >>> nightT--- 2017-05-14 00:21:32.714083 UTC--- >>> hour24F nightT+-- >>> hour24F midnight -- "00" hour24F :: FormatTime a => a -> Builder hour24F = timeF "%H"@@ -226,45 +233,47 @@ -- -- >>> hour12F t -- "04"--- >>> hour12F nightT+-- >>> hour12F midnight -- "12" hour12F :: FormatTime a => a -> Builder hour12F = timeF "%I"  -- | Hour, 24-hour, leading space as needed, @ 0@ - @23@. ----- >>> hour24SF nightT+-- >>> hour24SF t+-- "16"+-- >>> hour24SF midnight -- " 0" hour24SF :: FormatTime a => a -> Builder hour24SF = timeF "%k"  -- | Hour, 12-hour, leading space as needed, @ 1@ - @12@. ----- >>> hour12SF nightT+-- >>> hour12SF t+-- " 4"+-- >>> hour12SF midnight -- "12" hour12SF :: FormatTime a => a -> Builder hour12SF = timeF "%l"  -- | Minute, @00@ - @59@. ----- >>> otherT--- 2017-05-14 17:12:47.897343 MSK--- >>> minuteF otherT--- "12"+-- >>> minuteF t+-- "20" minuteF :: FormatTime a => a -> Builder minuteF = timeF "%M"  -- | Second, without decimal part, @00@ - @60@. -- -- >>> secondF t--- "47"+-- "45" secondF :: FormatTime a => a -> Builder secondF = timeF "%S"  -- | Picosecond, including trailing zeros, @000000000000@ - @999999999999@. -- -- >>> picosecondF t--- "621350000000"+-- "500000000000" picosecondF :: FormatTime a => a -> Builder picosecondF = timeF "%q" @@ -272,7 +281,7 @@ -- For a whole number of seconds, this produces an empty string. -- -- >>> subsecondF t--- ".62135"+-- ".5" subsecondF :: FormatTime a => a -> Builder subsecondF = timeF "%Q" @@ -286,7 +295,7 @@ -- Unix epoch is formatted as @-1.1@ with @%s%Q@. -- -- >>> epochF t--- "1494767807"+-- "1518646845" epochF :: FormatTime a => a -> Builder epochF = timeF "%s" @@ -297,35 +306,35 @@ -- | Same as @%m\/%d\/%y@. -- -- >>> dateSlashF t--- "05/14/17"+-- "02/14/18" dateSlashF :: FormatTime a => a -> Builder dateSlashF = timeF "%D"  -- | Same as @%Y-%m-%d@. -- -- >>> dateDashF t--- "2017-05-14"+-- "2018-02-14" dateDashF :: FormatTime a => a -> Builder dateDashF = timeF "%F"  -- | As 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@). -- -- >>> dateSlashLF t--- "05/14/17"+-- "02/14/18" dateSlashLF :: FormatTime a => a -> Builder dateSlashLF = timeF "%x"  -- | Year. -- -- >>> yearF t--- "2017"+-- "2018" yearF :: FormatTime a => a -> Builder yearF = timeF "%Y"  -- | Last two digits of year, @00@ - @99@. -- -- >>> yyF t--- "17"+-- "18" yyF :: FormatTime a => a -> Builder yyF = timeF "%y" @@ -339,23 +348,22 @@ -- | Month name, long form ('fst' from 'months' @locale@), @January@ - -- @December@. ----- >>> let longMonthT = read "2017-01-12 00:21:32.714083 UTC" :: UTCTime--- >>> monthNameF longMonthT--- "January"+-- >>> monthNameF t+-- "February" monthNameF :: FormatTime a => a -> Builder monthNameF = timeF "%B"  -- | Month name, short form ('snd' from 'months' @locale@), @Jan@ - @Dec@. ----- >>> monthNameShortF longMonthT--- "Jan"+-- >>> monthNameShortF t+-- "Feb" monthNameShortF :: FormatTime a => a -> Builder monthNameShortF = timeF "%b"  -- | Month of year, leading 0 as needed, @01@ - @12@. ----- >>> monthF longMonthT--- "01"+-- >>> monthF t+-- "02" monthF :: FormatTime a => a -> Builder monthF = timeF "%m" @@ -383,21 +391,21 @@ -- | Day of year for Ordinal Date format, @001@ - @366@. -- -- >>> dayF t--- "134"+-- "045" dayF :: FormatTime a => a -> Builder dayF = timeF "%j"  -- | Year for Week Date format e.g. @2013@. -- -- >>> weekYearF t--- "2017"+-- "2018" weekYearF :: FormatTime a => a -> Builder weekYearF = timeF "%G"  -- | Last two digits of year for Week Date format, @00@ - @99@. -- -- >>> weekYYF t--- "17"+-- "18" weekYYF :: FormatTime a => a -> Builder weekYYF = timeF "%g" @@ -411,21 +419,21 @@ -- | Week for Week Date format, @01@ - @53@. -- -- >>> weekF t--- "19"+-- "07" weekF :: FormatTime a => a -> Builder weekF = timeF "%V"  -- | Day for Week Date format, @1@ - @7@. -- -- >>> dayOfWeekF t--- "7"+-- "3" dayOfWeekF :: FormatTime a => a -> Builder dayOfWeekF = timeF "%u"  -- | Day of week, short form ('snd' from 'wDays' @locale@), @Sun@ - @Sat@. -- -- >>> dayNameShortF t--- "Sun"+-- "Wed" dayNameShortF :: FormatTime a => a -> Builder dayNameShortF = timeF "%a" @@ -433,7 +441,7 @@ -- @Saturday@. -- -- >>> dayNameF t--- "Sunday"+-- "Wednesday" dayNameF :: FormatTime a => a -> Builder dayNameF = timeF "%A" @@ -441,14 +449,14 @@ -- 'sundayStartWeek'), @00@ - @53@. -- -- >>> weekFromZeroF t--- "20"+-- "06" weekFromZeroF :: FormatTime a => a -> Builder weekFromZeroF = timeF "%U"  -- | Day of week number, @0@ (= Sunday) - @6@ (= Saturday). -- -- >>> dayOfWeekFromZeroF t--- "0"+-- "3" dayOfWeekFromZeroF :: FormatTime a => a -> Builder dayOfWeekFromZeroF = timeF "%w" @@ -456,7 +464,7 @@ -- 'mondayStartWeek'), @00@ - @53@. -- -- >>> weekOfYearMonF t--- "19"+-- "07" weekOfYearMonF :: FormatTime a => a -> Builder weekOfYearMonF = timeF "%W" @@ -522,10 +530,10 @@  -- | Display the absolute value time span in years. ----- >>> epochF t--- "1494767807"--- >>> yearsF 3 1494767807--- "47.399"+-- >>> epochF t    -- time passed since Jan 1, 1970+-- "1518646845"+-- >>> yearsF 3 1518646845+-- "48.156" yearsF :: RealFrac n        => Int -- ^ Decimal places.        -> n@@ -535,8 +543,8 @@  -- | Display the absolute value time span in days. ----- >>> daysF 3 1494767807--- "17300.553"+-- >>> daysF 3 1518646845+-- "17576.931" daysF :: RealFrac n       => Int -- ^ Decimal places.       -> n

@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}   module Main where@@ -22,6 +23,8 @@ import qualified Data.ByteString.Lazy as BSL -- Generics import GHC.Generics+-- Call stacks+import Data.CallStack -- Tests import Test.Hspec @@ -149,8 +152,6 @@     exptF 2 f1_3 ==#> "1.30e0"   it "fixedF" $ do     fixedF 2 f1_3 ==#> "1.30"-  it "precF" $ do-    precF 2 f1_3 ==#> "1.3"  test_hex :: Spec test_hex = describe "'hexF'" $ do@@ -508,14 +509,14 @@ test_tuples :: Spec test_tuples = describe "tuples" $ do   test_tupleSimple-  describe "tupleLikeF" $ do+  describe "tupleF on lists" $ do     test_tupleOneLine     test_tupleMultiline  test_tupleSimple :: Spec test_tupleSimple = it "tupleF" $ do   -- we don't need complicated tests here, they're all tested in-  -- 'tupleLikeF' tests+  -- "tupleF on lists" tests   tupleF (n, s) ==#> "(25, !)"   tupleF (n, s, n, s) ==#> "(25, !, 25, !)"   tupleF (n, s, n, s, 'a', 'b', 'c', 'd') ==#>@@ -524,21 +525,21 @@ test_tupleOneLine :: Spec test_tupleOneLine = describe "one-line" $ do   it "()" $ do-    tupleLikeF [] ==#> "()"+    tupleF ([] :: [Builder]) ==#> "()"   it "('')" $ do-    tupleLikeF [""] ==#> "()"+    tupleF ([""] :: [Builder]) ==#> "()"   it "(a)" $ do-    tupleLikeF ["a"] ==#> "(a)"+    tupleF (["a"] :: [Builder]) ==#> "(a)"   it "(a,b)" $ do-    tupleLikeF ["a", "b"] ==#> "(a, b)"+    tupleF (["a", "b"] :: [Builder]) ==#> "(a, b)"   it "(a,'')" $ do-    tupleLikeF ["a", ""] ==#> "(a, )"+    tupleF (["a", ""] :: [Builder]) ==#> "(a, )"   it "('',b)" $ do-    tupleLikeF ["", "b"] ==#> "(, b)"+    tupleF (["", "b"] :: [Builder]) ==#> "(, b)"   it "('','')" $ do-    tupleLikeF ["", ""] ==#> "(, )"+    tupleF (["", ""] :: [Builder]) ==#> "(, )"   it "(a,b,c)" $ do-    tupleLikeF ["a", "ba", "caba"] ==#> "(a, ba, caba)"+    tupleF (["a", "ba", "caba"] :: [Builder]) ==#> "(a, ba, caba)"  test_tupleMultiline :: Spec test_tupleMultiline = describe "multiline" $ do@@ -546,45 +547,45 @@   someEmpty   it "weird case" $ do     -- not sure whether I should fix it or not-    tupleLikeF ["a\n"] ==#> "(a\n)"+    tupleF ["a\n" :: Builder] ==#> "(a\n)"    where     allNonEmpty = describe "all non-empty" $ do       it "1 element (2 lines)" $ do-          tupleLikeF ["a\nx"] ==#> [text|+          tupleF ["a\nx" :: Builder] ==#> [text|             ( a               x )             |]-          tupleLikeF ["a\n x"] ==#> [text|+          tupleF ["a\n x" :: Builder] ==#> [text|             ( a                x )             |]-          tupleLikeF [" a\nx\n"] ==#> [text|+          tupleF [" a\nx\n" :: Builder] ==#> [text|             (  a               x )             |]       it "1 element (3 lines)" $ do-          tupleLikeF ["a\nb\nc"] ==#> [text|+          tupleF ["a\nb\nc" :: Builder] ==#> [text|             ( a               b               c )             |]       it "2 elements (1 line + 2 lines)" $ do-          tupleLikeF ["a", "b\nc"] ==#> [text|+          tupleF ["a", "b\nc" :: Builder] ==#> [text|             ( a             ,               b               c )             |]       it "2 elements (2 lines + 1 line)" $ do-          tupleLikeF ["a\nb", "c"] ==#> [text|+          tupleF ["a\nb", "c" :: Builder] ==#> [text|             ( a               b             ,               c )             |]       it "3 elements (each has 2 lines)" $ do-          tupleLikeF ["a\nb", "c\nd", "e\nf"] ==#> [text|+          tupleF ["a\nb", "c\nd", "e\nf" :: Builder] ==#> [text|             ( a               b             ,@@ -597,21 +598,21 @@      someEmpty = describe "some empty" $ do       it "2 elements (0 + 2)" $ do-          tupleLikeF ["", "a\nb"] ==#> [text|+          tupleF ["", "a\nb" :: Builder] ==#> [text|             (             ,               a               b )             |]       it "2 elements (2 + 0)" $ do-          tupleLikeF ["a\nb", ""] ==#> [text|+          tupleF ["a\nb", "" :: Builder] ==#> [text|             ( a               b             ,               )             |]       it "3 elements (0 + 2 + 0)" $ do-          tupleLikeF ["", "a\nb", ""] ==#> [text|+          tupleF ["", "a\nb", "" :: Builder] ==#> [text|             (             ,               a@@ -620,7 +621,7 @@               )             |]       it "3 elements (2 + 0 + 2)" $ do-          tupleLikeF ["a\nb", "", "c\nd"] ==#> [text|+          tupleF ["a\nb", "", "c\nd" :: Builder] ==#> [text|             ( a               b             ,@@ -629,7 +630,7 @@               d )             |]       it "4 elements (2 + 0 + 0 + 2)" $ do-          tupleLikeF ["a\nb", "", "", "c\nd"] ==#> [text|+          tupleF ["a\nb", "", "", "c\nd" :: Builder] ==#> [text|             ( a               b             ,@@ -706,8 +707,8 @@ -- Utilities ---------------------------------------------------------------------------- -(==%>) :: Text -> Text -> Expectation+(==%>) :: HasCallStack => Text -> Text -> Expectation (==%>) = shouldBe -(==#>) :: Builder -> Text -> Expectation+(==#>) :: HasCallStack => Builder -> Text -> Expectation (==#>) a b = a `shouldBe` build (T.replace "_" " " b)

@@ -0,0 +1,3 @@+{+    "sourceFolders": ["lib"]+}

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF doctest-discover -optF tests/doctest-config.json #-}