diff --git a/Data/Prednote/Expressions/RPN.hs b/Data/Prednote/Expressions/RPN.hs --- a/Data/Prednote/Expressions/RPN.hs +++ b/Data/Prednote/Expressions/RPN.hs @@ -73,7 +73,7 @@ xs -> Ex.throw $ "bad expression: multiple operands left on the stack:\n" <> ( X.concat - . map C.chunkText + . map C._text . concatMap (P.showPdct 4 0) $ xs ) diff --git a/Data/Prednote/Pdct.hs b/Data/Prednote/Pdct.hs --- a/Data/Prednote/Pdct.hs +++ b/Data/Prednote/Pdct.hs @@ -65,8 +65,8 @@ import Data.Text (Text) import qualified Data.Text as X import Data.Monoid ((<>), mconcat, mempty) +import Data.String (fromString) import qualified System.Console.Rainbow as R -import System.Console.Rainbow ((+.+)) import Prelude hiding (not, and, or, compare, filter) import qualified Prelude @@ -78,7 +78,7 @@ instance Show (Pdct a) where show = X.unpack . X.concat - . map R.chunkText + . map R._text . showPdct 2 0 -- | Renames the top level of the Pdct. The function you pass will be @@ -189,39 +189,43 @@ indent :: IndentAmt -> Level -> [R.Chunk] -> [R.Chunk] indent amt lvl cs = idt : (cs ++ [nl]) where - idt = R.plain (X.replicate (lvl * amt) " ") - nl = R.plain (X.singleton '\n') + idt = fromString (replicate (lvl * amt) ' ') + nl = fromString "\n" +-- | Creates a plain Chunk from a Text. +plain :: Text -> R.Chunk +plain = R.Chunk mempty + -- | Shows a Pdct tree without evaluating it. showPdct :: IndentAmt -> Level -> Pdct a -> [R.Chunk] showPdct amt lvl (Pdct l pd) = case pd of - And ls -> indent amt lvl [R.plain l] + And ls -> indent amt lvl [plain l] <> mconcat (map (showPdct amt (lvl + 1)) ls) - Or ls -> indent amt lvl [R.plain l] + Or ls -> indent amt lvl [plain l] <> mconcat (map (showPdct amt (lvl + 1)) ls) - Not t -> indent amt lvl [R.plain l] + Not t -> indent amt lvl [plain l] <> showPdct amt (lvl + 1) t - NeverFalse t -> indent amt lvl [R.plain l] + NeverFalse t -> indent amt lvl [plain l] <> showPdct amt (lvl + 1) t - NeverTrue t -> indent amt lvl [R.plain l] + NeverTrue t -> indent amt lvl [plain l] <> showPdct amt (lvl + 1) t - Operand _ -> indent amt lvl [R.plain l] + Operand _ -> indent amt lvl [plain l] labelBool :: Text -> Maybe Bool -> [R.Chunk] labelBool t b = [open, trueFalse, close, blank, txt] where trueFalse = case b of - Nothing -> R.plain "discard" +.+ R.f_yellow + Nothing -> "discard" <> R.f_yellow Just bl -> if bl - then R.plain "TRUE" +.+ R.f_green - else R.plain "FALSE" +.+ R.f_red - open = R.plain "[" - close = R.plain "]" - blank = R.plain (X.replicate blankLen " ") + then "TRUE" <> R.f_green + else "FALSE" <> R.f_red + open = "[" + close = "]" + blank = plain (X.replicate blankLen " ") blankLen = X.length "discard" - - X.length (R.chunkText trueFalse) + 1 - txt = R.plain t + - X.length (R._text trueFalse) + 1 + txt = plain t type ShowDiscards = Bool @@ -310,7 +314,7 @@ go (x:xs) (fndFalse, acc) = if fndFalse then (fndFalse, acc <> indent i l - [R.plain "(short circuit)"]) + [plain "(short circuit)"]) else let (res, cTxt) = evaluate i sd a l x fndFalse' = maybe False Prelude.not res in go xs (fndFalse', acc <> cTxt) @@ -324,7 +328,7 @@ go (x:xs) (fnd, acc) = if fnd then (fnd, acc <> indent i l - [R.plain "(short circuit)"]) + [plain "(short circuit)"]) else let (res, cTxt) = evaluate i sd a l x fnd' = fromMaybe False res in go xs (fnd', acc <> cTxt) diff --git a/Data/Prednote/TestTree.hs b/Data/Prednote/TestTree.hs --- a/Data/Prednote/TestTree.hs +++ b/Data/Prednote/TestTree.hs @@ -93,13 +93,12 @@ import Data.Either (rights) import Data.Maybe (isJust) import Data.List (unfoldr) -import Data.Monoid ((<>)) +import Data.Monoid ((<>), mempty) import qualified Data.Text as X import Data.Text (Text) import qualified Data.List.Split as Sp import qualified System.Console.Rainbow as R -import System.Console.Rainbow ((+.+)) import qualified Data.Prednote.Pdct as Pt -- @@ -206,19 +205,23 @@ Discards -> (True, True) +-- | Creates a plain Chunk from a Text. +plain :: X.Text -> R.Chunk +plain = R.Chunk mempty + showTestTitle :: Pt.IndentAmt -> Pt.Level -> Name -> Pass -> [R.Chunk] showTestTitle i l n p = [idt, open, passFail, close, blank, txt, nl] where - idt = R.plain (X.replicate (i * l) " ") - nl = R.plain "\n" + idt = plain (X.replicate (i * l) " ") + nl = plain "\n" passFail = if p - then R.plain "PASS" +.+ R.f_green - else R.plain "FAIL" +.+ R.f_red - open = R.plain "[" - close = R.plain "]" - blank = R.plain (X.singleton ' ') - txt = R.plain n + then "PASS" <> R.f_green + else "FAIL" <> R.f_red + open = plain "[" + close = plain "]" + blank = plain (X.singleton ' ') + txt = plain n isTrue :: Maybe Bool -> Bool isTrue = maybe False id @@ -270,19 +273,19 @@ . concat $ resultList indent :: Pt.IndentAmt -> Pt.Level -> Text -> R.Chunk -indent amt lvl t = R.plain txt +indent amt lvl t = plain txt where txt = X.concat [spaces, t, "\n"] spaces = X.replicate (amt * lvl) " " skip :: Text -> Pt.IndentAmt -> Pt.Level -> Text -> [R.Chunk] skip lbl amt lvl t = - [ R.plain (X.replicate (amt * lvl) " ") - , R.plain "[" - , R.plain ("skip " <> lbl) +.+ R.f_yellow - , R.plain "] " - , R.plain t - , R.plain "\n" + [ plain (X.replicate (amt * lvl) " ") + , plain "[" + , plain ("skip " <> lbl) <> R.f_yellow + , plain "] " + , plain t + , plain "\n" ] -- | Shows a tree, without evaluating it. @@ -379,11 +382,11 @@ rslts = concat . map snd $ ls groupNm = if tGroupVerbosity ee /= NoGroups then indent (tIndentAmt ee) l n - else R.plain "" + else plain "" in (stop, Left [groupNm] : rslts) else let groupNm = if tGroupVerbosity ee == AllGroups then skip "group" (tIndentAmt ee) l n - else [R.plain ""] + else [plain ""] in (False, [Left groupNm]) diff --git a/prednote.cabal b/prednote.cabal --- a/prednote.cabal +++ b/prednote.cabal @@ -1,5 +1,5 @@ name: prednote -version: 0.8.0.0 +version: 0.10.0.0 synopsis: Build and evaluate trees of predicates description: Build and evaluate trees of predicates. For example, you might build @@ -37,7 +37,7 @@ build-depends: base >= 4.6 && < 5 , explicit-exception ==0.1.* - , rainbow ==0.2.* + , rainbow ==0.4.* , split ==0.2.* , text == 0.11.*