diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,15 @@ +# 0.1.0.0 + +* Added `genericF` for formatting arbitrary data. + +* Changed `%<` and `>%` to `#|` and `|#` because they turn out to be easier to type. + +* Added a migration guide from `formatting`. + +* Changed output of `eitherF`. + +* Added bechmarks. + # 0.0.0.4 * Added `format` from `text-format`, because in some cases it's nicer than brackets. diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +-- | Benchmarks for @fmt@ library. + +module Main where + +import Control.DeepSeq (NFData) +import Data.Monoid ((<>)) +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 Formatting (Format, formatToString, int, sformat, stext, + string, (%)) +import Text.Printf (printf) + +import Criterion (Benchmark, bench, bgroup, nf) +import Criterion.Main (defaultMain) + +---------------------------------------------------------------------------- +-- 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 + +tshow :: Show a => a -> Text +tshow x = T.pack (show x) + +---------------------------------------------------------------------------- +-- Benchmarks utility functions +---------------------------------------------------------------------------- + +bGenericStringGroup :: NFData s => String -> a -> [(String, a -> s)] -> Benchmark +bGenericStringGroup sTag benchObj = + bgroup sTag . map (\(tag, howToFmt) -> bench tag (nf howToFmt benchObj)) +{-# INLINE bGenericStringGroup #-} + +bTextGroup :: a -> [(String, a -> Text)] -> Benchmark +bTextGroup = bGenericStringGroup "text" +{-# INLINE bTextGroup #-} + +bStringGroup :: a -> [(String, a -> String)] -> Benchmark +bStringGroup = bGenericStringGroup "string" +{-# INLINE bStringGroup #-} + +-- Function for convenience instead of using manual @(,)@. +taggedB :: String -> (a -> b) -> (String, a -> b) +taggedB = (,) + +---------------------------------------------------------------------------- +-- Benchmakrs themselves +---------------------------------------------------------------------------- + +main :: IO () +main = defaultMain + [ bgroup "simple" + [ bTextGroup (1 :: Int, 2 :: Int) + [ taggedB "fmt" $ + \(a,b) -> "hello "#|a|#" world "#|b|#"" + , 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" $ + \(a,b) -> "hello " <> tshow a <> " world " <> tshow b + , taggedB "printf" $ + \(a,b) -> T.pack $ printf "hello %d world %d" a b + ] + , bStringGroup (1 :: Int, 2 :: Int) + [ taggedB "fmt" $ + \(a,b) -> "hello "#|a|#" world "#|b|#"" + , 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" $ + \(a,b) -> "hello " ++ show a ++ " world " ++ show b + , taggedB "printf" $ + \(a,b) -> printf "hello %d world %d" a b + ] + ] + + , bgroup "readme" + [ bTextGroup (9 :: Int, "Beijing" :: Text) + [ taggedB "fmt" $ + \(n,city) -> "There are "#|n|#" million bicycles in "#|city|#"." + , 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" $ + \(n,city) -> "There are " <> tshow n <> " million bicycles in " <> city <> "." + , taggedB "printf" $ + \(n,city) -> T.pack $ printf "There are %d million bicycles in %s." n city + ] + , bStringGroup (9 :: Int, "Beijing" :: String) + [ taggedB "fmt" $ + \(n,city) -> "There are "#|n|#" million bicycles in "#|city|#"." + , 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" $ + \(n,city) -> "There are " ++ show n ++ " million bicycles in " ++ city ++ "." + , taggedB "printf" $ + \(n,city) -> printf "There are %d million bicycles in %s." n city + ] + ] + ] diff --git a/fmt.cabal b/fmt.cabal --- a/fmt.cabal +++ b/fmt.cabal @@ -1,15 +1,49 @@ name: fmt -version: 0.0.0.4 -synopsis: Nice formatting library +version: 0.1.0.0 +synopsis: A new formatting library description: - Nice formatting library + A new formatting library that tries to be simple to understand while still + being powerful and providing more convenience features than other libraries + (like functions for pretty-printing maps and lists, or a function for + printing arbitrary datatypes using generics). + . + A comparison with other libraries: + . + * @printf@ (from @Text.Printf@) takes a formatting string and uses some + type tricks to accept the rest of the arguments polyvariadically. It's + very concise, but there are some drawbacks – it can't produce @Text@ + (you'd have to @T.pack@ it every time) and it doesn't warn you at + compile-time if you pass wrong arguments or not enough of them. + . + * takes a + formatting string with angle brackets 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 + runtime, but at least the formatters are first-class (and you can add new + ones). + . + * takes a + formatting template consisting of pieces of strings interleaved with + formatters; this ensures that arguments always match their placeholders. + @formatting@ provides lots of formatters and generally seems to be the + most popular formatting library here. Unfortunately, at least in my + experience writing new formatters can be awkward and people sometimes + have troubles understanding how @formatting@ works. + . + * (i.e. this library) + provides formatters that are ordinary functions, and a bunch of operators + for concatenating formatted strings; those operators also do automatic + conversion. There are some convenience formatters which aren't present in + @formatting@ (like ones for formatting maps, lists, converting to base64, + etc). Some find the operator syntax annoying, while others like it. homepage: http://github.com/aelve/fmt bug-reports: http://github.com/aelve/fmt/issues license: BSD3 license-file: LICENSE author: Artyom maintainer: yom@artyom.me --- copyright: +-- copyright: category: Text tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 build-type: Simple @@ -27,6 +61,7 @@ base16-bytestring, base64-bytestring, bytestring, + containers, microlens >= 0.3, text, text-format >= 0.3 @@ -47,6 +82,26 @@ , vector ghc-options: -Wall -fno-warn-unused-do-bind hs-source-dirs: tests + default-language: Haskell2010 + if impl(ghc < 7.10) + buildable: False + +benchmark benches + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Main.hs + build-depends: base >=4.6 && <5 + , bytestring + , containers + , criterion + , deepseq + , fmt + , formatting + , interpolate + , text + , text-format + , vector + ghc-options: -Wall 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 @@ -18,6 +18,8 @@ -} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} @@ -25,6 +27,19 @@ {-# 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 @@ -33,20 +48,26 @@ -- * Examples -- $examples + -- * Migration guide from @formatting@ + -- $migration + -- * Basic formatting -- $brackets -- ** Ordinary brackets - (%<), - (>%), + -- $god1 + (#|), + (|#), -- ** 'Show' brackets - (%<<), - (>>%), + -- $god2 + (#||), + (||#), -- ** Combinations - (>%%<), - (>>%%<<), - (>%%<<), - (>>%%<), + -- $god3 + (|##|), + (||##||), + (|##||), + (||##|), -- * Old-style formatting format, @@ -113,6 +134,9 @@ -- ** Conditional formatting whenF, unlessF, + + -- ** Generic formatting + genericF, ) where @@ -120,6 +144,15 @@ 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.Lazy as TL -- 'Buildable' and text-format @@ -134,11 +167,17 @@ 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 @@ -163,12 +202,12 @@ 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: "#|a|#", "#|b|#"\nAlso a number: "#|n|#"") :: String "Here are some words: foo, bar\nAlso a number: 25" Print it: ->>> fmtLn ("Here are some words: "%%", "%%"\nAlso a number: "%%"") +>>> fmtLn ("Here are some words: "#|a|#", "#|b|#"\nAlso a number: "#|n|#"") Here are some words: foo, bar Also a number: 25 @@ -176,16 +215,16 @@ >>> let xs = ["John", "Bob"] ->>> fmtLn ("Using show: "%<>%"\nUsing listF: "%%"") +>>> fmtLn ("Using show: "#||xs||#"\nUsing listF: "#|listF xs|#"") Using show: ["John","Bob"] Using listF: [John, Bob] ->>> fmt ("YAML-like:\n"%%"") +>>> fmt ("YAML-like:\n"#|blockListF xs|#"") YAML-like: - John - Bob ->>> fmt ("JSON-like: "%%"") +>>> fmt ("JSON-like: "#|jsonListF xs|#"") JSON-like: [ John , Bob @@ -193,28 +232,91 @@ -} +{- $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@) +* formatters that deal with time (anything from @Formatting.Time@) + +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 ('>%'): +To format strings, put variables between ('#|') and ('|#'): >>> let name = "Alice" ->>> "Meet "%%"!" :: String +>>> "Meet "#|name|#"!" :: String "Meet Alice!" Of course, 'Text' is supported as well: ->>> "Meet "%%"!" :: Text +>>> "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 "%%"!") +>>> fmtLn ("Meet "#|name|#"!") Meet Alice! Otherwise the type of the formatted string would be resolved to @IO ()@ and @@ -224,110 +326,152 @@ @ main = do [fin, fout] \<- words \<$\> getArgs - __"Reading data from "%\%"\\n"__ + __"Reading data from "\#|fin|\#"\\n"__ xs \<- readFile fin - __"Writing processed data to "%\%"\\n"__ + __"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 ('>%'): +characters and dates, can be put between ('#|') and ('|#'): >>> let starCount = "173" ->>> fmtLn ("Meet "%%"! She's got "%%" stars on Github.") +>>> 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 +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") +>>> 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: "%%"") +>>> 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: "%%"") +>>> fmtLn ("Character's position: "#|tupleF pos|#"") Character's position: (3, 5) -Finally, for convenience there's the ('>%%<') operator, which can be used if +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 (""%%%%%%" = "%%"") +>>> 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' +'Buildable', there are operators ('#||') and ('||#'), which use 'show' instead of 'build': @ -(""%\%%\%"") === (""%\<\\>%%\<\\>%"") +__(""\#|show foo|\#\#|show bar|\#"")__ === __(""\#||foo||\#\#||bar||\#"")__ @ -} -(%<) :: (FromBuilder b) => Builder -> Builder -> b -(%<) str rest = fromBuilder (str <> rest) +-- $god1 +-- Operators for the operators god! -(>%) :: (Buildable a, FromBuilder b) => a -> Builder -> b -(>%) a rest = fromBuilder (build a <> rest) +-- | Concatenate, then convert +(#|) :: (FromBuilder b) => Builder -> Builder -> b +(#|) str rest = fromBuilder (str <> rest) -(>%%<) :: (Buildable a, FromBuilder b) => a -> Builder -> b -(>%%<) a rest = fromBuilder (build a <> rest) +-- | 'build' and concatenate, then convert +(|#) :: (Buildable a, FromBuilder b) => a -> Builder -> b +(|#) a rest = fromBuilder (build a <> rest) -infixr 1 %< -infixr 1 >% -infixr 1 >%%< +infixr 1 #| +infixr 1 |# ---------------------------------------------------------------------------- -- Operators with 'Show' ---------------------------------------------------------------------------- -(%<<) :: (FromBuilder b) => Builder -> Builder -> b -(%<<) str rest = str %< rest -{-# INLINE (%<<) #-} +-- $god2 +-- More operators for the operators god! -(>>%) :: (Show a, FromBuilder b) => a -> Builder -> b -(>>%) a rest = show a >% rest -{-# INLINE (>>%) #-} +-- | Concatenate, then convert +(#||) :: (FromBuilder b) => Builder -> Builder -> b +(#||) str rest = str #| rest +{-# INLINE (#||) #-} -(>>%%<<) :: (Show a, FromBuilder b) => a -> Builder -> b -(>>%%<<) a rest = show a >% rest -{-# INLINE (>>%%<<) #-} +-- | 'show' and concatenate, then convert +(||#) :: (Show a, FromBuilder b) => a -> Builder -> b +(||#) a rest = show a |# rest +{-# INLINE (||#) #-} -infixr 1 %<< -infixr 1 >>% -infixr 1 >>%%<< +infixr 1 #|| +infixr 1 ||# ---------------------------------------------------------------------------- -- Combinations ---------------------------------------------------------------------------- -(>>%%<) :: (Buildable a, FromBuilder b) => a -> Builder -> b -(>>%%<) a rest = a >%%< rest -{-# INLINE (>>%%<) #-} +{- $god3 -(>%%<<) :: (Show a, FromBuilder b) => a -> Builder -> b -(>%%<<) a rest = a >>%%<< rest -{-# INLINE (>%%<<) #-} +Z̸͠A̵̕͟͠L̡̀́͠G̶̛O͝ ̴͏̀ I͞S̸̸̢͠  ̢̛͘͢C̷͟͡Ó̧̨̧͞M̡͘͟͞I̷͜N̷̕G̷̀̕ -infixr 1 >>%%< -infixr 1 >%%<< +(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). + +To provide substitution arguments, use a tuple: + +>>> format "{} + {} = {}" (2, 2, 4) +"2 + 2 = 4" + +You can use arbitrary formatters: + +>>> format "0x{} + 0x{} = 0x{}" (hexF 130, hexF 270, hexF (130+270)) +"2 + 2 = 4" + +To provide just one argument, use a list instead of a tuple: + +>>> format "Hello {}!" ["world"] +"Hello world!" +-} format :: (FromBuilder b, TF.Params ps) => TF.Format -> ps -> b format f ps = fromBuilder (TF.build f ps) {-# INLINE format #-} +{- | Like 'format', but adds a newline. +-} formatLn :: (FromBuilder b, TF.Params ps) => TF.Format -> ps -> b formatLn f ps = fromBuilder (TF.build f ps <> "\n") {-# INLINE formatLn #-} @@ -338,8 +482,8 @@ {- | '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 +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. @@ -436,7 +580,7 @@ It automatically handles multiline list elements: @ ->>> fmt $ blockListF ["hello\nworld", "foo\nbar\nquix"] +>>> __fmt $ blockListF ["hello\\nworld", "foo\\nbar\\nquix"]__ - hello world @@ -650,27 +794,6 @@ -- 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 @@ -748,8 +871,8 @@ -- ADT formatters ---------------------------------------------------------------------------- -{- | -Like 'build' for 'Maybe', but displays 'Nothing' as @@ instead of an empty string. +{- | Like 'build' for 'Maybe', but displays 'Nothing' as @\@ instead +of an empty string. 'build': @@ -772,10 +895,11 @@ Format an 'Either': >>> eitherF (Right 1) -": 1" +"" -} eitherF :: (Buildable a, Buildable b) => Either a b -> Builder -eitherF = either (\x -> ": " <> build x) (\x -> ": " <> build x) +eitherF = either (\x -> " build x <> ">") + (\x -> " build x <> ">") ---------------------------------------------------------------------------- -- Other formatters @@ -940,13 +1064,13 @@ For small numbers, it uses scientific notation for everything smaller than 1e-6: -> listF' (precF 3) [1e-5,1e-6,1e-7] +>>> 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] +>>> listF' (precF 4) [1e3,5e3,1e4] "[1000, 5000, 1.000e4]" -} precF :: Real a => Int -> a -> Builder @@ -969,14 +1093,14 @@ Display something only if the condition is 'True' (empty string otherwise). @ ->>> "Hello!" <> whenF showDetails (", details: "%%"") +>>> __"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: +unusable with ('#|')-formatted strings which can resolve to any 'FromBuilder'). Thus, use 'fmt' if you need just one value: @ ->>> "Maybe here's a number: "%%"" +>>> __"Maybe here's a number: "\#|whenF cond (fmt n)|\#""__ @ -} whenF :: Bool -> Builder -> Builder @@ -1015,61 +1139,217 @@ spaces = TL.replicate (fromIntegral n) (TL.singleton ' ') ---------------------------------------------------------------------------- --- TODOs +-- Generic formatting ---------------------------------------------------------------------------- -{- add these: +{- | Format an arbitrary value without requiring a 'Buildable' instance: -* 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 +@ +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])) + + +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 -{- list/map: +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' _ = "" + +instance _OVERLAPPABLE_ Buildable a => Buildable' a where + build' = build + +---------------------------------------------------------------------------- +-- TODOs +---------------------------------------------------------------------------- + +{- 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 -} {- docs - +~~~~~~~~~~~~~~~~~~~~ * write explicitly that 'build' can be used and is useful sometimes -* 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, +* 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”) +* write that it can be used in parallel with formatting? can it, actually? * clarify what exactly is hard about writing `formatting` formatters -} {- others - -* 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 >|? also <% and %> are good +~~~~~~~~~~~~~~~~~~~~ * 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/Internal.hs b/lib/Fmt/Internal.hs --- a/lib/Fmt/Internal.hs +++ b/lib/Fmt/Internal.hs @@ -18,7 +18,13 @@ FromBuilder(..), FormatAsHex(..), FormatAsBase64(..), + TupleF(..), + -- * Classes used for 'genericF' + GBuildable(..), + GetFields(..), + Buildable'(..), + -- * Helpers groupInt, atBase, @@ -59,6 +65,7 @@ ---------------------------------------------------------------------------- class FromBuilder a where + -- | Convert a 'Builder' to something else. fromBuilder :: Builder -> a instance FromBuilder Builder where @@ -91,6 +98,8 @@ >>> hexF 3635 "e33" +>>> hexF ("\0\50\63\80" :: BS.ByteString) +"00323f50" -} hexF :: a -> Builder @@ -138,6 +147,47 @@ 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 + +---------------------------------------------------------------------------- -- Helpers ---------------------------------------------------------------------------- @@ -177,7 +227,10 @@ | i >= 10 && i < 36 = chr (ord 'a' + i - 10) | otherwise = error ("intToDigit': Invalid int " ++ show i) --- assumes that the prefix doesn't contain newlines +{- | 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. +-} indent' :: Int -> T.Text -> Builder -> Builder indent' n pref a = case TL.lines (toLazyText a) of [] -> fromText pref <> "\n" diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE -OverloadedStrings, -QuasiQuotes - #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE DeriveGeneric #-} module Main where @@ -21,6 +20,8 @@ import Data.Map (Map) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL +-- Generics +import GHC.Generics -- Tests import Test.Hspec @@ -28,81 +29,246 @@ import Fmt +---------------------------------------------------------------------------- +-- Constants for testing (to avoid “ambiguous type” errors) +---------------------------------------------------------------------------- + +n :: Integer +n = 25 + +s :: String +s = "!" + +---------------------------------------------------------------------------- +-- List of tests +---------------------------------------------------------------------------- + main :: IO () main = hspec $ do - let n = 25 :: Integer - s = "!" :: String + test_operators + test_outputTypes + describe "formatters" $ do + test_indent + test_baseConversion + test_floatingPoint + test_hex + test_ADTs + test_conditionals + test_padding + test_lists + test_maps + test_tuples + test_generic +---------------------------------------------------------------------------- +-- Testing that operators work (when used as intended) +---------------------------------------------------------------------------- + +test_operators :: Spec +test_operators = do it "simple examples" $ do - ("a"%%"b") ==%> "a25b" - ("a"%%"b"%%"") ==%> "a25b!" - (""%%%%"") ==%> "25!" - (""%%%%"") ==%> "-25!" - (""%%%%"") ==%> "25!" + ("a"#|n|#"b") ==%> "a25b" + ("a"#|n|#"b"#|s|#"") ==%> "a25b!" + (""#|n|##|s|#"") ==%> "25!" + (""#|negate n|##|s|#"") ==%> "-25!" + (""#|Just n|##|s|#"") ==%> "25!" describe "examples with Show/mixed" $ do it "copy of Buildable examples" $ do - ("a"%<>%"b") ==%> "a25b" - ("a"%<>%%<>%"b") ==%> "a2525b" + ("a"#||n||#"b") ==%> "a25b" + ("a"#||n||##||n||#"b") ==%> "a2525b" -- These are mixed, i.e. both Buildable and Show versions are used - ("a"%<>%"b"%%"") ==%> "a25b!" - (""%<>%%%"") ==%> "25!" - (""%<>%%%"") ==%> "-25!" + ("a"#||n||#"b"#|s|#"") ==%> "a25b!" + (""#||n||##|s|#"") ==%> "25!" + (""#||negate n||##|s|#"") ==%> "-25!" it "examples that don't work with Buildable" $ do - (""%<>%"") ==%> "Just 25" - (""%<<(n,n)>>%"") ==%> "(25,25)" + (""#||Just n||#"") ==%> "Just 25" + (""#||(n,n)||#"") ==%> "(25,25)" it "plays nice with other operators" $ do -- If precedence is bad these won't compile - (""%%%%"") ==%> "2426" - (id $ ""%%%%"") ==%> "2426" + (""#|n-1|##|n+1|#"") ==%> "2426" + (id $ ""#|n-1|##|n+1|#"") ==%> "2426" it "works with <>" $ do - ("number: "%%"\n"<> - "string: "%%"") ==%> "number: 25\nstring: !" + ("number: "#|n|#"\n"<> + "string: "#|s|#"") ==%> "number: 25\nstring: !" - describe "output as" $ do - it "String" $ - ("a"%%"b" :: String) `shouldBe` "a25b" - it "Text" $ - ("a"%%"b" :: Text) `shouldBe` "a25b" - it "Lazy Text" $ - ("a"%%"b" :: TL.Text) `shouldBe` "a25b" - it "Builder" $ - ("a"%%"b" :: Builder) `shouldBe` "a25b" +---------------------------------------------------------------------------- +-- Testing that different output types work +---------------------------------------------------------------------------- +test_outputTypes :: Spec +test_outputTypes = describe "output as" $ do + it "String" $ + ("a"#|n|#"b" :: String) `shouldBe` "a25b" + it "Text" $ + ("a"#|n|#"b" :: Text) `shouldBe` "a25b" + it "Lazy Text" $ + ("a"#|n|#"b" :: TL.Text) `shouldBe` "a25b" + it "Builder" $ + ("a"#|n|#"b" :: Builder) `shouldBe` "a25b" - describe "formatters" $ do - describe "'indent'" $ do - it "simple examples" $ do - indent 0 "hi" ==#> "hi\n" - indent 0 "\nhi\n\n" ==#> "\nhi\n\n" - indent 2 "hi" ==#> " hi\n" - indent 2 "hi\n" ==#> " hi\n" - indent 2 "" ==#> " \n" - indent 2 "hi\nbye" ==#> " hi\n bye\n" - 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\n" +---------------------------------------------------------------------------- +-- Tests for various simple formatters +---------------------------------------------------------------------------- - 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]" +test_indent :: Spec +test_indent = describe "'indent'" $ do + it "simple examples" $ do + indent 0 "hi" ==#> "hi\n" + indent 0 "\nhi\n\n" ==#> "\nhi\n\n" + indent 2 "hi" ==#> " hi\n" + indent 2 "hi\n" ==#> " hi\n" + indent 2 "" ==#> " \n" + indent 2 "hi\nbye" ==#> " hi\n bye\n" + indent 2 "hi\nbye\n" ==#> " hi\n bye\n" + it "formatting a block" $ do + ("Some numbers:\n"<> + indent 2 ( + "odd: "#|n|#"\n"<> + "even: "#|n+1|#"")) ==#> "Some numbers:\n odd: 25\n even: 26\n" - describe "'blockListF'" $ do - it "empty list" $ do +test_baseConversion :: Spec +test_baseConversion = describe "conversion to bases" $ 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" + +test_floatingPoint :: Spec +test_floatingPoint = 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" + +test_hex :: Spec +test_hex = 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" + +test_ADTs :: Spec +test_ADTs = 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) ==#> "" + eitherF (Right 1 :: Either Int Int) ==#> "" + +test_conditionals :: Spec +test_conditionals = describe "conditionals" $ do + it "whenF" $ do + whenF True "hi" ==#> "hi" + whenF False "hi" ==#> "" + it "unlessF" $ do + unlessF True "hi" ==#> "" + unlessF False "hi" ==#> "hi" + +---------------------------------------------------------------------------- +-- Tests for padding +---------------------------------------------------------------------------- + +test_padding :: Spec +test_padding = 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 "padBothF" $ do + padBothF (-1) '!' ("hello" :: Text) ==#> "hello" + padBothF 0 '!' ("hello" :: Text) ==#> "hello" + padBothF 1 '!' ("hello" :: Text) ==#> "hello" + padBothF 5 '!' ("hello" :: Text) ==#> "hello" + padBothF 6 '!' ("hello" :: Text) ==#> "!hello" + padBothF 7 '!' ("hello" :: Text) ==#> "!hello!" + padBothF 7 '!' ("hell" :: Text) ==#> "!!hell!" + padBothF 7 '!' ("hel" :: Text) ==#> "!!hel!!" + padBothF 8 '!' ("hell" :: Text) ==#> "!!hell!!" + padBothF 8 '!' ("hel" :: Text) ==#> "!!!hel!!" + padBothF 8 '!' ("" :: Text) ==#> "!!!!!!!!" + +---------------------------------------------------------------------------- +-- Tests for lists +---------------------------------------------------------------------------- + +test_lists :: Spec +test_lists = describe "lists" $ do + test_listF + test_blockListF + test_jsonListF + +test_listF :: Spec +test_listF = 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]" + +test_blockListF :: Spec +test_blockListF = describe "'blockListF'" $ do + emptyList + nullElements + singleLineElements + multiLineElements + mixed + + where + emptyList = it "empty list" $ do blockListF ([] :: [Int]) ==#> "[]\n" - it "null elements" $ do + + nullElements = it "null elements" $ do blockListF ([""] :: [Text]) ==#> [text| - |] @@ -115,7 +281,8 @@ - a - |] - it "single-line elements" $ do + + singleLineElements = it "single-line elements" $ do blockListF (["a"] :: [Text]) ==#> [text| - a |] @@ -128,7 +295,8 @@ - b - ccc |] - it "multi-line elements" $ do + + multiLineElements = it "multi-line elements" $ do blockListF (["a\nx"] :: [Text]) ==#> [text| - a x @@ -148,7 +316,8 @@ - c __ |] - it "mix of single-line and multi-line" $ do + + mixed = it "mix of single-line and multi-line" $ do blockListF (["a\nx","b"] :: [Text]) ==#> [text| - a x @@ -171,10 +340,20 @@ - c __ |] - describe "'jsonListF'" $ do - it "empty list" $ do + +test_jsonListF :: Spec +test_jsonListF = describe "'jsonListF'" $ do + emptyList + nullElements + singleLineElements + multiLineElements + mixed + + where + emptyList = it "empty list" $ do jsonListF ([] :: [Int]) ==#> "[]\n" - it "null elements" $ do + + nullElements = it "null elements" $ do jsonListF ([""] :: [Text]) ==#> [text| [ @@ -193,7 +372,8 @@ , ] |] - it "single-line elements" $ do + + singleLineElements = it "single-line elements" $ do jsonListF (["a"] :: [Text]) ==#> [text| [ a @@ -212,7 +392,8 @@ , ccc ] |] - it "multi-line elements" $ do + + multiLineElements = it "multi-line elements" $ do jsonListF (["a\nx"] :: [Text]) ==#> [text| [ a @@ -236,7 +417,8 @@ __ ] |] - it "mix of single-line and multi-line" $ do + + mixed = it "mix of single-line and multi-line" $ do jsonListF (["a\nx","b"] :: [Text]) ==#> [text| [ a @@ -262,269 +444,269 @@ ] |] - 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}" +---------------------------------------------------------------------------- +-- Tests for maps +---------------------------------------------------------------------------- - 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 - |] +test_maps :: Spec +test_maps = describe "maps" $ do + test_mapF + test_blockMapF + test_jsonMapF - 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 - } - |] +test_mapF :: Spec +test_mapF = 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 "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 ) - |] +test_blockMapF :: Spec +test_blockMapF = 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 "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" +test_jsonMapF :: Spec +test_jsonMapF = 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 "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 "padBothF" $ do - padBothF (-1) '!' ("hello" :: Text) ==#> "hello" - padBothF 0 '!' ("hello" :: Text) ==#> "hello" - padBothF 1 '!' ("hello" :: Text) ==#> "hello" - padBothF 5 '!' ("hello" :: Text) ==#> "hello" - padBothF 6 '!' ("hello" :: Text) ==#> "!hello" - padBothF 7 '!' ("hello" :: Text) ==#> "!hello!" - padBothF 7 '!' ("hell" :: Text) ==#> "!!hell!" - padBothF 7 '!' ("hel" :: Text) ==#> "!!hel!!" - padBothF 8 '!' ("hell" :: Text) ==#> "!!hell!!" - padBothF 8 '!' ("hel" :: Text) ==#> "!!!hel!!" - padBothF 8 '!' ("" :: Text) ==#> "!!!!!!!!" +---------------------------------------------------------------------------- +-- Tests for tuples +---------------------------------------------------------------------------- - 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" +test_tuples :: Spec +test_tuples = describe "tuples" $ do + test_tupleSimple + describe "tupleLikeF" $ do + test_tupleOneLine + test_tupleMultiline - 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" +test_tupleSimple :: Spec +test_tupleSimple = 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 "conditionals" $ do - it "whenF" $ do - whenF True "hi" ==#> "hi" - whenF False "hi" ==#> "" - it "unlessF" $ do - unlessF True "hi" ==#> "" - unlessF False "hi" ==#> "hi" +test_tupleOneLine :: Spec +test_tupleOneLine = 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)" - 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" +test_tupleMultiline :: Spec +test_tupleMultiline = describe "multiline" $ do + allNonEmpty + someEmpty + it "weird case" $ do + -- not sure whether I should fix it or not + tupleLikeF ["a\n"] ==#> "(a\n)" + + where + allNonEmpty = 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 ) + |] + + someEmpty = 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 ) + |] + +---------------------------------------------------------------------------- +-- Tests for 'genericF' +---------------------------------------------------------------------------- + +data Foo a = Foo a deriving Generic +data Bar a = Bar a a deriving Generic +data Qux a = Qux {q1 :: Int, q2 :: a, q3 :: Text} deriving Generic + +data Op = (:|:) Int + | (:||:) Int Int + | (:|||:) Int Int Int + | Int :-: Int + | Int `O` Int + deriving Generic + +test_generic :: Spec +test_generic = describe "'genericF'" $ do + it "Maybe" $ do + genericF (Nothing :: Maybe Int) ==#> "Nothing" + genericF (Just 25 :: Maybe Int) ==#> "" + it "Either" $ do + genericF (Left 25 :: Either Int Bool) ==#> "" + genericF (Right True :: Either Int Bool) ==#> "" + it "tuples" $ do + genericF (n, s) ==#> "(25, !)" + genericF (n, s, -n, s ++ s) ==#> "(25, !, -25, !!)" + describe "custom types" $ do + it "ordinary constructors" $ do + genericF (Foo n) ==#> "" + genericF (Bar (n-1) (n+1)) ==#> "" + it "records" $ do + genericF (Qux 1 True "hi") ==#> [text| + Qux: + q1: 1 + q2: True + q3: hi + |] + it "operators and infix constructors" $ do + genericF ((:|:) 1) ==#> "<(:|:): 1>" + genericF ((:||:) 1 2) ==#> "<(:||:): 1, 2>" + genericF ((:|||:) 1 2 3) ==#> "<(:|||:): 1, 2, 3>" + genericF ((:-:) 1 2) ==#> "(1 :-: 2)" + genericF (O 1 2) ==#> "(1 `O` 2)" + describe "types with non-Buildables inside" $ do + it "functions" $ do + genericF (Foo not) ==#> ">" + it "lists" $ do + genericF (Foo [n, n+1]) ==#> "" + it "maps" $ do + genericF (Foo (M.singleton n s)) ==#> "" + it "tuples" $ do + genericF (Foo (n, s)) ==#> "" + genericF (Foo (n, s, n+1)) ==#> "" + it "tuple with a string inside" $ do + -- strings have to be handled differently from lists + -- so we test this case separately + genericF (Foo (n, s)) ==#> "" + it "Either" $ do + genericF (Foo (Left 25 :: Either Int Int)) ==#> ">" + it "Maybe with a non-buildable" $ do + genericF (Foo (Just [n])) ==#> "" + genericF (Foo (Nothing :: Maybe ())) ==#> ">" ---------------------------------------------------------------------------- -- Utilities