diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,14 @@ # Revision history for sayable +## 1.2.0.0 -- 2023-10-01 + +* Changed `&+*` and `&!+*` to `&:*` and `&!:*` to avoid confusion with normal `+` + indication of concatenation. +* Added `&+*` which acts like `&*` but does not add a space separator relative to + the preceding output. +* Added `&+?` operator to show an immediate adjacent `Just` value. +* Added various tests. + ## 1.1.1.0 -- 2023-06-20 * Add Haddock documentation showing examples for operators. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,139 @@ +This module provides a set of data structures, classes, and operators that +facilitate the construction of a Prettyprinter `Doc` object. + +# Motivation + +Standard prettyprinting is a monotonic conversion that does not allow for +customization for different uses or environments. For example, when debugging, +full and explicit information about a structure should be generated, but for +checkpoint logging, a simple overview is usually more appropriate. + +This library provides for an additional type parameter that can be used to +control the conversion to a suitably verbose Prettyprinter Doc representation. + +This is also highly useful in conjunction with logging to generate successively +more verbose information as the logging verbosity increases. + +## Usage + +Typical usage is to create a sayable message using the operators defined here and +then extract Prettyprinter `Doc` from the saying and convert it to a printable +format (here, simply using `show` for the default Prettyprinter rendering). + +``` +import qualified Prettyprinter as PP + +foo :: Members '[ Logging SayMessage, Config ] r -> a -> b -> Eff r [b] +foo arg1 arg2 = + do putStrLn $ show $ saying $ sayable @info "Entering foo with" &- arg1 &- "and" &- arg2 + rslt <- something arg1 arg2 + case rslt of + Right vals -> + do putStrLn $ show $ saying $ sayable @"verbose" + $ "Foo successfully returning" &% length vals &- "results:" &- vals + return vals + Left err -> + do putStrLn $ show $ saying $ sayable @"error" + $ "Foo error (" &- arg1 &- PP.comma &- arg2 &- ") is" &- err + throwError err +``` + +There are three messages printed: one on entry and one on either the success or +failure paths. Each message may have different levels of information reported +for the various arguments. + +## The `saytag` type parameter + +Each sayable message uses a `TypeApplication` to specify a `saytag` which should +be used for controlling the rendering of that message. This parameter is +polykinded to provide maximum flexibility, but the most common kind is `Symbol` +(e.g. `"info"`, `"verbose"`, `"error"`, etc.). + +Another frequent kind used for the `saytag` is `GHC.TypeNats.Nat`, allowing for +an ordering of saytag types. However be aware that any instance constraints +(e.g. `saytag <= 9`) are only resolved __after__ the instance head is matched, so +if the constraints do not match no other instances will be tried an an error is +generated. Thus, rather than use constraints for selecting between instances, +the maximum value for each "range" should be an instance, along with the minimum +extremum: + +``` +instance {-# OVERLAPPING #-} Sayable (9::Nat) Foo where sayable f = ...[sayable for 9+] +instance {-# OVERLAPPING #-} Sayable (3::Nat) Foo where sayable f = ...[sayable for 3-8] +instance {-# OVERLAPPING #-} Sayable (0::Nat) Foo where sayable f = ...[sayable for 0-2] +instance {-# OVERLAPPABLE #-} (0 <= prevVer, prevVer ~ (ver - 1), Sayable prevVer Foo) + => Sayable ver Foo where + sayable = Saying . saying . sayable @Nat @prevVer +``` + +As a developer, it is encouraged to use whatever saytag makes sense relative to +the current context and type of information being processed. Most of this +documentation will use the preferred `Symbol` kind for the `saytag`. + +== Individual Arguments + +The arguments passed to the sayable should be instances of the `Sayable` class. +There are a number of standard instances of `Sayable`, but an instance can be +declared for any object that might be output. The `Sayable` class has two class +parameters: the second is object to be converted, and the first is the "saytag". +This allows different Sayable instances for an object to be used in different +saytag scenarios. For example: + +``` +import Network.URL + +instance Sayable "verbose" URL where + sayable url = + let newline = PP.line :: PP.Doc SayableAnn + prettyShow x = PP.viaShow x :: PP.Doc SayableAnn + in "URL {" + &- "url_type=" &- prettyShow (url_type url) &- newline + &- "url_path=" &- url_path url &- newline + &- "url_params=" &* url_params url + &- "}" +instance Sayable saytag URL where + sayable = Sayable . PP.viaShow . exportURL +``` + +The above would cause a url emitted via a "verbose" saytag to be +expanded into a report on each individual field, whereas all other +saytags would simply output the `exportURL` representation of the `URL`. + +``` +>>> let host = Host (HTTP True) "github.com" Nothing +>>> url' = URL (Absolute host) "by/one" +>>> saying $ sayable @"verbose" url' +URL { url_type= Absolute (Host {protocol = HTTP True, host= "github.com", port= Nothing}) + url_path= by/one + url_params= } +>>> saying @"info" $ sayable url' +https://github.com:442/by/one +``` + +Note that there are several pre-declared `Sayable` instances for common +datatypes for convenience. + +== Operators + +In the logging lines above, there are several operators used, each of which +starts with the `&` character. These are described in detail in the 'Helper +operators' section below, but the general mnemonic for these is: + + * A dash is a space between sayable elements + + * A plus is immediately adjacent sayable elements + + * A colon is a separator specification + + * An asterisk is applied to a foldable (i.e. a list) + + * A percent sign preceeds a Pretty object + + * An exclamation follows a Pretty function, which is applied to the following + argument. + + * A question mark is followed by a Maybe, with no output for a Nothing + + * A less-than character means newline (i.e. return to the left) + +These characters will be combined for operators with combination effects. diff --git a/Text/Sayable.hs b/Text/Sayable.hs --- a/Text/Sayable.hs +++ b/Text/Sayable.hs @@ -1,7 +1,8 @@ {- | Module: Text.Sayable -This module provides a set of data structures, classes, and operators that facilitate the construction of a Prettyprinter Doc object. +This module provides a set of data structures, classes, and operators that +facilitate the construction of a Prettyprinter Doc object. = Motivation @@ -40,12 +41,13 @@ throwError err @ -[Note: if viewing via Haddock HTML, the '@' in front of @"info"@, +[Note: if viewing via Haddock HTML, the ampersand in front of @"info"@, @"verbose"@, and @"error"@ on the putStrLn lines above may not be visible.] There are three messages printed: one on entry and one on either the success or -failure paths. Each message may have different levels of information reported for the various arguments. +failure paths. Each message may have different levels of information reported +for the various arguments. == The @saytag@ type parameter @@ -100,126 +102,30 @@ == Operators -In the logging lines above, there are three operators used, each of -which starts with the @&@ character: +In the logging lines above, there are several operators used, each of which +starts with the @&@ character. These are described in detail in the 'Helper +operators' section below, but the general mnemonic for these is: - ['&-'] This is the standard operator that takes two Sayable - arguments and converts them to their Sayable form, then - combining them (with an intervening space). This is the - standard argument to use for building the output message from - distinct parts. + * A dash is elements separated by a space - >>> sez @"info" $ t'"hello" &- t'"world" - "hello world" + * A plus indicates immediately adjacent elements - ['&+'] This is a variation of the standard '&-' operator that has no - intervening space between the two arguments that are - converted to a Sayable form. + * A colon is designates a separator - >>> sez @"info" $ t'"hello" &+ t'"world" - "helloworld" + * An asterisk is applied to a foldable (i.e. a list) - ['&%'] This is a variation of the standard '&-' operator that only - requires the second argument to be an instances of - Prettyprinter.Pretty instead of an instance of 'Sayable', - which can be convenient and avoids the need to define large - numbers of 'Sayable' instances. + * A percent sign preceeds a Pretty object - >>> sez @"info" $ t'"hello" &% (t'"world", t'"!") - "hello (world, !)" + * An exclamation follows a Pretty function, which is applied to the following + argument. - ['&*'] This is a helper operator whose second argument is a - 'Foldable' series of 'Sayable' elements. This will fold over - the series, adding the 'Sayable' instance value for each - element separated by commas. + * A question mark is followed by a Maybe, with no output for a Nothing - >>> sez @"info" $ t'"three:" &* [1, 2, 3::Int] - "three: 1, 2, 3" + * A less-than character means newline (i.e. return to the left) - ['&+*'] This is similar to the '&*' helper, but it uses the first - argument as the separator between the elements of the - 'Foldable' second argument (instead of the ", " default used - by the '&*' helper). +These characters will be combined for operators with combination effects. - >>> sez @"info" $ t'"three:" &- t'".." &+* [1, 2, 3::Int] - "three: 1..2..3" - ['&?'] This is a helper operator whose second argument is a @Maybe - a@ (where @a@ is a @Showable@). This will emit the - @Showable@ of @a@ if the argument is a 'Just' value, or - nothing (an empty Text Showable) if the argument is a - 'Nothing' value. - - >>> sez @"info" $ t'"It's" &? Just (t'"something") &- t'"or" &? (Nothing :: Maybe Text) - "It's something or" - - ['&<'] This is a helper operator that generates a newline between its two - arguments. - - >>> sez @"info" $ t'"Hello" &< t'"world" - "Hello\nworld" - - ['&<*'] This is a helper operator that combines the '&<' and '&*' operators: it - generates a newline between its two arguments and the second argument - is a Foldable that will be output separated by commas. - - >>> sez @"info" $ t'"three:" &<* [1, 2, 3::Int] - "three:\n1, 2, 3" - - ['&>> sez @"info" $ t'"First" &>> sez @"info" $ t'"Then" &>> sez @"info" $ PP.group &! t'"hi" - "hi" - - ['&!?'] This helper operator is a combination of the '&!' operator and the '&?' - operator: for a second-argument 'Just' value it will convert the value - to a sayable and then apply the Prettyprinter conversion operator - first-argument. - - >>> sez @"info" $ PP.group &!? Just (t'"hi") - "hi" - - ['&!*'] This helper operator is a combination of the '&!' operator - and the '&*' operator: it applies the first argument (a - @[PrettyPrinter.Doc ann] -> PrettyPrinter.Doc ann@ function) - to the foldable collection represented by the second - argument. - - >>> sez @"info" $ t'"three:" &- PP.align . PP.vsep &!* [1, 2, 3::Int] - "three: 1, \n 2, \n 3" - - ['&!$*'] This helper operator is a combination of the '&!' operator and the - '&*' operator: it applies the first argument (a @PrettyPrinter.Doc ann - -> PrettyPrinter.Doc ann@ function) to the *result* of a foldable - collection represented by the second argument. It is similar to the - '&!*' operator except that it applies the Prettyprinter conversion to - the singular result of the list rather than to the list of results. - - >>> sez @"info" $ t'"three:" &- PP.align &!$* [1, 2, 3::Int] - "three: 1, 2, 3" - - ['&!+*'] This helper operator is a combination of the '&!' operator and the - '&+*' operator (and is a trinary rather than a binary operator): it - applies the first argument (a @[PrettyPrinter.Doc ann] -> - PrettyPrinter.Doc ann@ function) to the foldable collection - represented by the third argument, using the second argument to - specify the separators between the elements. - - >>> sez @"info" $ t'"three:" &- (PP.align . PP.vsep &!+* (t'" or")) [1, 2, 3::Int] - "three: 1 or\n 2 or\n 3" - == Convenience/other * This module also provides an instance to convert a Sayable back @@ -435,7 +341,9 @@ , (&%) , (&*) , (&+*) + , (&:*) , (&?) + , (&+?) , (&<) , (&<*) , (&>> sez @"info" $ t'"hello" &- t'"world" +-- "hello world" +-- (&-) :: forall saytag m n . (Sayable saytag m, Sayable saytag n) => m -> n -> Saying saytag m &- n = sayable m <> sayable n @@ -557,6 +469,10 @@ -- a Saying by placing the two Sayable items immediately adjacent with -- no intervening spaces. This is the high-density version of the -- more common '&-' operator. +-- +-- >>> sez @"info" $ t'"hello" &+ t'"world" +-- "helloworld" +-- (&+) :: forall saytag m n . (Sayable saytag m, Sayable saytag n) => m -> n -> Saying saytag m &+ n = Saying $ (saying $ sayable @saytag m) <> (saying $ sayable @saytag n) @@ -566,6 +482,10 @@ -- Pretty item into a Saying. This is infrequently used and primarily -- allows the composition of a data object which has a "Prettyprinter" -- instance but no 'Sayable' instance. +-- +-- >>> sez @"info" $ t'"hello" &% (t'"world", t'"!") +-- "hello (world, !)" +-- (&%) :: (Sayable tag m, PP.Pretty n) => m -> n -> Saying tag m &% n = sayable m <> sayable (PP.pretty n :: PP.Doc SayableAnn) infixl 1 &% @@ -573,11 +493,15 @@ -- | A helper operator to /apply/ a "Prettyprinter" (@Doc ann -> Doc -- ann@) function (the first argument) to the Sayable in the second -- argument. This is different from the '&%' operator in that the --- former uses 'Prettyprinter.hsep' to join two independent +-- former uses 'Prettyprinter.hcat' to join two independent -- 'Prettyprinter.Doc' 'Saying' values, whereas this operator applies -- a transformation (e.g. @Prettyprinter.annotate AnnValue@ or -- @Prettyprinter.align . Prettyprinter.group@) to the -- 'Prettyprinter.Doc' in the second 'Saying' argument. +-- +-- >>> sez @"info" $ PP.group &! t'"hi" +-- "hi" +-- (&!) :: forall tag m . Sayable tag m => (PP.Doc SayableAnn -> PP.Doc SayableAnn) -> m -> Saying tag pf &! m = Saying $ pf $ saying $ sayable @tag m @@ -594,6 +518,12 @@ -- folding over a tuple only returns the 'snd' value of a tuple. -- Consider wrapping tuples in a newtype with an explicit Sayable to -- avoid this. +-- +-- >>> sez @"info" $ t'"three:" &* [1, 2, 3::Int] +-- "three: 1, 2, 3" +-- +-- If the second argument is a null collection then no output is generated for +-- it. (&*) :: forall tag m e t . (Sayable tag m, Sayable tag e, Foldable t) => m -> t e -> Saying tag m &* l = let addElem e (s, Saying p) = @@ -601,30 +531,50 @@ in sayable m <> (snd $ foldr addElem ("", Saying PP.emptyDoc) l) infixl 1 &* +-- | A helper operator that generates a sayable from a foldable group (e.g. list) +-- of sayable items. This helper is linke the '&*' operator except that the +-- folded output is immediately adjacent to the preceeding sayable output instead +-- of separated by a space; this is useful for situations where the folded output +-- has delimiters like parentheses or brackets. +-- +-- >>> sez @"info" $ t'"three:" &- '(' &+* [1,2,3::Int] &+ ')' +-- "three: (1, 2, 3)" +-- +-- If the second argument is an empty collection then no output is generated for +-- it. --- | A helper operator that generates a sayable from a list of sayable --- items, separated by the first sayable (&+*) :: forall tag m e t + . (Sayable tag m, Sayable tag e, Foldable t) => m -> t e -> Saying tag +m &+* l = let addElem e (s, Saying p) = + ("," <> PP.softline, Saying $ saying (sayable @tag e) <> s <> p) + in Saying (saying (sayable @tag m) + <> saying (snd $ foldr addElem ("", Saying PP.emptyDoc) l)) +infixl 1 &+* + +-- | A helper operator that generates a sayable from a list of sayable items, +-- separated by the first sayable argument (instead of the ", " that use used by +-- the '&*' operator). +-- +-- >>> sez @"info" $ t'"three:" &- t'".." &:* [1, 2, 3::Int] +-- "three: 1..2..3" +-- +(&:*) :: forall tag m e t . (Sayable tag m, Sayable tag e, Foldable t) => m -> t e -> Saying tag -m &+* l = let addElem e (s, Saying p) = (Just m, +m &:* l = let addElem e (s, Saying p) = (Just m, case s of Nothing -> sayable @tag e &+ p Just s' -> sayable @tag e &+ s' &+ p ) in snd $ foldr addElem (Nothing, Saying PP.emptyDoc) l -infixl 2 &+* - +infixl 2 &:* --- | A helper operator that applies the first argument which converts an array of --- 'Prettyprinter.Doc ann' elements to a single 'PrettyPrinter.Doc ann' element --- to the second argument, which is a Foldable collection of 'Sayable' items. --- This is essentially a combination of the '&!' and '&*' operators where the --- first operation takes the list of doc items and returns a single item. +-- | A helper operator that is a combination of the '&!' and '&*' operators. It +-- applies the first argument (which converts an array of 'Prettyprinter.Doc ann' +-- elements into a single 'PrettyPrinter.Doc ann' element) to the second argument +-- (which is a Foldable collection of 'Sayable' items). -- --- > import qualified Prettyprinter as PP --- > --- > putStrLn $ sez @"info" $ t'"The stooges are" &- PP.hsep &!* ["Larry", "Mo", "Curly"] --- The stooges are Larry Mo Curly +-- >>> sez @"info" $ t'"three:" &- PP.align . PP.vsep &!* [1, 2, 3::Int] +-- "three: 1, \n 2, \n 3" -- (&!*) :: forall tag m t . (Sayable tag m, Foldable t) @@ -640,6 +590,14 @@ -- items. This is essentially a combination of the '&!' and '&*' operators where -- the first operation is applied to the entire list, rather than each element of -- the list (as with `&!*`). +-- +-- >>> sez @"info" $ t'"three:" &- PP.align &!$* [1, 2, 3::Int] +-- "three: 1, 2, 3" +-- +-- As with the '&!*' operator (and unlike the '&*' operator), a null collection +-- is passed to the converter first argument. +-- +-- @since: 1.1.0.0 (&!$*) :: forall tag m t . (Sayable tag m, Foldable t) => (PP.Doc SayableAnn -> PP.Doc SayableAnn) -> t m -> Saying tag @@ -649,11 +607,11 @@ infixl 2 &!$* --- | A helper operator that applies the first argument which converts +-- | A helper operator that applies the first argument (which converts -- an array of 'Prettyprinter.Doc ann' elements to a single --- 'PrettyPrinter.Doc ann' element to the second argument, which is a +-- 'PrettyPrinter.Doc ann' element) to the second argument, which is a -- Foldable collection of 'Sayable' items. This is essentially a --- combination of the '&!' and '&+*' operators. +-- combination of the '&!' and '&:*' operators. -- -- Unlike the other operators defined in this package, this is a trinary operator -- rather than a binary operator. Because function application (whitespace) is @@ -661,20 +619,18 @@ -- to prevent applying the second argument to the third argument before applying -- this operator. -- --- > import qualified Prettyprinter as PP --- > --- > putStrLn $ sez @"info" $ PP.fillSep &!+* t'" and " $ ["one", "two", "three"] --- one and two and three +-- >>> sez @"info" $ t'"three:" &- (PP.align . PP.vsep &!:* (t'" or")) [1, 2, 3::Int] +-- "three: 1 or\n 2 or\n 3" -- -(&!+*) :: forall tag m t b . (Sayable tag b, Sayable tag m, Foldable t) +(&!:*) :: forall tag m t b . (Sayable tag b, Sayable tag m, Foldable t) => ([PP.Doc SayableAnn] -> PP.Doc SayableAnn) -> b -> t m -> Saying tag -pf &!+* b = let addElem e (s, p) = +pf &!:* b = let addElem e (s, p) = (Just b, (case s of Nothing -> saying (sayable @tag e) Just x -> saying (sayable @tag e &+ x) ) : p) in Saying . pf . snd . foldr addElem (Nothing, []) -infixl 2 &!+* +infixl 2 &!:* -- | A helper operator allowing a Sayable item to be wrapped in a @@ -682,26 +638,42 @@ -- 'Sayable' of the second argument in the 'Just' case, or just emits -- the 'Sayable' of the first argument if the second argument is -- 'Nothing'. +-- +-- >>> sez @"info" $ t'"It's" &? Just (t'"something") &- t'"or" &? (Nothing :: Maybe Text) +-- "It's something or" +-- (&?) :: forall tag m e . (Sayable tag m, Sayable tag e) => m -> Maybe e -> Saying tag m &? Nothing = sayable m m &? (Just a) = sayable m <> sayable a infixl 1 &? + -- | A helper operator allowing a Sayable item to be wrapped in a 'Maybe' and a -- prettyprinter conversion as the first argument. This is a combination of the -- `&!` and `&?` operators. +-- +-- >>> sez @"info" $ PP.group &!? Just (t'"hi") +-- "hi" +-- +-- @since: 1.1.0.0 (&!?) :: forall tag e . (Sayable tag e) => (PP.Doc SayableAnn -> PP.Doc SayableAnn) -> Maybe e -> Saying tag _ &!? Nothing = Saying mempty pf &!? (Just a) = Saying $ pf $ saying $ sayable @tag a infixl 1 &!? + -- | A helper operator that generates a newline between its two arguments. Many -- times the '&-' operator is a better choice to allow normal prettyprinter -- layout capabilities, but in situations where it is known that multiple lines -- will or should be generated, this operator makes it easy to separate the -- lines. +-- +-- >>> sez @"info" $ t'"Hello" &< t'"world" +-- "Hello\nworld" +-- +-- @since: 1.1.0.0 (&<) :: forall saytag m n . (Sayable saytag m, Sayable saytag n) => m -> n -> Saying saytag m &< n = Saying @@ -710,9 +682,15 @@ <> (saying $ sayable @saytag n) infixl 1 &< + -- | A helper operator that combines '&<' and '&*' which will generate a newline -- between its two arguments, where the second argument is a foldable collection -- whose elements will be sayable emitted with comma separators. +-- +-- >>> sez @"info" $ t'"three:" &<* [1, 2, 3::Int] +-- "three:\n1, 2, 3" +-- +-- @since: 1.1.0.0 (&<*) :: forall saytag m n t . (Sayable saytag m, Sayable saytag n, Foldable t) => m -> t n -> Saying saytag m &<* n = let addElem e (s, Saying p) = @@ -724,9 +702,17 @@ (snd $ foldr addElem ("", Saying PP.emptyDoc) n)) infixl 1 &<* + -- | A helper operator that emits the first argument and optionally emits a -- newline and the 'Just' value of the second argument if the second argument is --- not 'Nothing' +-- not 'Nothing' (a combination of the '&<' and '&?' operators). +-- +-- >>> sez @"info" $ t'"First" &>> sez @"info" $ t'"Then" & m -> Maybe n -> Saying saytag m &>> sez @"info" $ t'"It's" &+? Nothing &- t'"ok" &+? Just "time" +-- "It's oktime" +-- +-- @since: 1.2.0.0 +(&+?) :: forall saytag m n . (Sayable saytag m, Sayable saytag n) + => m -> Maybe n -> Saying saytag +m &+? Nothing = sayable m +m &+? (Just n) = Saying + $ (saying $ sayable @saytag m) + <> (saying $ sayable @saytag n) +infixl 1 &+? + + +-- | A helper function to use when @OverloadedStrings@ is active to identify the +-- following quoted literal as a "Data.Text" object. It is common to enable +-- OverloadedStrings because 'Prettyprinter.Pretty' declares an 'Data.String.IsString' +-- instance and thus facilitates the pretty-printing of string values, but this +-- causes GHC to emit warnings about assuming the types of strings, so this +-- function can be used to clarify the intended type. +-- +-- >>> putStrLn $ t'"This is type: Data.Text" +-- "This is type: Data.Text" +-- t' :: Text -> Text t' = id {-# INLINE t' #-} diff --git a/sayable.cabal b/sayable.cabal --- a/sayable.cabal +++ b/sayable.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: sayable -version: 1.1.1.0 +version: 1.2.0.0 synopsis: Data structures, classes and operators for constructing context-adjusted pretty output description: . @@ -21,6 +21,7 @@ category: Text build-type: Simple extra-doc-files: CHANGELOG.md + README.md tested-with: GHC == 9.6.2, GHC == 9.4.5, GHC == 9.2.7, GHC == 9.0.2, GHC == 8.10.7, GHC == 8.8.4 source-repository head @@ -48,3 +49,18 @@ , bytestring , text , prettyprinter + +test-suite sayableTests + import: bldspec + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Test.hs + build-depends: base + , hspec + , prettyprinter + , sayable + , tasty >= 1.4 && < 1.5 + , tasty-ant-xml >= 1.1 && < 1.2 + , tasty-hspec >= 1.2 && < 1.3 + , text diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +import Data.Text ( Text ) +import qualified Prettyprinter as PP +import Text.Sayable + +import Test.Hspec +import Test.Tasty +import Test.Tasty.Hspec +import Test.Tasty.Runners.AntXML + + +main :: IO () +main = tests >>= defaultMainWithIngredients (antXMLRunner : defaultIngredients) + +tests :: IO TestTree +tests = testGroup "Sayable" <$> sequence + [ + testSpec "Operators" $ + describe "operator results shown in haddocks" $ do + it "renders &-" $ + (sez @"info" $ t'"hello" &- t'"world") `shouldBe` "hello world" + it "renders &+" $ + (sez @"info" $ t'"hello" &+ t'"world") `shouldBe` "helloworld" + it "renders &%" $ + (sez @"info" $ t'"hello" &% (t'"world", t'"!")) `shouldBe` "hello (world, !)" + it "renders &!" $ + (sez @"info" $ PP.group &! t'"hi") `shouldBe` "hi" + it "renders &*" $ + (sez @"info" $ t'"three:" &* [1, 2, 3::Int]) `shouldBe` "three: 1, 2, 3" + it "renders &+*" $ + (sez @"info" $ t'"three:" &- '(' &+* [1, 2, 3::Int] &+ ')') + `shouldBe` "three: (1, 2, 3)" + it "renders &:*" $ + (sez @"info" $ t'"three:" &- t'".." &:* [1, 2, 3::Int]) + `shouldBe` "three: 1..2..3" + it "renders &!*" $ + (sez @"info" $ t'"three:" &- PP.align . PP.vsep &!* [1, 2, 3::Int]) + `shouldBe` "three: 1, \n 2, \n 3" + it "renders &!$*" $ + (sez @"info" $ t'"three:" &- PP.align &!$* [1, 2, 3::Int]) + `shouldBe` "three: 1, 2, 3" + it "renders &!:*" $ + (sez @"info" $ t'"three:" &- (PP.align . PP.vsep &!:* (t'" or")) [1, 2, 3::Int]) + `shouldBe` "three: 1 or\n 2 or\n 3" + it "renders &?" $ + (sez @"info" $ t'"It's" &? Just (t'"something") &- t'"or" &? (Nothing :: Maybe Text)) + `shouldBe` "It's something or" + it "renders &!?" $ + (sez @"info" $ PP.group &!? Just (t'"hi")) `shouldBe` "hi" + it "renders &<" $ + (sez @"info" $ t'"Hello" &< t'"world") `shouldBe` "Hello\nworld" + it "renders &<*" $ + (sez @"info" $ t'"three:" &<* [1, 2, 3::Int]) `shouldBe` "three:\n1, 2, 3" + it "renders &