diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,28 @@ +# 0.0.0.3 + +* Wrote documentation. + +* Added some formatters: + + * `indent` + * formatters for lists, maps and tuples (`listF`, etc) + * `octF`, `binF`, `baseF` and floating-point formatters + * `hexF` which works on both numbers and bytestrings + * `ordinalF` and `commaizeF` + * padding and trimming formatters + * `base64F` and `base64UrlF` + * conditionals (`whenF` and `unlessF`) + +* Merged `Fmt.IO` with `Fmt` because orphan instances are controversial. + +* Exported internal classes and functions from `Fmt.Internal`. + +* Added `fmt` and `fmtLn`. + +* Made all operators associate to the right (`Builder` documentation says it's faster than the opposite). + +* Reexported `Buildable` and `Builder`. + # 0.0.0.2 * Added `>%%<` so that it'd be possible to write `%%%%` instead of weird `%%`. diff --git a/fmt.cabal b/fmt.cabal --- a/fmt.cabal +++ b/fmt.cabal @@ -1,5 +1,5 @@ name: fmt -version: 0.0.0.2 +version: 0.0.0.3 synopsis: Nice formatting library description: Nice formatting library @@ -22,10 +22,12 @@ library exposed-modules: Fmt - Fmt.IO - -- other-modules: - -- other-extensions: + Fmt.Internal build-depends: base >=4.6 && <5, + base16-bytestring, + base64-bytestring, + bytestring, + microlens >= 0.3, text, text-format >= 0.3 ghc-options: -Wall -fno-warn-unused-do-bind @@ -36,9 +38,15 @@ main-is: Main.hs type: exitcode-stdio-1.0 build-depends: base >=4.6 && <5 + , bytestring + , containers , fmt - , hspec >= 2.2 && < 2.4 + , hspec >= 2.2 && < 2.5 + , neat-interpolation , text + , vector ghc-options: -Wall -fno-warn-unused-do-bind hs-source-dirs: tests default-language: Haskell2010 + if impl(ghc < 7.10) + buildable: False diff --git a/lib/Fmt.hs b/lib/Fmt.hs --- a/lib/Fmt.hs +++ b/lib/Fmt.hs @@ -1,109 +1,1070 @@ -{-# LANGUAGE FlexibleInstances #-} - -module Fmt -( - (%<), - (>%), - (>%%<), - - (%<<), - (>>%), - (>>%%<<), - - (>%%<<), - (>>%%<), - - FromBuilder(..), -) -where - -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import Data.Text.Lazy.Builder hiding (fromString) -import Data.Monoid -import Data.Text.Buildable - ----------------------------------------------------------------------------- --- Operators with 'Buildable' ----------------------------------------------------------------------------- - -(%<) :: (Buildable a, FromBuilder b) => Builder -> a -> b -(%<) x a = fromBuilder (x <> build a) - -(>%) :: (FromBuilder b) => Builder -> Builder -> b -(>%) x a = fromBuilder (x <> a) - -(>%%<) :: (Buildable a, FromBuilder b) => Builder -> a -> b -(>%%<) x a = fromBuilder (x <> build a) - -infixl 1 %< -infixl 1 >% -infixl 1 >%%< - ----------------------------------------------------------------------------- --- Operators with 'Show' ----------------------------------------------------------------------------- - -(%<<) :: (Show a, FromBuilder b) => Builder -> a -> b -(%<<) x a = x %< show a -{-# INLINE (%<<) #-} - -(>>%) :: (FromBuilder b) => Builder -> Builder -> b -(>>%) x a = x >% a -{-# INLINE (>>%) #-} - -(>>%%<<) :: (Show a, FromBuilder b) => Builder -> a -> b -(>>%%<<) x a = x %< show a -{-# INLINE (>>%%<<) #-} - -infixl 1 %<< -infixl 1 >>% -infixl 1 >>%%<< - ----------------------------------------------------------------------------- --- Combinations ----------------------------------------------------------------------------- - -(>>%%<) :: (Buildable a, FromBuilder b) => Builder -> a -> b -(>>%%<) x a = x >%%< a -{-# INLINE (>>%%<) #-} - -(>%%<<) :: (Show a, FromBuilder b) => Builder -> a -> b -(>%%<<) x a = x >>%%<< a -{-# INLINE (>%%<<) #-} - -infixl 1 >>%%< -infixl 1 >%%<< - --- TODO: something for indentation --- TODO: something to format a record nicely (with generics, probably) --- TODO: something like https://hackage.haskell.org/package/groom --- TODO: reexport Buildable --- TODO: write docs --- TODO: mention printf in description so that it would be findable --- TODO: mention things that work (, , ) --- TODO: colors? --- TODO: add NL for newline? --- TODO: have to decide on whether it would be >%< or >%%< or maybe >|< --- TODO: actually, what about |< and >|? --- TODO: what effect does it have on compilation time? what effect do --- other formatting libraries have on compilation time? - -class FromBuilder a where - fromBuilder :: Builder -> a - -instance FromBuilder Builder where - fromBuilder = id - {-# INLINE fromBuilder #-} - -instance FromBuilder String where - fromBuilder = TL.unpack . toLazyText - {-# INLINE fromBuilder #-} - -instance FromBuilder T.Text where - fromBuilder = TL.toStrict . toLazyText - {-# INLINE fromBuilder #-} - -instance FromBuilder TL.Text where - fromBuilder = toLazyText - {-# INLINE fromBuilder #-} +{- Acknowledgements +~~~~~~~~~~~~~~~~~~~ + +* 'prefixF', 'suffixF', 'padCenterF', 'groupInt' are taken from + + Written by Github user @mwm + + +* 'ordinalF' is taken from + + Written by Chris Done + + +* 'atBase' is taken from + , originally from + + Seems to be written by Johan Kiviniemi + +-} + +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} + +module Fmt +( + -- * Overloaded strings + -- $overloadedstrings + + -- * Examples + -- $examples + + -- * Basic formatting + -- $brackets + + -- ** Ordinary brackets + (%<), + (>%), + -- ** 'Show' brackets + (%<<), + (>>%), + -- ** Combinations + (>%%<), + (>>%%<<), + (>%%<<), + (>>%%<), + + -- * Helper functions + fmt, + fmtLn, + + Builder, + Buildable(..), + + -- * Formatters + indent, indent', + nameF, + + -- ** Lists + listF, listF', + blockListF, blockListF', + jsonListF, jsonListF', + + -- ** Maps + mapF, mapF', + blockMapF, blockMapF', + jsonMapF, jsonMapF', + + -- ** Tuples + tupleF, + tupleLikeF, + + -- ** ADTs + maybeF, + eitherF, + + -- ** Padding/trimming + prefixF, + suffixF, + padLeftF, + padRightF, + padCenterF, + + -- ** Hex + hexF, + + -- ** Bytestrings + base64F, + base64UrlF, + + -- ** Integers + ordinalF, + commaizeF, + -- *** Base conversion + octF, + binF, + baseF, + + -- ** Floating-point + floatF, + exptF, + precF, + fixedF, + + -- ** Conditional formatting + whenF, + unlessF, +) +where + +-- Generic useful things +import Data.List +import Data.Monoid +import Lens.Micro +-- Text +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +-- 'Buildable' and text-format +import Data.Text.Buildable +import qualified Data.Text.Format as TF +-- Text 'Builder' +import Data.Text.Lazy.Builder hiding (fromString) +-- 'Foldable' and 'IsList' for list/map formatters +import Data.Foldable (toList) +#if __GLASGOW_HASKELL__ >= 708 +import GHC.Exts (IsList, Item) +import qualified GHC.Exts as IsList (toList) +#endif + +#if __GLASGOW_HASKELL__ < 710 +import Data.Foldable (Foldable) +#endif + +import Fmt.Internal + + +{- $overloadedstrings + +You need @OverloadedStrings@ enabled to use this library. There are three ways to do it: + + * __In GHCi:__ do @:set -XOverloadedStrings@. + + * __In a module:__ add @\{\-\# LANGUAGE OverloadedStrings \#\-\}@ + to the beginning of your module. + + * __In a project:__ add @OverloadedStrings@ to the @default-extensions@ + section of your @.cabal@ file. +-} + +{- $examples + +Here's a bunch of examples because some people learn better by looking at +examples. + +Insert some variables into a string: + +>>> let (a, b, n) = ("foo", "bar", 25) +>>> ("Here are some words: "%%", "%%"\nAlso a number: "%%"") :: String +"Here are some words: foo, bar\nAlso a number: 25" + +Print it: + +>>> fmtLn ("Here are some words: "%%", "%%"\nAlso a number: "%%"") +Here are some words: foo, bar +Also a number: 25 + +Format a list in various ways: + +>>> let xs = ["John", "Bob"] + +>>> fmtLn ("Using show: "%<>%"\nUsing listF: "%%"") +Using show: ["John","Bob"] +Using listF: [John, Bob] + +>>> fmt ("YAML-like:\n"%%"") +YAML-like: +- John +- Bob + +>>> fmt ("JSON-like: "%%"") +JSON-like: [ + John +, Bob +] + +-} + +---------------------------------------------------------------------------- +-- Operators with 'Buildable' +---------------------------------------------------------------------------- + +{- $brackets + +To format strings, put variables between ('%<') and ('>%'): + +>>> let name = "Alice" +>>> "Meet "%%"!" :: String +"Meet Alice!" + +Of course, 'Text' is supported as well: + +>>> "Meet "%%"!" :: 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 "%%"!") +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 "%\%"\\n"__ + xs \<- readFile fin + __"Writing processed data to "%\%"\\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 "%%"! She's got "%%" 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 (""%%"'s name has "%%" 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: "%%"") +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: "%%"") +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 (""%%%%%%" = "%%"") +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': + +@ +(""%\%%\%"") === (""%\<\\>%%\<\\>%"") +@ +-} + +(%<) :: (FromBuilder b) => Builder -> Builder -> b +(%<) str rest = fromBuilder (str <> rest) + +(>%) :: (Buildable a, FromBuilder b) => a -> Builder -> b +(>%) a rest = fromBuilder (build a <> rest) + +(>%%<) :: (Buildable a, FromBuilder b) => a -> Builder -> b +(>%%<) a rest = fromBuilder (build a <> rest) + +infixr 1 %< +infixr 1 >% +infixr 1 >%%< + +---------------------------------------------------------------------------- +-- Operators with 'Show' +---------------------------------------------------------------------------- + +(%<<) :: (FromBuilder b) => Builder -> Builder -> b +(%<<) str rest = str %< rest +{-# INLINE (%<<) #-} + +(>>%) :: (Show a, FromBuilder b) => a -> Builder -> b +(>>%) a rest = show a >% rest +{-# INLINE (>>%) #-} + +(>>%%<<) :: (Show a, FromBuilder b) => a -> Builder -> b +(>>%%<<) a rest = show a >% rest +{-# INLINE (>>%%<<) #-} + +infixr 1 %<< +infixr 1 >>% +infixr 1 >>%%<< + +---------------------------------------------------------------------------- +-- Combinations +---------------------------------------------------------------------------- + +(>>%%<) :: (Buildable a, FromBuilder b) => a -> Builder -> b +(>>%%<) a rest = a >%%< rest +{-# INLINE (>>%%<) #-} + +(>%%<<) :: (Show a, FromBuilder b) => a -> Builder -> b +(>%%<<) a rest = a >>%%<< rest +{-# INLINE (>%%<<) #-} + +infixr 1 >>%%< +infixr 1 >%%<< + +---------------------------------------------------------------------------- +-- Main functions +---------------------------------------------------------------------------- + +{- | 'fmt' converts things to 'String', 'Text' or 'Builder'. + +Most of the time you won't need it, as strings produced with ('%<') and +('>%') can already be used as 'String', 'Text', etc. However, combinators +like 'listF' can only produce 'Builder' (for better type inference), and you +need to use 'fmt' on them. + +Also, 'fmt' can do printing: + +>>> fmt "Hello world!\n" +Hello world! +-} +fmt :: FromBuilder b => Builder -> b +fmt = fromBuilder +{-# INLINE fmt #-} + +{- | Like 'fmt', but appends a newline. +-} +fmtLn :: FromBuilder b => Builder -> b +fmtLn = fromBuilder . (<> "\n") +{-# INLINE fmtLn #-} + +---------------------------------------------------------------------------- +-- Formatters +---------------------------------------------------------------------------- + +{- | Attach a name to anything: + +>>> fmt $ nameF "clients" $ blockListF ["Alice", "Bob", "Zalgo"] +clients: + - Alice + - Bob + - Zalgo +-} +nameF :: Builder -> Builder -> Builder +nameF k v = case TL.lines (toLazyText v) of + [] -> k <> ":\n" + [l] -> k <> ": " <> fromLazyText l <> "\n" + ls -> k <> ":\n" <> + mconcat [" " <> fromLazyText s <> "\n" | s <- ls] + +---------------------------------------------------------------------------- +-- List formatters +---------------------------------------------------------------------------- + +{- | A simple comma-separated list formatter. + +>>> listF ["hello", "world"] +"[hello, world]" +-} +listF :: (Foldable f, Buildable a) => f a -> Builder +listF = listF' build +{-# INLINE listF #-} + +{- | A version of 'listF' that lets you supply your own building function for +list elements. + +For instance, to format a list of lists you'd have to do this (since there's +no 'Buildable' instance for lists): + +>>> listF' listF [[1,2,3],[4,5,6]] +"[[1, 2, 3], [4, 5, 6]]" +-} +listF' :: (Foldable f) => (a -> Builder) -> f a -> Builder +listF' fbuild xs = mconcat $ + "[" : + intersperse ", " (map fbuild (toList xs)) ++ + ["]"] + +{-# SPECIALIZE listF' :: (a -> Builder) -> [a] -> Builder #-} + +{- Note [Builder appending] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The documentation for 'Builder' says that it's preferrable to associate +'Builder' appends to the right (i.e. @a <> (b <> c)@). The maximum possible +association-to-the-right is achieved when we avoid appending builders +until the last second (i.e. in the latter scenario): + + -- (a1 <> x) <> (a2 <> x) <> ... + mconcat [a <> x | a <- as] + + -- a1 <> x <> a2 <> x <> ... + mconcat $ concat [[a, x] | a <- as] + +However, benchmarks have shown that the former way is actually faster. +-} + +{- | A multiline formatter for lists. + +>>> fmt $ blockListF [1,2,3] +- 1 +- 2 +- 3 + +It automatically handles multiline list elements: + +@ +>>> fmt $ blockListF ["hello\nworld", "foo\nbar\nquix"] +- hello + world + +- foo + bar + quix +@ +-} +blockListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder +blockListF = blockListF' build +{-# INLINE blockListF #-} + +{- | A version of 'blockListF' that lets you supply your own building function +for list elements. +-} +blockListF' :: forall f a. (Foldable f) => (a -> Builder) -> f a -> Builder +blockListF' fbuild xs + | null items = "[]\n" + | True `elem` mls = mconcat (intersperse "\n" items) + | otherwise = mconcat items + where + (mls, items) = unzip $ map buildItem (toList xs) + -- Returns 'True' if the item is multiline + buildItem :: a -> (Bool, Builder) + buildItem x = case TL.lines (toLazyText (fbuild x)) of + [] -> (False, "-\n") + (l:ls) -> (not (null ls), + "- " <> fromLazyText l <> "\n" <> + mconcat [" " <> fromLazyText s <> "\n" | s <- ls]) + +{-# SPECIALIZE blockListF' :: (a -> Builder) -> [a] -> Builder #-} + +{- | A JSON-style formatter for lists. + +>>> fmt $ jsonListF [1,2,3] +[ + 1 +, 2 +, 3 +] + +Like 'blockListF', it handles multiline elements well: + +>>> fmt $ jsonListF ["hello\nworld", "foo\nbar\nquix"] +[ + hello + world +, foo + bar + quix +] + +(Note that, unlike 'blockListF', it doesn't add blank lines in such cases.) +-} +jsonListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder +jsonListF = jsonListF' build +{-# INLINE jsonListF #-} + +{- | A version of 'jsonListF' that lets you supply your own building function +for list elements. +-} +jsonListF' :: forall f a. (Foldable f) => (a -> Builder) -> f a -> Builder +jsonListF' fbuild xs + | null items = "[]\n" + | otherwise = "[\n" <> mconcat items <> "]\n" + where + items = zipWith buildItem (True : repeat False) (toList xs) + -- Item builder + buildItem :: Bool -> a -> Builder + buildItem isFirst x = + case map fromLazyText (TL.lines (toLazyText (fbuild x))) of + [] | isFirst -> "\n" + | otherwise -> ",\n" + ls -> + mconcat . map (<> "\n") $ + ls & _head %~ (if isFirst then (" " <>) else (", " <>)) + & _tail.each %~ (" " <>) + +{-# SPECIALIZE jsonListF' :: (a -> Builder) -> [a] -> Builder #-} + +---------------------------------------------------------------------------- +-- Map formatters +---------------------------------------------------------------------------- + +#if __GLASGOW_HASKELL__ >= 708 +# define MAPTOLIST IsList.toList +#else +# define MAPTOLIST id +#endif + +{- | A simple JSON-like map formatter; works for Map, HashMap, etc, as well as +ordinary lists of pairs. Doesn't handle multiline elements (for that you need 'blockMapF' or 'jsonMapF'). + +>>> mapF [("a", 1), ("b", 4)] +"{a: 1, b: 4}" +-} +mapF :: +#if __GLASGOW_HASKELL__ >= 708 + (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder +#else + (Buildable k, Buildable v) => [(k, v)] -> Builder +#endif +mapF = mapF' build build +{-# INLINE mapF #-} + +{- | A version of 'mapF' that lets you supply your own building function for +keys and values. +-} +mapF' :: +#if __GLASGOW_HASKELL__ >= 708 + (IsList t, Item t ~ (k, v)) => + (k -> Builder) -> (v -> Builder) -> t -> Builder +#else + (k -> Builder) -> (v -> Builder) -> [(k, v)] -> Builder +#endif +mapF' fbuild_k fbuild_v xs = + "{" <> mconcat (intersperse ", " (map buildPair (MAPTOLIST xs))) <> "}" + where + buildPair (k, v) = fbuild_k k <> ": " <> fbuild_v v + +{- | A YAML-like map formatter: + +>>> fmt $ blockMapF [("Odds", blockListF [1,3]), ("Evens", blockListF [2,4])] +Odds: + - 1 + - 3 +Evens: + - 2 + - 4 +-} +blockMapF :: +#if __GLASGOW_HASKELL__ >= 708 + (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder +#else + (Buildable k, Buildable v) => [(k, v)] -> Builder +#endif +blockMapF = blockMapF' build build +{-# INLINE blockMapF #-} + +{- | A version of 'blockMapF' that lets you supply your own building function +for keys and values. +-} +blockMapF' :: +#if __GLASGOW_HASKELL__ >= 708 + (IsList t, Item t ~ (k, v)) => + (k -> Builder) -> (v -> Builder) -> t -> Builder +#else + (k -> Builder) -> (v -> Builder) -> [(k, v)] -> Builder +#endif +blockMapF' fbuild_k fbuild_v xs + | null items = "{}\n" + | otherwise = mconcat items + where + items = map (\(k, v) -> nameF (fbuild_k k) (fbuild_v v)) (MAPTOLIST xs) + +{- | A JSON-like map formatter (unlike 'mapF', always multiline): + +>>> fmt $ jsonMapF [("Odds", jsonListF [1,3]), ("Evens", jsonListF [2,4])] +{ + Odds: + [ + 1 + , 3 + ] +, Evens: + [ + 2 + , 4 + ] +} +-} +jsonMapF :: +#if __GLASGOW_HASKELL__ >= 708 + (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder +#else + (Buildable k, Buildable v) => [(k, v)] -> Builder +#endif +jsonMapF = jsonMapF' build build +{-# INLINE jsonMapF #-} + +{- | A version of 'jsonMapF' that lets you supply your own building function +for keys and values. +-} +jsonMapF' :: +#if __GLASGOW_HASKELL__ >= 708 + forall t k v. + (IsList t, Item t ~ (k, v)) => + (k -> Builder) -> (v -> Builder) -> t -> Builder +#else + forall k v. + (k -> Builder) -> (v -> Builder) -> [(k, v)] -> Builder +#endif +jsonMapF' fbuild_k fbuild_v xs + | null items = "{}\n" + | otherwise = "{\n" <> mconcat items <> "}\n" + where + items = zipWith buildItem (True : repeat False) (MAPTOLIST xs) + -- Item builder + buildItem :: Bool -> (k, v) -> Builder + buildItem isFirst (k, v) = do + let kb = (if isFirst then " " else ", ") <> fbuild_k k + case map fromLazyText (TL.lines (toLazyText (fbuild_v v))) of + [] -> kb <> ":\n" + [l] -> kb <> ": " <> l <> "\n" + ls -> kb <> ":\n" <> + mconcat [" " <> s <> "\n" | s <- ls] + +---------------------------------------------------------------------------- +-- Tuple formatters +---------------------------------------------------------------------------- + +class TupleF a where + {- | +Format a tuple (of up to 8 elements): + +>>> tupleF (1,2,"hi") +"(1, 2, hi)" + +If any of the elements takes several lines, an alternate format is used: + +@ +>>> fmt $ tupleF ("test","foo\nbar","more test") +( test +, + foo + bar +, + more test ) +@ + -} + tupleF :: a -> Builder + +instance (Buildable a1, Buildable a2) + => TupleF (a1, a2) where + tupleF (a1, a2) = tupleLikeF + [build a1, build a2] + +instance (Buildable a1, Buildable a2, Buildable a3) + => TupleF (a1, a2, a3) where + tupleF (a1, a2, a3) = tupleLikeF + [build a1, build a2, build a3] + +instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4) + => TupleF (a1, a2, a3, a4) where + tupleF (a1, a2, a3, a4) = tupleLikeF + [build a1, build a2, build a3, build a4] + +instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4, + Buildable a5) + => TupleF (a1, a2, a3, a4, a5) where + tupleF (a1, a2, a3, a4, a5) = tupleLikeF + [build a1, build a2, build a3, build a4, + build a5] + +instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4, + Buildable a5, Buildable a6) + => TupleF (a1, a2, a3, a4, a5, a6) where + tupleF (a1, a2, a3, a4, a5, a6) = tupleLikeF + [build a1, build a2, build a3, build a4, + build a5, build a6] + +instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4, + Buildable a5, Buildable a6, Buildable a7) + => TupleF (a1, a2, a3, a4, a5, a6, a7) where + tupleF (a1, a2, a3, a4, a5, a6, a7) = tupleLikeF + [build a1, build a2, build a3, build a4, + build a5, build a6, build a7] + +instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4, + Buildable a5, Buildable a6, Buildable a7, Buildable a8) + => TupleF (a1, a2, a3, a4, a5, a6, a7, a8) where + tupleF (a1, a2, a3, a4, a5, a6, a7, a8) = tupleLikeF + [build a1, build a2, build a3, build a4, + build a5, build a6, build a7, build a8] + +{- | +Format a list like a tuple. (This function is used to define 'tupleF'.) +-} +tupleLikeF :: [Builder] -> Builder +tupleLikeF xs + | True `elem` mls = mconcat (intersperse ",\n" items) + | otherwise = "(" <> mconcat (intersperse ", " xs) <> ")" + where + (mls, items) = unzip $ zipWith3 buildItem + xs (set _head True falses) (set _last True falses) + -- A list of 'False's which has the same length as 'xs' + falses = map (const False) xs + -- Returns 'True' if the item is multiline + buildItem :: Builder + -> Bool -- ^ Is the item the first? + -> Bool -- ^ Is the item the last? + -> (Bool, Builder) + buildItem x isFirst isLast = + case map fromLazyText (TL.lines (toLazyText x)) of + [] | isFirst && isLast -> (False, "()\n") + | isFirst -> (False, "(\n") + | isLast -> (False, " )\n") + | otherwise -> (False, "") + ls -> + (not (null (tail ls)), + mconcat . map (<> "\n") $ + ls & _head %~ (if isFirst then ("( " <>) else (" " <>)) + & _tail.each %~ (" " <>) + & _last %~ (if isLast then (<> " )") else id)) + +---------------------------------------------------------------------------- +-- ADT formatters +---------------------------------------------------------------------------- + +{- | +Like 'build' for 'Maybe', but displays 'Nothing' as @@ instead of an empty string. + +'build': + +>>> build (Nothing :: Maybe Int) +"" +>>> build (Just 1 :: Maybe Int) +"1" + +'maybeF': + +>>> maybeF (Nothing :: Maybe Int) +"" +>>> maybeF (Just 1 :: Maybe Int) +"1" +-} +maybeF :: Buildable a => Maybe a -> Builder +maybeF = maybe "" build + +{- | +Format an 'Either': + +>>> eitherF (Right 1) +": 1" +-} +eitherF :: (Buildable a, Buildable b) => Either a b -> Builder +eitherF = either (\x -> ": " <> build x) (\x -> ": " <> build x) + +---------------------------------------------------------------------------- +-- Other formatters +---------------------------------------------------------------------------- + +{- | +Take the first N characters: + +>>> prefixF 3 "hello" +"hel" +-} +prefixF :: Buildable a => Int -> a -> Builder +prefixF size = + fromLazyText . TL.take (fromIntegral size) . toLazyText . build + +{- | +Take the last N characters: + +>>> suffixF 3 "hello" +"llo" +-} +suffixF :: Buildable a => Int -> a -> Builder +suffixF size = + fromLazyText . + (\t -> TL.drop (TL.length t - fromIntegral size) t) . + toLazyText . build + +{- | +@padLeftF n c@ pads the string with character @c@ from the left side until it +becomes @n@ characters wide (and does nothing if the string is already that +long, or longer): + +>>> padLeftF 5 '0' 12 +"00012" +>>> padLeftF 5 '0' 123456 +"123456" +-} +padLeftF :: Buildable a => Int -> Char -> a -> Builder +padLeftF = TF.left + +{- | +@padRightF n c@ pads the string with character @c@ from the right side until +it becomes @n@ characters wide (and does nothing if the string is already +that long, or longer): + +>>> padRightF 5 ' ' "foo" +"foo " +>>> padRightF 5 ' ' "foobar" +"foobar" +-} +padRightF :: Buildable a => Int -> Char -> a -> Builder +padRightF = TF.right + +{- | +@padCenterF n c@ pads the string with character @c@ from both sides until +it becomes @n@ characters wide (and does nothing if the string is already +that long, or longer): + +>>> padCenterF 5 '=' "foo" +"=foo=" +>>> padCenterF 5 '=' "foobar" +"foobar" + +When padding can't be distributed equally, the left side is preferred: + +>>> padCenter 8 '=' "foo" +"===foo==" +-} +padCenterF :: Buildable a => Int -> Char -> a -> Builder +padCenterF i c = + fromLazyText . TL.center (fromIntegral i) c . toLazyText . build + +{- | +Add an ordinal suffix to a number: + +>>> ordinalF 15 +"15th" +>>> ordinalF 22 +"22nd" +-} +ordinalF :: (Buildable a, Integral a) => a -> Builder +ordinalF n + | tens > 3 && tens < 21 = build n <> "th" + | otherwise = build n <> case n `mod` 10 of + 1 -> "st" + 2 -> "nd" + 3 -> "rd" + _ -> "th" + where + tens = n `mod` 100 + +{- | +Break digits in a number: + +>>> commaizeF 15830000 +"15,830,000" +-} +commaizeF :: (Buildable a, Integral a) => a -> Builder +commaizeF = groupInt 3 ',' + +{- | +Format a number as octal: + +>>> listF' octF [7,8,9,10] +"[7, 10, 11, 12]" +-} +octF :: Integral a => a -> Builder +octF = baseF 8 + +{- | +Format a number as binary: + +>>> listF' binF [7,8,9,10] +"[111, 1000, 1001, 1010]" +-} +binF :: Integral a => a -> Builder +binF = baseF 2 + +{- | +Format a number in arbitrary base (up to 36): + +>>> baseF 3 10000 +"111201101" +>>> baseF 7 10000 +"41104" +>>> baseF 36 10000 +"7ps" +-} +baseF :: Integral a => Int -> a -> Builder +baseF numBase = build . atBase numBase + +{- | +Format a floating-point number: + +>>> floatF 3.1415 +"3.1415" + +Numbers bigger than 1e21 or smaller than 1e-6 will be displayed using +scientific notation: + +>>> listF' floatF [1e-6,9e-7] +"[0.000001, 9e-7]" +>>> listF' floatF [9e20,1e21] +"[900000000000000000000, 1e21]" +-} +floatF :: Real a => a -> Builder +floatF = TF.shortest + +{- | +Format a floating-point number using scientific notation, with given amount +of precision: + +>>> listF' (exptF 5) [pi,0.1,10] +"[3.14159e0, 1.00000e-1, 1.00000e1]" +-} +exptF :: Real a => Int -> a -> Builder +exptF = TF.expt + +{- | +Format a floating-point number with given amount of precision. + +For small numbers, it uses scientific notation for everything smaller than +1e-6: + +> listF' (precF 3) [1e-5,1e-6,1e-7] +"[0.0000100, 0.00000100, 1.00e-7]" + +For large numbers, it uses scientific notation for everything larger than +1eN, where N is the precision: + +> listF' (precF 4) [1e3,5e3,1e4] +"[1000, 5000, 1.000e4]" +-} +precF :: Real a => Int -> a -> Builder +precF = TF.prec + +{- | +Format a floating-point number without scientific notation: + +>>> listF' (fixedF 5) [pi,0.1,10] +"[3.14159, 0.10000, 10.00000]" +-} +fixedF :: Real a => Int -> a -> Builder +fixedF = TF.fixed + +---------------------------------------------------------------------------- +-- Conditional formatters +---------------------------------------------------------------------------- + +{- | +Display something only if the condition is 'True' (empty string otherwise). + +@ +>>> "Hello!" <> whenF showDetails (", details: "%%"") +@ + +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 :: Bool -> Builder -> Builder +whenF True x = x +whenF False _ = mempty +{-# INLINE whenF #-} + +{- | +Display something only if the condition is 'False' (empty string otherwise). +-} +unlessF :: Bool -> Builder -> Builder +unlessF False x = x +unlessF True _ = mempty +{-# INLINE unlessF #-} + +---------------------------------------------------------------------------- +-- Utilities +---------------------------------------------------------------------------- + +{- | +Indent already formatted text. + +>>> fmt $ "This is a list:\n" <> indent 4 (blockListF [1,2,3]) +This is a list: + - 1 + - 2 + - 3 +-} +indent :: Int -> Builder -> Builder +indent n a = go (toLazyText a) + where + spaces = fromText (T.replicate n (T.singleton ' ')) + -- We don't use 'lines' because it doesn't distinguish between trailing + -- newline being present/absent. We want the following behavior: + -- >>> indent 2 "hi" + -- " hi" + -- >>> indent 2 "hi\n" + -- " hi\n" + go t | TL.null t = mempty + go t = let (l, t') = TL.break ((==) '\n') t + in spaces <> if TL.null t' + then fromLazyText l + else fromLazyText l <> singleton '\n' <> + go (TL.tail t') + +---------------------------------------------------------------------------- +-- TODOs +---------------------------------------------------------------------------- + +{- add these: + +* something that would cut a string by adding ellipsis to the center +* 'time' that would use hackage.haskell.org/package/time/docs/Data-Time-Format.html#t:FormatTime +* something that would show time and date in a standard way +* something to format a floating-point number without any scientific notation +-} + +{- list/map: + +* maybe add something like blockMapF_ and blockListF_ that would add + a blank line automatically? or `---` and `:::` or something? +* should also add something to _not_ add a blank line between list + entries (e.g. when they are 'name'd and can be clearly differentiated) +* should also add something that would truncate lists in the middle + (and maybe not in the middle as well) +* the problem is that the user might want to combine them so I guess + we can't make a separate combinator for each +* there don't seem to be any cases when 'listF' is better than 'jsonListF', + so we'd want to leave only one of those, but there are cases when 'mapF' is + better than 'jsonMapF' (i.e. when you want everything to be on one + line). What to do? Maybe rename 'jsonMapF' to 'mapF' and 'mapF' to ??? + (can't think of a name)? +-} + +{- docs + +* add an examples section in the beginning +* provide a formatting→fmt transition table +* mention that fmt doesn't do the neat thing that formatting does with (<>) + (or maybe it does? there's a monoid instance for functions after all, + though I might also have to write a IsString instance for (a -> Builder)) +* write that if %< >% are hated or if it's inconvenient in some cases, + you can just use provided formatters and <> (add Fmt.DIY for that?) + (e.g. "pub:" <> base16F foo) +* write that it can be used in parallel with formatting? +* mention printf in cabal description so that it would be findable +* clarify philosophy (“take a free spot in design space; write the + best possible library around it, not just a proof of concept”) +* clarify what exactly is hard about writing `formatting` formatters +* write that [(a,b)] works too and could be used +-} + +{- others + +* rename 'padCenterF' +* change indentation to always add newlines +* something to format a record nicely (with generics, probably) +* something like https://hackage.haskell.org/package/groom +* something for wrapping lists (not indenting, just hard-wrapping) +* reexport (<>)? don't know whether to use Semigroup or Monoid, though +* colors? +* should it be called 'listBlock' or 'blockList'? +* add NL or _NL for newline? or (<\>) or (<>\)? and also (>%\)? +* have to decide on whether it would be >%< or >%%< or maybe >|< +* actually, what about |< and >|? +* what effect does it have on compilation time? what effect do + other formatting libraries have on compilation time? +* use 4 spaces instead of 2? +* change tuples to correspond to jsonList +* be consistent about newlines after tuples/maps/lists +* find some way to use IO inside %<>% brackets +-} diff --git a/lib/Fmt/IO.hs b/lib/Fmt/IO.hs deleted file mode 100644 --- a/lib/Fmt/IO.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE GADTs #-} - -{-# OPTIONS_GHC -fno-warn-orphans #-} - - -module Fmt.IO -( - module Fmt, -) -where - - -import Fmt -import qualified Data.Text.Lazy.Builder as TL -import qualified Data.Text.Lazy.IO as TL - - -instance (a ~ ()) => FromBuilder (IO a) where - fromBuilder = TL.putStr . TL.toLazyText - {-# INLINE fromBuilder #-} diff --git a/lib/Fmt/Internal.hs b/lib/Fmt/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/Fmt/Internal.hs @@ -0,0 +1,192 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP #-} + +-- for FormatAsHex +#if __GLASGOW_HASKELL__ < 710 +{-# LANGUAGE OverlappingInstances #-} +#endif + +{- | A module providing access to internals (in case you really need them). Can +change at any time, though probably won't. +-} +module Fmt.Internal +( + -- * Classes + FromBuilder(..), + FormatAsHex(..), + FormatAsBase64(..), + + -- * Helpers + groupInt, + atBase, + showSigned', + intToDigit', + indent', +) +where + +-- Generic useful things +import Data.Monoid +import Numeric +import Data.Char +-- Text +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TL +import qualified Data.Text.Lazy.Encoding as TL +-- 'Buildable' and text-format +import Data.Text.Buildable +import qualified Data.Text.Format as TF +-- Text 'Builder' +import Data.Text.Lazy.Builder hiding (fromString) +-- Bytestring +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +-- Formatting bytestrings +import qualified Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Base16.Lazy as B16L +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Base64.Lazy as B64L +import qualified Data.ByteString.Base64.URL as B64U +import qualified Data.ByteString.Base64.URL.Lazy as B64UL + +---------------------------------------------------------------------------- +-- FromBuilder +---------------------------------------------------------------------------- + +class FromBuilder a where + fromBuilder :: Builder -> a + +instance FromBuilder Builder where + fromBuilder = id + {-# INLINE fromBuilder #-} + +instance (a ~ Char) => FromBuilder [a] where + fromBuilder = TL.unpack . toLazyText + {-# INLINE fromBuilder #-} + +instance FromBuilder T.Text where + fromBuilder = TL.toStrict . toLazyText + {-# INLINE fromBuilder #-} + +instance FromBuilder TL.Text where + fromBuilder = toLazyText + {-# INLINE fromBuilder #-} + +instance (a ~ ()) => FromBuilder (IO a) where + fromBuilder = TL.putStr . toLazyText + {-# INLINE fromBuilder #-} + +---------------------------------------------------------------------------- +-- Hex +---------------------------------------------------------------------------- + +class FormatAsHex a where + {- | +Format a number or bytestring as hex: + +>>> hexF 3635 +"e33" + -} + hexF :: a -> Builder + +instance FormatAsHex BS.ByteString where + hexF = fromText . T.decodeLatin1 . B16.encode + +instance FormatAsHex BSL.ByteString where + hexF = fromLazyText . TL.decodeLatin1 . B16L.encode + +#if __GLASGOW_HASKELL__ >= 710 +instance {-# OVERLAPPABLE #-} Integral a => FormatAsHex a where + hexF = TF.hex +#else +instance Integral a => FormatAsHex a where + hexF = TF.hex +#endif + +---------------------------------------------------------------------------- +-- Base64 +---------------------------------------------------------------------------- + +class FormatAsBase64 a where + {- | +Convert a bytestring to base64: + +>>> base64F ("\0\50\63\80" :: BS.ByteString) +"ADI/UA==" + -} + base64F :: a -> Builder + {- | +Convert a bytestring to base64url (a variant of base64 which omits @\/@ and +thus can be used in URLs): + +>>> base64UrlF ("\0\50\63\80" :: BS.ByteString) +"ADI_UA==" + -} + base64UrlF :: a -> Builder + +instance FormatAsBase64 BS.ByteString where + base64F = fromText . T.decodeLatin1 . B64.encode + base64UrlF = fromText . T.decodeLatin1 . B64U.encode + +instance FormatAsBase64 BSL.ByteString where + base64F = fromLazyText . TL.decodeLatin1 . B64L.encode + base64UrlF = fromLazyText . TL.decodeLatin1 . B64UL.encode + +---------------------------------------------------------------------------- +-- Helpers +---------------------------------------------------------------------------- + +groupInt :: (Buildable a, Integral a) => Int -> Char -> a -> Builder +groupInt 0 _ n = build n +groupInt i c n = + fromLazyText . TL.reverse . + foldr merge "" . + TL.zip (zeros <> cycle' zeros') . + TL.reverse . + toLazyText . build + $ n + where + zeros = TL.replicate (fromIntegral i) (TL.singleton '0') + zeros' = TL.singleton c <> TL.tail zeros + merge (f, c') rest + | f == c = TL.singleton c <> TL.singleton c' <> rest + | otherwise = TL.singleton c' <> rest + cycle' xs = xs <> cycle' xs + -- Suppress the warning about redundant Integral constraint + _ = toInteger n + +atBase :: Integral a => Int -> a -> String +atBase b _ | b < 2 || b > 36 = error ("baseF: Invalid base " ++ show b) +atBase b n = + showSigned' (showIntAtBase (toInteger b) intToDigit') (toInteger n) "" +{-# INLINE atBase #-} + +showSigned' :: Real a => (a -> ShowS) -> a -> ShowS +showSigned' f n + | n < 0 = showChar '-' . f (negate n) + | otherwise = f n + +intToDigit' :: Int -> Char +intToDigit' i + | i >= 0 && i < 10 = chr (ord '0' + i) + | i >= 10 && i < 36 = chr (ord 'a' + i - 10) + | otherwise = error ("intToDigit': Invalid int " ++ show i) + +-- assumes that the prefix doesn't contain newlines +indent' :: Int -> T.Text -> Builder -> Builder +indent' n pref a = go True (toLazyText a) + where + spaces = fromText (T.replicate n (T.singleton ' ')) + go isFirst t + | TL.null t = if isFirst then fromText pref else "" + | otherwise = let (l, t') = TL.break ((==) '\n') t + in (if isFirst then fromText pref else spaces) <> + if TL.null t' + then fromLazyText l + else fromLazyText l <> singleton '\n' <> + go False (TL.tail t') diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,5 +1,6 @@ {-# LANGUAGE -OverloadedStrings +OverloadedStrings, +QuasiQuotes #-} @@ -10,8 +11,16 @@ import Data.Monoid ((<>)) -- Text import Data.Text (Text) +import qualified Data.Text as T import qualified Data.Text.Lazy as TL -import Data.Text.Lazy.Builder (Builder) +import NeatInterpolation +-- Various data structures +import qualified Data.Vector as V +import Data.Vector (Vector) +import qualified Data.Map as M +import Data.Map (Map) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL -- Tests import Test.Hspec @@ -21,7 +30,7 @@ main :: IO () main = hspec $ do - let n = 25 :: Int + let n = 25 :: Integer s = "!" :: String it "simple examples" $ do @@ -62,9 +71,467 @@ it "Builder" $ ("a"%%"b" :: Builder) `shouldBe` "a25b" + + describe "formatters" $ do + describe "'indent'" $ do + it "simple examples" $ do + indent 0 "hi" ==#> "hi" + indent 0 "\nhi\n\n" ==#> "\nhi\n\n" + indent 2 "hi" ==#> " hi" + indent 2 "hi\n" ==#> " hi\n" + indent 2 "" ==#> "" + indent 2 "hi\nbye" ==#> " hi\n bye" + indent 2 "hi\nbye\n" ==#> " hi\n bye\n" + it "formatting a block" $ do + ("Some numbers:\n"<> + indent 2 ( + "odd: "%%"\n"<> + "even: "%%"")) ==#> "Some numbers:\n odd: 25\n even: 26" + + describe "'listF'" $ do + it "simple examples" $ do + listF ([] :: [Int]) ==#> "[]" + listF [n] ==#> "[25]" + listF [n,n+1] ==#> "[25, 26]" + listF [s,s<>s,"",s<>s<>s] ==#> "[!, !!, , !!!]" + it "different Foldables" $ do + listF ([1,2,3] :: [Int]) ==#> "[1, 2, 3]" + listF (V.fromList [1,2,3] :: Vector Int) ==#> "[1, 2, 3]" + listF (M.fromList [(1,2),(3,4),(5,6)] :: Map Int Int) ==#> "[2, 4, 6]" + + describe "'blockListF'" $ do + it "empty list" $ do + blockListF ([] :: [Int]) ==#> "[]\n" + it "null elements" $ do + blockListF ([""] :: [Text]) ==#> [text| + - + |] + blockListF (["",""] :: [Text]) ==#> [text| + - + - + |] + blockListF (["","a",""] :: [Text]) ==#> [text| + - + - a + - + |] + it "single-line elements" $ do + blockListF (["a"] :: [Text]) ==#> [text| + - a + |] + blockListF (["a","b"] :: [Text]) ==#> [text| + -_a + -_b + |] + blockListF (["a","b","ccc"] :: [Text]) ==#> [text| + - a + - b + - ccc + |] + it "multi-line elements" $ do + blockListF (["a\nx"] :: [Text]) ==#> [text| + - a + x + |] + blockListF (["a\n x"] :: [Text]) ==#> [text| + - a + x + |] + blockListF (["a\n x"," b\nxx\ny y ","c\n\n"] :: [Text]) ==#> [text| + - a + x + + - b + xx + y y_ + + - c + __ + |] + it "mix of single-line and multi-line" $ do + blockListF (["a\nx","b"] :: [Text]) ==#> [text| + - a + x + + - b + |] + blockListF (["a\nx","b\n"] :: [Text]) ==#> [text| + - a + x + + - b + |] + blockListF (["a"," b\nxx\ny y ","c\n\n"] :: [Text]) ==#> [text| + - a + + - b + xx + y y_ + + - c + __ + |] + describe "'jsonListF'" $ do + it "empty list" $ do + jsonListF ([] :: [Int]) ==#> "[]\n" + it "null elements" $ do + jsonListF ([""] :: [Text]) ==#> [text| + [ + + ] + |] + jsonListF (["",""] :: [Text]) ==#> [text| + [ + + , + ] + |] + jsonListF (["","a",""] :: [Text]) ==#> [text| + [ + + , a + , + ] + |] + it "single-line elements" $ do + jsonListF (["a"] :: [Text]) ==#> [text| + [ + a + ] + |] + jsonListF (["a","b"] :: [Text]) ==#> [text| + [ + a + , b + ] + |] + jsonListF (["a","b","ccc"] :: [Text]) ==#> [text| + [ + a + , b + , ccc + ] + |] + it "multi-line elements" $ do + jsonListF (["a\nx"] :: [Text]) ==#> [text| + [ + a + x + ] + |] + jsonListF (["a\n x"] :: [Text]) ==#> [text| + [ + a + x + ] + |] + jsonListF (["a\n x"," b\nxx\ny y ","c\n\n"] :: [Text]) ==#> [text| + [ + a + x + , b + xx + y y_ + , c + __ + ] + |] + it "mix of single-line and multi-line" $ do + jsonListF (["a\nx","b"] :: [Text]) ==#> [text| + [ + a + x + , b + ] + |] + jsonListF (["a\nx","b\n"] :: [Text]) ==#> [text| + [ + a + x + , b + ] + |] + jsonListF (["a"," b\nxx\ny y ","c\n\n"] :: [Text]) ==#> [text| + [ + a + , b + xx + y y_ + , c + __ + ] + |] + + describe "'mapF'" $ do + it "simple examples" $ do + mapF ([] :: [(Int, Int)]) ==#> "{}" + mapF [(n,n+1)] ==#> "{25: 26}" + mapF [(s,n)] ==#> "{!: 25}" + mapF [('a',True),('b',False),('c',True)] ==#> + "{a: True, b: False, c: True}" + it "different map types" $ do + let m = [('a',True),('b',False),('d',False),('c',True)] + mapF m ==#> "{a: True, b: False, d: False, c: True}" + mapF (M.fromList m) ==#> "{a: True, b: False, c: True, d: False}" + + describe "'blockMapF'" $ do + it "empty map" $ do + blockMapF ([] :: [(Int, Int)]) ==#> "{}\n" + it "complex example" $ do + blockMapF ([("hi", ""), + ("foo"," a\n b"), + ("bar","a"), + ("baz","a\ng")] :: [(Text, Text)]) ==#> [text| + hi: + foo: + a + b + bar: a + baz: + a + g + |] + + describe "'jsonMapF'" $ do + it "empty map" $ do + jsonMapF ([] :: [(Int, Int)]) ==#> "{}\n" + it "complex example" $ do + jsonMapF ([("hi", ""), + ("foo"," a\n b"), + ("bar","a"), + ("baz","a\ng")] :: [(Text, Text)]) ==#> [text| + { + hi: + , foo: + a + b + , bar: a + , baz: + a + g + } + |] + + describe "tuples" $ do + it "tupleF" $ do + -- we don't need complicated tests here, they're all tested in + -- 'tupleLikeF' tests + tupleF (n, s) ==#> "(25, !)" + tupleF (n, s, n, s) ==#> "(25, !, 25, !)" + tupleF (n, s, n, s, 'a', 'b', 'c', 'd') ==#> + "(25, !, 25, !, a, b, c, d)" + describe "tupleLikeF" $ do + describe "one-line" $ do + it "()" $ do + tupleLikeF [] ==#> "()" + it "('')" $ do + tupleLikeF [""] ==#> "()" + it "(a)" $ do + tupleLikeF ["a"] ==#> "(a)" + it "(a,b)" $ do + tupleLikeF ["a", "b"] ==#> "(a, b)" + it "(a,'')" $ do + tupleLikeF ["a", ""] ==#> "(a, )" + it "('',b)" $ do + tupleLikeF ["", "b"] ==#> "(, b)" + it "('','')" $ do + tupleLikeF ["", ""] ==#> "(, )" + it "(a,b,c)" $ do + tupleLikeF ["a", "ba", "caba"] ==#> "(a, ba, caba)" + it "weird case" $ do + -- not sure whether I should fix it or not + tupleLikeF ["a\n"] ==#> "(a\n)" + describe "multiline" $ do + describe "all non-empty" $ do + it "1 element (2 lines)" $ do + tupleLikeF ["a\nx"] ==#> [text| + ( a + x ) + |] + tupleLikeF ["a\n x"] ==#> [text| + ( a + x ) + |] + tupleLikeF [" a\nx\n"] ==#> [text| + ( a + x ) + |] + it "1 element (3 lines)" $ do + tupleLikeF ["a\nb\nc"] ==#> [text| + ( a + b + c ) + |] + it "2 elements (1 line + 2 lines)" $ do + tupleLikeF ["a", "b\nc"] ==#> [text| + ( a + , + b + c ) + |] + it "2 elements (2 lines + 1 line)" $ do + tupleLikeF ["a\nb", "c"] ==#> [text| + ( a + b + , + c ) + |] + it "3 elements (each has 2 lines)" $ do + tupleLikeF ["a\nb", "c\nd", "e\nf"] ==#> [text| + ( a + b + , + c + d + , + e + f ) + |] + describe "some empty" $ do + it "2 elements (0 + 2)" $ do + tupleLikeF ["", "a\nb"] ==#> [text| + ( + , + a + b ) + |] + it "2 elements (2 + 0)" $ do + tupleLikeF ["a\nb", ""] ==#> [text| + ( a + b + , + ) + |] + it "3 elements (0 + 2 + 0)" $ do + tupleLikeF ["", "a\nb", ""] ==#> [text| + ( + , + a + b + , + ) + |] + it "3 elements (2 + 0 + 2)" $ do + tupleLikeF ["a\nb", "", "c\nd"] ==#> [text| + ( a + b + , + , + c + d ) + |] + it "4 elements (2 + 0 + 0 + 2)" $ do + tupleLikeF ["a\nb", "", "", "c\nd"] ==#> [text| + ( a + b + , + , + , + c + d ) + |] + + describe "ADTs" $ do + it "maybeF" $ do + maybeF (Nothing :: Maybe Int) ==#> "" + maybeF (Just 3 :: Maybe Int) ==#> "3" + it "eitherF" $ do + eitherF (Left 1 :: Either Int Int) ==#> ": 1" + eitherF (Right 1 :: Either Int Int) ==#> ": 1" + + describe "padding" $ do + it "prefixF" $ do + prefixF (-1) ("hello" :: Text) ==#> "" + prefixF 0 ("hello" :: Text) ==#> "" + prefixF 1 ("hello" :: Text) ==#> "h" + prefixF 2 ("hello" :: Text) ==#> "he" + prefixF 3 ("hello" :: Text) ==#> "hel" + prefixF 5 ("hello" :: Text) ==#> "hello" + prefixF 1000 ("hello" :: Text) ==#> "hello" + prefixF 1000 ("" :: Text) ==#> "" + it "suffixF" $ do + suffixF (-1) ("hello" :: Text) ==#> "" + suffixF 0 ("hello" :: Text) ==#> "" + suffixF 1 ("hello" :: Text) ==#> "o" + suffixF 2 ("hello" :: Text) ==#> "lo" + suffixF 3 ("hello" :: Text) ==#> "llo" + suffixF 5 ("hello" :: Text) ==#> "hello" + suffixF 1000 ("hello" :: Text) ==#> "hello" + suffixF 1000 ("" :: Text) ==#> "" + it "padLeftF" $ do + padLeftF (-1) '!' ("hello" :: Text) ==#> "hello" + padLeftF 0 '!' ("hello" :: Text) ==#> "hello" + padLeftF 1 '!' ("hello" :: Text) ==#> "hello" + padLeftF 5 '!' ("hello" :: Text) ==#> "hello" + padLeftF 6 '!' ("hello" :: Text) ==#> "!hello" + padLeftF 7 '!' ("hello" :: Text) ==#> "!!hello" + padLeftF 7 '!' ("" :: Text) ==#> "!!!!!!!" + it "padRightF" $ do + padRightF (-1) '!' ("hello" :: Text) ==#> "hello" + padRightF 0 '!' ("hello" :: Text) ==#> "hello" + padRightF 1 '!' ("hello" :: Text) ==#> "hello" + padRightF 5 '!' ("hello" :: Text) ==#> "hello" + padRightF 6 '!' ("hello" :: Text) ==#> "hello!" + padRightF 7 '!' ("hello" :: Text) ==#> "hello!!" + padRightF 7 '!' ("" :: Text) ==#> "!!!!!!!" + it "padCenterF" $ do + padCenterF (-1) '!' ("hello" :: Text) ==#> "hello" + padCenterF 0 '!' ("hello" :: Text) ==#> "hello" + padCenterF 1 '!' ("hello" :: Text) ==#> "hello" + padCenterF 5 '!' ("hello" :: Text) ==#> "hello" + padCenterF 6 '!' ("hello" :: Text) ==#> "!hello" + padCenterF 7 '!' ("hello" :: Text) ==#> "!hello!" + padCenterF 7 '!' ("hell" :: Text) ==#> "!!hell!" + padCenterF 7 '!' ("hel" :: Text) ==#> "!!hel!!" + padCenterF 8 '!' ("hell" :: Text) ==#> "!!hell!!" + padCenterF 8 '!' ("hel" :: Text) ==#> "!!!hel!!" + padCenterF 8 '!' ("" :: Text) ==#> "!!!!!!!!" + + describe "integer" $ do + it "octF" $ do + octF n ==#> "31" + it "binF" $ do + binF n ==#> "11001" + it "baseF" $ do + baseF 36 (n^n) ==#> "54kbbzw21jhueg5jb0ggr4p" + it "-baseF" $ do + baseF 36 (-(n^n)) ==#> "-54kbbzw21jhueg5jb0ggr4p" + + describe "floating-point" $ do + let f1_3 = 1.2999999999999998 :: Double + it "floatF" $ do + floatF f1_3 ==#> "1.2999999999999998" + it "exptF" $ do + exptF 2 f1_3 ==#> "1.30e0" + it "fixedF" $ do + fixedF 2 f1_3 ==#> "1.30" + it "precF" $ do + precF 2 f1_3 ==#> "1.3" + + describe "conditionals" $ do + it "whenF" $ do + whenF True "hi" ==#> "hi" + whenF False "hi" ==#> "" + it "unlessF" $ do + unlessF True "hi" ==#> "" + unlessF False "hi" ==#> "hi" + + describe "'hexF'" $ do + it "Int" $ do + hexF n ==#> "19" + it "-Int" $ do + hexF (-n) ==#> "-19" + it "strict ByteString" $ do + hexF (BS.pack [15,250]) ==#> "0ffa" + it "lazy ByteString" $ do + hexF (BSL.pack [15,250]) ==#> "0ffa" + ---------------------------------------------------------------------------- -- Utilities ---------------------------------------------------------------------------- (==%>) :: Text -> Text -> Expectation (==%>) = shouldBe + +(==#>) :: Builder -> Text -> Expectation +(==#>) a b = a `shouldBe` build (T.replace "_" " " b)