predicate-typed 0.7.0.0 → 0.7.1.0

raw patch · 14 files changed

+593/−244 lines, 14 filesdep ~thesePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: these

API changes (from Hackage documentation)

Files

• predicate-typed.cabal +5/−5
• src/Predicate/Core.hs +35/−32
• src/Predicate/Examples/Refined1.hs +0/−1
• src/Predicate/Examples/Refined2.hs +1/−3
• src/Predicate/Examples/Refined3.hs +1/−3
• src/Predicate/Prelude.hs +206/−15
• src/Predicate/Refined.hs +54/−31
• src/Predicate/Refined1.hs +36/−10
• src/Predicate/Refined2.hs +77/−7
• src/Predicate/Refined3.hs +34/−11
• src/Predicate/Util.hs +144/−118
• test/TestRefined.hs +0/−4
• test/TestRefined2.hs +0/−2
• test/TestRefined3.hs +0/−2

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 50c224873b64d409685fdae3dead9b051e87bbe0a62f23783507eda242b4884d+-- hash: ce8bf201dfcc67f4335c139afa9cb860348bc6b07daa4e34ac23aff8db72dad2  name:           predicate-typed-version:        0.7.0.0+version:        0.7.1.0 synopsis:       Predicates, Refinement types and Dsl description:    Please see the README on GitHub at <https://github.com/gbwey/predicate-typed#readme> category:       Data@@ -66,7 +66,7 @@     , template-haskell     , text     , th-lift-    , these+    , these >=0.8     , time     , tree-view >=0.5   if impl(ghc >= 8.8)@@ -119,7 +119,7 @@     , template-haskell     , text     , th-lift-    , these+    , these >=0.8     , time     , tree-view >=0.5   if impl(ghc >= 8.8)@@ -166,7 +166,7 @@     , template-haskell     , text     , th-lift-    , these+    , these >=0.8     , time     , tree-view >=0.5   if impl(ghc >= 8.8)

@@ -45,7 +45,7 @@   , runPQBool
   , evalBool
   , evalQuick
-  , prtTree'
+  , prtTree
   ) where
 import Predicate.Util
 import GHC.TypeLits (Symbol,Nat,KnownSymbol,KnownNat)
@@ -72,7 +72,6 @@ evalQuick :: forall p i . P p i => i -> Either String (PP p i)
 evalQuick i = getValLRFromTT (runIdentity (eval (Proxy @p) (getOptT @'OL) i))
 
-
 -- | identity function
 --
 -- >>> pz @I 23
@@ -510,7 +509,7 @@       Nothing -> pure $ mkNode opts (FailT (msg0 <> " found Nothing")) (msg0 <> " found Nothing") []
 
 -- | expects Nothing otherwise it fails
--- if the value is Nothing then it returns \'Proxy a\' as this provides more information than '()'
+-- if the value is Nothing then it returns \'Proxy a\' as this provides type information
 --
 -- >>> pz @'Nothing Nothing
 -- PresentT Proxy
@@ -677,6 +676,30 @@     let b = Proxy @a
     in pure $ mkNode opts (PresentT b) ("'Proxy" <> show1 opts " | " a) []
 
+-- | typelevel 'BoolT'
+--
+-- >>> pz @'TrueT ()
+-- TrueT
+--
+-- >>> pz @'FalseT ()
+-- FalseT
+--
+-- >>> pz @('PresentT 123) ()
+-- PresentT False
+--
+-- >>> pz @('FailT '[]) ()
+-- FailT "'FailT _"
+--
+instance GetBoolT x b => P (b :: BoolT x) a where
+  type PP b a = Bool
+  eval _ opts _ = do
+    let msg0 = "'BoolT"
+    let ret = getBoolT @x @b
+    pure $ case ret of
+      Left b -> mkNodeB opts b (if b then "TrueT" else "FalseT") []
+      Right True -> mkNode opts (PresentT False) (msg0 <> " PresentT") []
+      Right False -> mkNode opts (FailT "'FailT _") (msg0 <> " FailT") []
+
 pan, pa, pu, pl, pz, pab, pub :: forall p a . (Show (PP p a), P p a) => a -> IO (BoolT (PP p a))
 -- | skips the evaluation tree and just displays the end result
 pz = run @'OZ @p
@@ -694,9 +717,13 @@ -- @
 pu = run @'OU @p
 -- | displays the evaluation tree using unicode and colors with background colors
--- | displays the evaluation tree using background colors
 pub = run @'OUB @p
 
+-- | evaluate a typelevel expression (use type applications to pass in the options and the expression)
+--
+-- >>> run @'OZ @Id 123
+-- PresentT 123
+--
 run :: forall opts p a
         . ( OptTC opts
           , Show (PP p a)
@@ -707,17 +734,17 @@   let opts = getOptT @opts
   pp <- eval (Proxy @p) opts a
   let r = pp ^. tBool
-  putStr $ prtTree' opts pp
+  putStr $ prtTree opts pp
   return r
 
-prtTree' :: Show x => POpts -> TT x -> String
-prtTree' opts pp =
+prtTree :: Show x => POpts -> TT x -> String
+prtTree opts pp =
   let r = pp ^. tBool
   in case oDebug opts of
        DZero -> ""
        DLite ->
              formatOMsg opts " >>> "
-          <> colorBoolT' opts r
+          <> colorBoolT opts r
           <> " "
           <> topMessage pp
           <> "\n"
@@ -759,27 +786,3 @@          pure $ case getValueLR opts msg0 qq (hhs <> [hh pp]) of
            Left e -> Left e
            Right q -> Right (p, q, pp, qq)
-
--- | typelevel 'BoolT'
---
--- >>> pz @'TrueT ()
--- TrueT
---
--- >>> pz @'FalseT ()
--- FalseT
---
--- >>> pz @('PresentT 123) ()
--- PresentT False
---
--- >>> pz @('FailT '[]) ()
--- FailT "'FailT _"
---
-instance GetBoolT x b => P (b :: BoolT x) a where
-  type PP b a = Bool
-  eval _ opts _ = do
-    let msg0 = "'BoolT"
-    let ret = getBoolT @x @b
-    pure $ case ret of
-      Left b -> mkNodeB opts b (if b then "TrueT" else "FalseT") []
-      Right True -> mkNode opts (PresentT False) (msg0 <> " PresentT") []
-      Right False -> mkNode opts (FailT "'FailT _") (msg0 <> " FailT") []

@@ -5,7 +5,6 @@ {-# OPTIONS -Wredundant-constraints #-}
 {-# OPTIONS -Wincomplete-record-updates #-}
 {-# OPTIONS -Wno-unused-imports #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}

@@ -278,9 +278,7 @@ -- >>> newRefined2 @'OZ @(ReadP Rational Id) @(Id > (11 % 1)) "13 % 3"
 -- Left "Step 2. False Boolean Check(op) | FalseP"
 --
--- >>> let tmString = "2018-10-19 14:53:11.5121359 UTC"
--- >>> let tm = read tmString :: UTCTime
--- >>> newRefined2 @'OZ @(ReadP UTCTime Id) @'True tmString
+-- >>> newRefined2 @'OZ @(ReadP UTCTime Id) @'True "2018-10-19 14:53:11.5121359 UTC"
 -- Right (Refined2 {r2In = 2018-10-19 14:53:11.5121359 UTC, r2Out = "2018-10-19 14:53:11.5121359 UTC"})
 --
 -- >>> :m + Data.Aeson

@@ -393,9 +393,7 @@ -- >>> newRefined3P (Proxy @(ReadShow' 'OZ Rational (Id > (11 % 1)))) "13 % 3"
 -- Left "Step 2. False Boolean Check(op) | FalseP"
 --
--- >>> let tmString = "2018-10-19 14:53:11.5121359 UTC"
--- >>> let tm = read tmString :: UTCTime
--- >>> newRefined3P (readshow @'OZ @UTCTime) tmString
+-- >>> newRefined3P (readshow @'OZ @UTCTime) "2018-10-19 14:53:11.5121359 UTC"
 -- Right (Refined3 {r3In = 2018-10-19 14:53:11.5121359 UTC, r3Out = "2018-10-19 14:53:11.5121359 UTC"})
 --
 -- >>> :m + Data.Aeson

@@ -31,7 +31,9 @@ module Predicate.Prelude (
   -- ** boolean expressions
     type (&&)
+  , type (&&~)
   , type (||)
+  , type (||~)
   , type (~>)
   , Not
   , Ands
@@ -127,6 +129,8 @@   , UnMkDay
   , MkDayExtra
   , MkDayExtra'
+  , ToWeekDate
+  , ToWeekYear
   , ToDay
   , ToTime
   , MkTime
@@ -241,6 +245,7 @@   , ToEnum
   , ToEnum'
   , EnumFromTo
+  , EnumFromThenTo
   -- *** bounded enum expressions
   , SuccB
   , SuccB'
@@ -1295,7 +1300,7 @@ --
 data ReplaceFn (o :: ReplaceFnSub) p
 
-instance (ReplaceFnSubC r
+instance (GetReplaceFnSub r
         , PP p x ~ String
         , P p x) => P (ReplaceFn r p) x where
   type PP (ReplaceFn r p) x = RReplace
@@ -2045,6 +2050,56 @@   type PP (MkDayExtra p) x = PP (MkDayExtraT p) x
   eval _ = eval (Proxy @(MkDayExtraT p))
 
+-- | get day of week
+--
+-- >>> pz @(Just (MkDay '(2020,7,11)) >> '(UnMkDay Id, ToWeekYear Id,ToWeekDate Id)) ()
+-- PresentT ((2020,7,11),28,(6,"Saturday"))
+--
+data ToWeekDate p
+
+instance ( P p x
+         , PP p x ~ Day
+         ) => P (ToWeekDate p) x where
+  type PP (ToWeekDate p) x = (Int, String)
+  eval _ opts x = do
+    let msg0 = "ToWeekDate"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let (_, _week, dow) = toWeekDate p
+            dowString =
+              case dow of
+                 1 -> "Monday"
+                 2 -> "Tuesday"
+                 3 -> "Wednesday"
+                 4 -> "Thursday"
+                 5 -> "Friday"
+                 6 -> "Saturday"
+                 7 -> "Sunday"
+                 _ -> error $ "oops: ToWeekDate invalid " ++ show dow
+        in mkNode opts (PresentT (dow,dowString)) (show01 opts msg0 dow p) [hh pp]
+
+-- | get week number of the year
+--
+-- >>> pz @(Just (MkDay '(2020,7,11)) >> ToWeekYear Id) ()
+-- PresentT 28
+--
+data ToWeekYear p
+
+instance ( P p x
+         , PP p x ~ Day
+         ) => P (ToWeekYear p) x where
+  type PP (ToWeekYear p) x = Int
+  eval _ opts x = do
+    let msg0 = "ToWeekYear"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let (_, week, _dow) = toWeekDate p
+        in mkNode opts (PresentT week) (show01 opts msg0 week p) [hh pp]
+
 class ToDayC a where
   getDay :: a -> Day
 instance ToDayC UTCTime where
@@ -2117,7 +2172,7 @@         in mkNode opts (PresentT ret) (show01 opts msg0 ret p) [hh pp]
 
 
--- | create a 'Time' from three int values passed in as year month and day
+-- | create a 'TimeOfDay' from three int values passed in as year month and day
 --
 -- >>> pz @(MkTime '(1,2,3 % 12345)) ()
 -- PresentT 01:02:00.000243013365
@@ -2168,6 +2223,12 @@ -- >>> pz @(ReadP UTCTime "2019-01-01 12:13:14.1234Z" >> ToTime Id >> UnMkTime Id) ()
 -- PresentT (12,13,70617 % 5000)
 --
+-- >>> pz @(ReadP UTCTime Id >> ToTime Id >> UnMkTime Id) "2020-07-22 08:01:14.127Z"
+-- PresentT (8,1,14127 % 1000)
+--
+-- >>> pz @(ReadP ZonedTime Id >> '(UnMkDay (ToDay Id), UnMkTime (ToTime Id))) "2020-07-11 11:41:12.333 CET"
+-- PresentT ((2020,7,11),(11,41,12333 % 1000))
+--
 data UnMkTime p
 
 instance (PP p x ~ TimeOfDay, P p x) => P (UnMkTime p) x where
@@ -2228,8 +2289,8 @@ -- >>> pz @(Rescan "^Date\\((\\d+)([^\\)]+)\\)" Id >> Head Id >> Snd Id >> ((ReadP Integer (Id !! 0) >> PosixToUTCTime (Id % 1000)) &&& ReadP TimeZone (Id !! 1))) "Date(1530144000000+0530)"
 -- PresentT (2018-06-28 00:00:00 UTC,+0530)
 --
--- not so uesful: just use ParseTimeP FormatTimeP with %s %q %z etc
-
+-- not so useful: instead use ParseTimeP FormatTimeP with %s %q %z etc
+--
 -- >>> pz @(ParseTimeP ZonedTime "%s%Q%z" Id)  "153014400.000+0530"
 -- PresentT 1974-11-07 05:30:00 +0530
 --
@@ -3520,7 +3581,7 @@   type PP (p * q) x = PP (MultT p q) x
   eval _ = eval (Proxy @(MultT p q))
 
--- | similar to '(^)'
+-- | similar to 'GHC.Real.(^)'
 --
 -- >>> pz @(Fst Id ^ Snd Id) (10,4)
 -- PresentT 10000
@@ -3551,7 +3612,7 @@                    else let d = p ^ q
                         in mkNode opts (PresentT d) (show p <> " ^ " <> show q <> " = " <> show d) hhs
 
--- | similar to '(**)'
+-- | similar to 'GHC.Float.(**)'
 --
 -- >>> pz @(Fst Id ** Snd Id) (10,4)
 -- PresentT 10000.0
@@ -4548,9 +4609,6 @@         let b = p > 1 && isPrime (fromIntegral p)
         in mkNodeB opts b (msg0 <> show1 opts " | " p) [hh pp]
 
-isPrime :: Word -> Bool
-isPrime n = n==2 || n>2 && all ((> 0).rem n) (2:[3,5 .. floor . sqrt @Double . fromIntegral $ n+1])
-
 -- | get the next prime number
 --
 -- >>> pz @(PrimeNext Id) 6
@@ -4566,7 +4624,7 @@         , Show a
         , Integral a
         ) => P (PrimeNext p) x where
-  type PP (PrimeNext p) x = Word
+  type PP (PrimeNext p) x = Int
   eval _ opts x = do
     let msg0 = "PrimeNext"
     pp <- eval (Proxy @p) opts x
@@ -5894,6 +5952,9 @@ -- >>> pz @(EnumFromTo (Pred Id) (Succ Id)) (SG.Max 10)
 -- PresentT [Max {getMax = 9},Max {getMax = 10},Max {getMax = 11}]
 --
+-- >>> pz @(EnumFromTo 1 20 >> Map '(Id, (If (Id `Mod` 3 == 0) "Fizz" "" <> If (Id `Mod` 5 == 0) "Buzz" "" )) Id) 123
+-- PresentT [(1,""),(2,""),(3,"Fizz"),(4,""),(5,"Buzz"),(6,"Fizz"),(7,""),(8,""),(9,"Fizz"),(10,"Buzz"),(11,""),(12,"Fizz"),(13,""),(14,""),(15,"FizzBuzz"),(16,""),(17,""),(18,"Fizz"),(19,""),(20,"Buzz")]
+--
 data EnumFromTo p q
 
 instance (P p x
@@ -5911,6 +5972,38 @@       Left e -> e
       Right (p,q,pp,qq) -> mkNode opts (PresentT (enumFromTo p q)) (msg0 <> " [" <> show p <> " .. " <> show q <> "]") [hh pp, hh qq]
 
+-- | similar to 'enumFromThenTo'
+--
+-- >>> pz @(EnumFromThenTo (ToEnum Day 10) (ToEnum Day 20) (ToEnum Day 70)) ()
+-- PresentT [1858-11-27,1858-12-07,1858-12-17,1858-12-27,1859-01-06,1859-01-16,1859-01-26]
+--
+-- >>> pz @(EnumFromThenTo (ReadP Day "2020-01-12") (ReadP Day "2020-02-12") (ReadP Day "2020-08-12")) ()
+-- PresentT [2020-01-12,2020-02-12,2020-03-14,2020-04-14,2020-05-15,2020-06-15,2020-07-16]
+--
+data EnumFromThenTo p q r
+
+instance (P p x
+        , P q x
+        , P r x
+        , PP p x ~ a
+        , Show a
+        , PP q x ~ a
+        , PP r x ~ a
+        , Enum a
+        ) => P (EnumFromThenTo p q r) x where
+  type PP (EnumFromThenTo p q r) x = [PP p x]
+  eval _ opts z = do
+    let msg0 = "EnumFromThenTo"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts z []
+    case lr of
+      Left e -> pure e
+      Right (p,q,pp,qq) -> do
+        rr <- eval (Proxy @r) opts z
+        pure $ case getValueLR opts (msg0 ++ " r failed") rr [hh pp, hh qq] of
+          Left e -> e
+          Right r ->
+            mkNode opts (PresentT (enumFromThenTo p q r)) (msg0 <> " [" <> show p <> ", " <> show q <> " .. " <> show r <> "]") [hh pp, hh qq, hh rr]
+
 -- | similar to 'partitionEithers'
 --
 -- >>> pz @PartitionEithers [Left 'a',Right 2,Left 'c',Right 4,Right 99]
@@ -6063,9 +6156,6 @@ -- >>> pz @(Unfoldr (MaybeBool (Not Null) (SplitAt 2 Id)) Id) [1..5]
 -- PresentT [[1,2],[3,4],[5]]
 --
--- >>> pz @(IterateN 4 (Succ Id)) 4
--- PresentT [4,5,6,7]
---
 data Unfoldr p q
 --type IterateN (t :: Type) n f = Unfoldr (If (Fst Id == 0) (MkNothing t) (Snd Id &&& (Pred Id *** f) >> MkJust Id)) '(n, Id)
 
@@ -6107,6 +6197,14 @@ type family UnfoldT mbs where
   UnfoldT (Maybe (b,s)) = b
 
+-- | like 'iterate' but for a fixed number of elements
+--
+-- >>> pz @(IterateN 4 (Succ Id)) 4
+-- PresentT [4,5,6,7]
+--
+-- >>> pz @('(0,1) >> IterateN 20 '(Snd Id, Fst Id + Snd Id) >> Map (Fst Id) Id) "sdf"
+-- PresentT [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
+--
 data IterateN n f
 type IterateNT n f = Unfoldr (MaybeBool (Fst Id > 0) '(Snd Id, Pred Id *** f)) '(n, Id)
 
@@ -6185,6 +6283,10 @@ --
 -- >>> pz @(If (Gt 4) "greater than 4" "less than or equal to 4") 0
 -- PresentT "less than or equal to 4"
+--
+-- >>> pz @(If (Snd Id == "a") '("xxx",Fst Id + 13) (If (Snd Id == "b") '("yyy",Fst Id + 7) (Failt _ "oops"))) (99,"b")
+-- PresentT ("yyy",106)
+--
 data If p q r
 
 instance (Show (PP r a)
@@ -6446,6 +6548,9 @@ -- >>> pz @(Catch' (Succ Id) (Second (ShowP Id) >> PrintT "%s %s" Id)) LT
 -- PresentT EQ
 --
+-- >>> pz @(Len > 1 && Catch (Id !! 3 == 66) 'False) [1,2]
+-- FalseT
+--
 -- more flexible: takes a (String,x) and a proxy so we can still call 'False 'True
 -- now takes the FailT string and x so you can print more detail if you want
 -- need the proxy so we can fail without having to explicitly specify a type
@@ -7186,6 +7291,45 @@                   (False, False) -> topMessage pp <> " " <> msg0 <> " " <> topMessage qq
         in mkNodeB opts (p&&q) (show p <> " " <> msg0 <> " " <> show q <> (if null zz then zz else " | " <> zz)) [hh pp, hh qq]
 
+-- | short circuit version of boolean And
+--
+-- >>> pl @(Id > 10 &&~ Failt _ "ss") 9
+-- False (False &&~ ... | (9 > 10))
+-- FalseT
+--
+-- >>> pl @(Id > 10 &&~ Id == 12) 11
+-- False (True &&~ False | (11 == 12))
+-- FalseT
+--
+-- >>> pl @(Id > 10 &&~ Id == 11) 11
+-- True (True &&~ True)
+-- TrueT
+--
+data p &&~ q
+infixr 3 &&~
+
+instance (P p a
+        , P q a
+        , PP p a ~ Bool
+        , PP q a ~ Bool
+        ) => P (p &&~ q) a where
+  type PP (p &&~ q) a = Bool
+  eval _ opts a = do
+    let msg0 = "&&~"
+    pp <- eval (Proxy @p) opts a
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right False ->
+        pure $ mkNodeB opts False ("False" <> " " <> msg0 <> " ... | " <> topMessage pp) [hh pp]
+      Right True -> do
+        qq <- eval (Proxy @q) opts a
+        pure $ case getValueLR opts msg0 qq [hh pp] of
+          Left e -> e
+          Right q ->
+            let zz = if q then ""
+                     else " | " <> topMessage qq
+            in mkNodeB opts q ("True" <> " " <> msg0 <> " " <> show q <> zz) [hh pp, hh qq]
+
 -- | similar to 'Prelude.||'
 --
 -- >>> pz @(Fst Id || (Length (Snd Id) >= 4)) (False,[11,12,13,14])
@@ -7210,10 +7354,48 @@       Left e -> e
       Right (p,q,pp,qq) ->
         let zz = case (p,q) of
-                  (False,False) -> topMessage pp <> " " <> msg0 <> " " <> topMessage qq
+                  (False,False) -> " | " <> topMessage pp <> " " <> msg0 <> " " <> topMessage qq
                   _ -> ""
-        in mkNodeB opts (p||q) (show p <> " " <> msg0 <> " " <> show q <> (if null zz then zz else " | " <> zz)) [hh pp, hh qq]
+        in mkNodeB opts (p||q) (show p <> " " <> msg0 <> " " <> show q <> zz) [hh pp, hh qq]
 
+-- | short circuit version of boolean Or
+--
+-- >>> pl @(Id > 10 ||~ Failt _ "ss") 11
+-- True (True ||~ ...)
+-- TrueT
+--
+-- >>> pz @(Id > 10 ||~ Id == 9) 9
+-- TrueT
+--
+-- >>> pl @(Id > 10 ||~ Id > 9) 9
+-- False (False ||~ False | (9 > 10) ||~ (9 > 9))
+-- FalseT
+--
+data p ||~ q
+infixr 2 ||~
+
+instance (P p a
+        , P q a
+        , PP p a ~ Bool
+        , PP q a ~ Bool
+        ) => P (p ||~ q) a where
+  type PP (p ||~ q) a = Bool
+  eval _ opts a = do
+    let msg0 = "||~"
+    pp <- eval (Proxy @p) opts a
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right False -> do
+        qq <- eval (Proxy @q) opts a
+        pure $ case getValueLR opts msg0 qq [hh pp] of
+          Left e -> e
+          Right q ->
+            let zz = if q then ""
+                     else " | " <> topMessage pp <> " " <> msg0 <> " " <> topMessage qq
+            in mkNodeB opts q ("False" <> " " <> msg0 <> " " <> show q <> zz) [hh pp, hh qq]
+      Right True ->
+        pure $ mkNodeB opts True ("True" <> " " <> msg0 <> " ...") [hh pp]
+
 -- | implication
 --
 -- >>> pz @(Fst Id ~> (Length (Snd Id) >= 4)) (True,[11,12,13,14])
@@ -8392,6 +8574,15 @@ --
 -- >>> pz @(Case (FailS "asdf" >> Snd Id >> Unproxy) '[Lt 4,Lt 10,Same 50] '[PrintF "%d is lt4" Id, PrintF "%d is lt10" Id, PrintF "%d is same50" Id] Id) 99
 -- FailT "asdf"
+--
+-- >>> pz @(Case (Failt _ "x") '[Same "a",Same "b"] '["hey","there"] Id) "b"
+-- PresentT "there"
+--
+-- >>> pz @(Case (Failt _ "x") '[Id == "a",Id == "b"] '["hey","there"] Id) "a"
+-- PresentT "hey"
+--
+-- >>> pz @(Case (Failt _ "x") '[Same "a",Same "b"] '["hey","there"] Id) "c"
+-- FailT "x"
 --
 data CaseImpl (n :: Nat) (e :: k0) (ps :: [k]) (qs :: [k1]) (r :: k2)
 -- ps = conditions

@@ -31,8 +31,6 @@     Refined
   , unRefined
   , RefinedC
-  , newRefined
-  , newRefinedM
   , RefinedT(..)
 
   -- ** print methods
@@ -40,6 +38,8 @@   , prtRefinedTIO
 
   -- ** create methods
+  , newRefined
+  , newRefinedM
   , withRefinedT
   , withRefinedTIO
   , newRefinedT
@@ -98,7 +98,7 @@ -- Right (Refined 13)
 --
 -- >>> prtRefinedIO @'OZ @(Between 10 14 Id) 99
--- Left FalseP
+-- Left FalseT
 --
 -- >>> prtRefinedIO @'OZ @(Last Id >> Len == 4) ["one","two","three","four"]
 -- Right (Refined ["one","two","three","four"])
@@ -107,37 +107,38 @@ -- Right (Refined "141.213.1.99")
 --
 -- >>> prtRefinedIO @'OZ @(Re "^\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}$" Id) "141.213.1"
--- Left FalseP
+-- Left FalseT
 --
 -- >>> prtRefinedIO @'OZ @(Map (ReadP Int Id) (Resplit "\\." Id) >> Guard (PrintF "bad length: found %d" Len) (Len == 4) >> 'True) "141.213.1"
--- Left (FailP "bad length: found 3")
+-- Left (FailT "bad length: found 3")
 --
 -- >>> prtRefinedIO @'OZ @(Map (ReadP Int Id) (Resplit "\\." Id) >> Guard (PrintF "bad length: found %d" Len) (Len == 4) >> GuardsN (PrintT "octet %d out of range %d" Id) 4 (Between 0 255 Id) >> 'True) "141.213.1.444"
--- Left (FailP "octet 3 out of range 444")
+-- Left (FailT "octet 3 out of range 444")
 --
 -- >>> prtRefinedIO @'OZ @(Map (ReadP Int Id) (Resplit "\\." Id) >> Guard (PrintF "bad length: found %d" Len) (Len == 4) >> GuardsN (PrintT "octet %d out of range %d" Id) 4 (Between 0 255 Id) >> 'True) "141.213.1x34.444"
--- Left (FailP "ReadP Int (1x34)")
+-- Left (FailT "ReadP Int (1x34)")
 --
 -- >>> prtRefinedIO @'OZ @(Map ('[Id] >> ReadP Int Id) Id >> Luhn Id) "12344"
 -- Right (Refined "12344")
 --
 -- >>> prtRefinedIO @'OZ @(Map ('[Id] >> ReadP Int Id) Id >> Luhn Id) "12340"
--- Left FalseP
+-- Left FalseT
 --
 -- >>> prtRefinedIO @'OZ @(Any (Prime Id) Id) [11,13,17,18]
 -- Right (Refined [11,13,17,18])
 --
 -- >>> prtRefinedIO @'OZ @(All (Prime Id) Id) [11,13,17,18]
--- Left FalseP
+-- Left FalseT
 --
 -- >>> prtRefinedIO @'OZ @(Snd Id !! Fst Id >> Len > 5) (2,["abc","defghij","xyzxyazsfd"])
 -- Right (Refined (2,["abc","defghij","xyzxyazsfd"]))
 --
 -- >>> prtRefinedIO @'OZ @(Snd Id !! Fst Id >> Len > 5) (27,["abc","defghij","xyzxyazsfd"])
--- Left (FailP "(!!) index not found")
+-- Left (FailT "(!!) index not found")
 --
 -- >>> prtRefinedIO @'OZ @(Snd Id !! Fst Id >> Len <= 5) (2,["abc","defghij","xyzxyazsfd"])
--- Left FalseP
+-- Left FalseT
+--
 newtype Refined (opts :: OptT) p a = Refined a deriving (Show, Eq, Generic, TH.Lift)
 
 -- | extract the value from Refined
@@ -146,6 +147,14 @@ 
 type role Refined nominal nominal nominal
 
+-- | 'IsString' instance for Refined
+--
+-- >>> pureTryTest $ fromString @(Refined 'OL (ReadP Int Id >> Id > 244) String) "523"
+-- Right (Refined "523")
+--
+-- >>> pureTryTest $ fromString @(Refined 'OL (ReadP Int Id >> Id > 244) String) "52"
+-- Left ()
+--
 instance RefinedC opts p String => IsString (Refined opts p String) where
   fromString s =
     let (w,mr) = runIdentity $ newRefinedM @opts @p s
@@ -258,10 +267,23 @@          ) => Hashable (Refined opts p a) where
   hashWithSalt s (Refined a) = s + hash a
 
-instance (Arbitrary a, RefinedC opts p a, Show a) => Arbitrary (Refined opts p a) where
+-- | 'Arbitrary' instance for 'Refined'
+--
+-- >>> xs <- generate (vectorOf 10 (arbitrary @(Refined 'OU (Id /= 0) Int)))
+-- >>> all ((/=0) . unRefined) xs
+-- True
+--
+-- >>> xs <- generate (vectorOf 10 (arbitrary @(Refined 'OU (Prime Id) Int)))
+-- >>> all (isPrime . unRefined) xs
+-- True
+--
+instance ( Arbitrary a
+         , RefinedC opts p a
+         , Show a
+         ) => Arbitrary (Refined opts p a) where
   arbitrary = genRefined arbitrary
 
--- | 'arbitrary' value for 'Refined'
+-- | create 'Refined' generator using a generator to restrict the values
 genRefined :: forall opts p a .
    RefinedC opts p a
    => Gen a
@@ -273,7 +295,7 @@         case ma of
           Nothing ->
              if cnt >= oRecursion o
-             then error $ markBoundary o ("genRefined recursion exceeded(" ++ show (oRecursion o) ++ ")")
+             then error $ setOtherEffects o ("genRefined recursion exceeded(" ++ show (oRecursion o) ++ ")")
              else f (cnt+1)
           Just a -> pure $ unsafeRefined a
   in f 0
@@ -286,11 +308,11 @@   -> RefinedT m (Refined opts p a)
 rapply f ma mb = do
   let opts = getOptT @opts
-  tell [markBoundary opts "=== a ==="]
+  tell [setOtherEffects opts "=== a ==="]
   Refined x <- ma
-  tell [markBoundary opts "=== b ==="]
+  tell [setOtherEffects opts "=== b ==="]
   Refined y <- mb
-  tell [markBoundary opts "=== a `op` b ==="]
+  tell [setOtherEffects opts "=== a `op` b ==="]
   newRefinedT @m @opts @p (f x y)
 
 -- | takes two values and lifts them into 'RefinedT' and then applies the binary operation
@@ -345,18 +367,18 @@ prtRefinedIO :: forall opts p a
    . RefinedC opts p a
    => a
-   -> IO (Either BoolP (Refined opts p a))
+   -> IO (Either (BoolT Bool) (Refined opts p a))
 prtRefinedIO a = do
   let o = getOptT @opts
   tt <- evalBool (Proxy @p) o a
-  let msg = (_tBool tt ^. boolT2P, prtTree' o tt) -- (fromTT tt))
+  let r = _tBool tt
   case oDebug o of
-     DZero -> pure ()  -- putStrLn $ colorBoolP opts (fst msg) <> " " <> topMessage tt
-     DLite -> putStrLn $ colorBoolT' o (_tBool tt) <> " " <> topMessage tt
-     _ -> putStrLn $ snd msg
+     DZero -> pure ()
+     DLite -> putStrLn $ colorBoolT o r <> " " <> topMessage tt
+     _ -> putStrLn $ prtTree o tt
   pure $ case getValueLR o "" tt [] of
     Right True -> Right (Refined a)
-    _ -> Left (fst msg)
+    _ -> Left r
 
 -- | returns a 'Refined' value if \'a\' is valid for the predicate \'p\'
 --
@@ -388,8 +410,8 @@ newRefinedM a = do
   let o = getOptT @opts
   pp <- evalBool (Proxy @p) o a
-  let r = colorBoolT o (_tBool pp)
-      s = prtTree' o pp
+  let r = colorBoolT' o (_tBool pp)
+      s = prtTree o pp
   pure $ ((r,(topMessage pp, s)),) $ case getValueLR o "" pp [] of
        Right True -> Just (Refined a)
        _ -> Nothing
@@ -405,11 +427,11 @@ newRefinedTImpl f a = do
   let o = getOptT @opts
   tt <- f $ evalBool (Proxy @p) o a
-  let msg = prtTree' o tt
+  let msg = prtTree o tt
   tell [msg]
   case getValueLR o "" tt [] of
     Right True -> return (Refined a) -- FalseP is also a failure!
-    _ -> throwError $ colorBoolT o (_tBool tt)
+    _ -> throwError $ colorBoolT' o (_tBool tt)
 
 -- | returns a wrapper 'RefinedT' around a possible 'Refined' value if \'a\' is valid for the predicate \'p\'
 newRefinedT :: forall m opts p a
@@ -475,11 +497,12 @@       tt = runIdentity $ evalBool (Proxy @p) o a
   in case getValueLR o "" tt [] of
        Right True -> Refined a
-       _ -> let s = prtTree' o tt
+       _ -> let s = prtTree o tt
+                bp = colorBoolT' o (view tBool tt)
             in case oDebug o of
-                 DZero -> error $ colorBoolT' o (view tBool tt)
-                 DLite -> error s
-                 _ -> error $ "\n" ++ s
+                 DZero -> error bp
+                 DLite -> error $ bp ++ "\n" ++ s
+                 _ -> error $ bp ++ "\n" ++ s
 
 type family ReplaceOptT (o :: OptT) t where
   ReplaceOptT o (Refined _ p a) = Refined o p a

@@ -100,6 +100,7 @@ import Data.Functor.Identity (Identity(..))
 import Data.Tree
 import Data.Proxy
+import Control.Arrow (left)
 import Control.Monad.Except
 import Control.Monad.Writer (tell)
 import Data.Aeson (ToJSON(..), FromJSON(..))
@@ -219,6 +220,14 @@ deriving instance (Eq i, Eq (PP ip i), Eq (PP fmt (PP ip i))) => Eq (Refined1 opts ip op fmt i)
 deriving instance (TH.Lift (PP ip i), TH.Lift (PP fmt (PP ip i))) => TH.Lift (Refined1 opts ip op fmt i)
 
+-- | 'IsString' instance for Refined1
+--
+-- >>> pureTryTest $ fromString @(Refined1 'OL (ReadP Int Id) (Id > 12) (ShowP Id) String) "523"
+-- Right (Refined1 523)
+--
+-- >>> pureTryTest $ fromString @(Refined1 'OL (ReadP Int Id) (Id > 12) (ShowP Id) String) "2"
+-- Left ()
+--
 instance (Refined1C opts ip op fmt String, Show (PP ip String)) => IsString (Refined1 opts ip op fmt String) where
   fromString s =
     let (ret,mr) = eval1 @opts @ip @op @fmt s
@@ -333,13 +342,28 @@                   case mr of
                     Nothing -> fail $ "Refined1:" ++ show (prt1Impl (getOptT @opts) ret)
                     Just r -> return r
-
+-- | 'Arbitrary' instance for 'Refined1'
+--
+-- >>> xs <- generate (vectorOf 10 (arbitrary @(Refined1 'OU (ReadP Int Id) (1 <..> 120 && Even) (ShowP Id) String)))
+-- >>> all ((/=0) . unRefined1) xs
+-- True
+--
+-- >>> xs <- generate (vectorOf 10 (arbitrary @(Refined1 'OU Id (Prime Id) Id Int)))
+-- >>> all (isPrime . unRefined1) xs
+-- True
+--
 instance (Arbitrary (PP ip i)
         , Refined1C opts ip op fmt i
         ) => Arbitrary (Refined1 opts ip op fmt i) where
   arbitrary = genRefined1 arbitrary
 
 -- | create a 'Refined1' generator
+--
+-- >>> g = genRefined1 @'OU @(ReadP Int Id) @(Between 10 100 Id && Even) @(ShowP Id) (choose (10,100))
+-- >>> xs <- generate (vectorOf 10 g)
+-- >>> all (\x -> let y = unRefined1 x in y >= 0 && y <= 100 && even y) xs
+-- True
+--
 genRefined1 ::
     forall opts ip op fmt i
   . Refined1C opts ip op fmt i
@@ -347,7 +371,7 @@   -> Gen (Refined1 opts ip op fmt i)
 genRefined1 = genRefined1P Proxy
 
--- | create a 'Refined1' generator
+-- | create a 'Refined1' generator with a Proxy
 genRefined1P ::
     forall opts ip op fmt i
   . Refined1C opts ip op fmt i
@@ -361,7 +385,7 @@         case mppi of
           Nothing ->
              if cnt >= oRecursion o
-             then error $ markBoundary o ("genRefined1 recursion exceeded(" ++ show (oRecursion o) ++ ")")
+             then error $ setOtherEffects o ("genRefined1 recursion exceeded(" ++ show (oRecursion o) ++ ")")
              else f (cnt+1)
           Just ppi ->
              pure $ unsafeRefined1 ppi
@@ -525,13 +549,13 @@ 
 -- | pure version for extracting Refined1
 --
--- >>> newRefined1 @'OU @(ParseTimeP TimeOfDay "%-H:%-M:%-S" Id) @'True @(FormatTimeP "%H:%M:%S" Id) "1:15:7"
+-- >>> newRefined1 @'OL @(ParseTimeP TimeOfDay "%-H:%-M:%-S" Id) @'True @(FormatTimeP "%H:%M:%S" Id) "1:15:7"
 -- Right (Refined1 01:15:07)
 --
--- >>> newRefined1 @'OU @(ParseTimeP TimeOfDay "%-H:%-M:%-S" Id) @'True @(FormatTimeP "%H:%M:%S" Id) "1:2:x"
+-- >>> newRefined1 @'OL @(ParseTimeP TimeOfDay "%-H:%-M:%-S" Id) @'True @(FormatTimeP "%H:%M:%S" Id) "1:2:x"
 -- Left "Step 1. Initial Conversion(ip) Failed | ParseTimeP TimeOfDay (%-H:%-M:%-S) failed to parse"
 --
--- >>> newRefined1 @'OU @(Rescan "^(\\d{1,2}):(\\d{1,2}):(\\d{1,2})$" Id >> Snd (Head Id) >> Map (ReadP Int Id) Id) @(All (0 <..> 59) Id && Len == 3) @(PrintL 3 "%02d:%02d:%02d" Id) "1:2:3"
+-- >>> newRefined1 @'OL @(Rescan "^(\\d{1,2}):(\\d{1,2}):(\\d{1,2})$" Id >> Snd (Head Id) >> Map (ReadP Int Id) Id) @(All (0 <..> 59) Id && Len == 3) @(PrintL 3 "%02d:%02d:%02d" Id) "1:2:3"
 -- Right (Refined1 [1,2,3])
 --
 newRefined1 :: forall opts ip op fmt i
@@ -551,7 +575,9 @@    => proxy '(opts,ip,op,fmt,i)
    -> i
    -> Either String (Refined1 opts ip op fmt i)
-newRefined1P _ = fst . runIdentity . unRavelT . newRefined1T @_ @opts @ip @op @fmt
+newRefined1P _ x =
+  let (lr,xs) = runIdentity $ unRavelT $ newRefined1T @_ @opts @ip @op @fmt x
+  in left (\e -> e ++ (if all null xs then "" else "\n" ++ unlines xs)) lr
 
 newRefined1T :: forall m opts ip op fmt i
   . ( Refined1C opts ip op fmt i
@@ -675,12 +701,12 @@   -> RefinedT m (Refined1 opts ip op fmt i)
 rapply1P p f ma mb = do
   let opts = getOptT @opts
-  tell [markBoundary opts "=== a ==="]
+  tell [setOtherEffects opts "=== a ==="]
   Refined1 x <- ma
-  tell [markBoundary opts "=== b ==="]
+  tell [setOtherEffects opts "=== b ==="]
   Refined1 y <- mb
   -- we skip the input value @Id and go straight to the internal value so PP fmt (PP ip i) /= i for this call
-  tell [markBoundary opts "=== a `op` b ==="]
+  tell [setOtherEffects opts "=== a `op` b ==="]
   Refined1 a <- newRefined1TPSkipIPImpl (return . runIdentity) p (f x y)
   return (Refined1 a)
 

@@ -3,6 +3,7 @@ {-# OPTIONS -Wincomplete-record-updates #-}
 {-# OPTIONS -Wincomplete-uni-patterns #-}
 {-# OPTIONS -Wno-redundant-constraints #-}
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -62,6 +63,10 @@   , mkProxy2
   , mkProxy2'
 
+  -- ** QuickCheck methods
+  , genRefined2
+  , genRefined2P
+
   -- ** unsafe methods for creating Refined2
   , unsafeRefined2
   , unsafeRefined2'
@@ -76,6 +81,7 @@ import Data.Functor.Identity (Identity(..))
 import Data.Tree
 import Data.Proxy
+import Control.Arrow (left)
 import Control.Monad.Except
 import Control.Monad.Writer (tell)
 import Data.Aeson (ToJSON(..), FromJSON(..))
@@ -85,13 +91,14 @@ import qualified Text.Read.Lex as RL
 import qualified Data.Binary as B
 import Data.Binary (Binary)
-import Data.Maybe (fromMaybe)
-import Control.Lens ((^.))
+import Data.Maybe (fromMaybe, isJust)
+import Control.Lens
 import Data.Tree.Lens (root)
 import Data.Char (isSpace)
 import Data.String
 import Data.Hashable (Hashable(..))
 import GHC.Stack
+import Test.QuickCheck
 
 -- $setup
 -- >>> :set -XDataKinds
@@ -170,6 +177,14 @@ deriving instance (Eq i, Eq (PP ip i)) => Eq (Refined2 opts ip op i)
 deriving instance (TH.Lift (PP ip i), TH.Lift i) => TH.Lift (Refined2 opts ip op i)
 
+-- | 'IsString' instance for Refined2
+--
+-- >>> pureTryTest $ fromString @(Refined2 'OL (ReadP Int Id) (Id > 12) String) "523"
+-- Right (Refined2 {r2In = 523, r2Out = "523"})
+--
+-- >>> pureTryTest $ fromString @(Refined2 'OL (ReadP Int Id) (Id > 12) String) "2"
+-- Left ()
+--
 instance ( s ~ String
          , Refined2C opts ip op s
          , Show (PP ip s)
@@ -279,11 +294,64 @@                     Nothing -> fail $ "Refined2:" ++ show (prt2Impl (getOptT @opts) ret)
                     Just r -> return r
 
+-- | 'Arbitrary' instance for 'Refined2'
+--
+-- >>> :m + Data.Time.Calendar.WeekDate
+-- >>> xs <- generate (vectorOf 10 (arbitrary @(Refined2 'OU (ToEnum Day Id) (Snd (ToWeekDate Id) == "Tuesday") Int)))
+-- >>> all (\x -> let y = toEnum @Day (r2Out x) in view _3 (toWeekDate y) == 2 && r2In x == y) xs
+-- True
+--
+instance ( Arbitrary i
+         , Refined2C opts ip op i
+         , Show (PP ip i)
+         ) => Arbitrary (Refined2 opts ip op i) where
+  arbitrary = genRefined2 arbitrary
 
+-- | create a 'Refined2' generator using a generator to restrict the values (so it completes)
+--
+-- >>> g = genRefined2 @'OU @(ToEnum Day Id) @(UnMkDay Id >> Snd Id == 10) arbitrary
+-- >>> xs <- generate (vectorOf 10 g)
+-- >>> all (\x -> let y = toEnum @Day (fromIntegral (r2Out x)) in view _2 (toGregorian y) == 10 && y == r2In x) xs
+-- True
+--
+genRefined2 ::
+    forall opts ip op i
+  . ( Refined2C opts ip op i
+    , Show (PP ip i)
+    )
+  => Gen i
+  -> Gen (Refined2 opts ip op i)
+genRefined2 = genRefined2P Proxy
+
+-- generates the external value unlike Refined3 as we dont have a way to recreate the output from the internal value
+-- | create a 'Refined2' generator using a proxy
+genRefined2P ::
+    forall opts ip op i
+  . ( Refined2C opts ip op i
+    , Show (PP ip i)
+    )
+  => Proxy '(opts,ip,op,i)
+  -> Gen i
+  -> Gen (Refined2 opts ip op i)
+genRefined2P _ g =
+  let o = getOptT @opts
+      f !cnt = do
+        mi <- suchThatMaybe g (isJust . snd . eval2 @opts @ip @op)
+        case mi of
+          Nothing ->
+             if cnt >= oRecursion o
+             then error $ setOtherEffects o ("genRefined2P recursion exceeded(" ++ show (oRecursion o) ++ ")")
+             else f (cnt+1)
+          Just i -> do
+             let lr = newRefined2 @opts @ip @op i
+             case lr of
+               Left e -> error $ "conversion failed: programming error failed!! " ++ e
+               Right r -> pure r
+  in f 0
+
 -- | 'Binary' instance for 'Refined2'
 --
 -- >>> import Control.Arrow ((+++))
--- >>> import Control.Lens
 -- >>> import Data.Time
 -- >>> type K1 = Refined2 'OAN (ReadP Day Id) 'True String
 -- >>> type K2 = Refined2 'OAN (ReadP Day Id) (Between (ReadP Day "2019-05-30") (ReadP Day "2019-06-01") Id) String
@@ -399,13 +467,13 @@ 
 -- | pure version for extracting Refined2
 --
--- >>> newRefined2 @'OU @Id @'True 22
+-- >>> newRefined2 @'OL @Id @'True 22
 -- Right (Refined2 {r2In = 22, r2Out = 22})
 --
--- >>> newRefined2 @'OU @(ReadP UTCTime Id) @(Between (MkDay '(2020,5,2)) (MkDay '(2020,5,7)) (MkJust (ToDay Id))) "2020-05-04 12:13:14Z"
+-- >>> newRefined2 @'OL @(ReadP UTCTime Id) @(Between (MkDay '(2020,5,2)) (MkDay '(2020,5,7)) (MkJust (ToDay Id))) "2020-05-04 12:13:14Z"
 -- Right (Refined2 {r2In = 2020-05-04 12:13:14 UTC, r2Out = "2020-05-04 12:13:14Z"})
 --
--- >>> newRefined2 @'OU @(ReadP UTCTime Id) @(Between (MkDay '(2020,5,2)) (MkDay '(2020,5,7)) (MkJust (ToDay Id))) "2020-05-08 12:13:14Z"
+-- >>> newRefined2 @'OL @(ReadP UTCTime Id) @(Between (MkDay '(2020,5,2)) (MkDay '(2020,5,7)) (MkJust (ToDay Id))) "2020-05-08 12:13:14Z"
 -- Left "Step 2. False Boolean Check(op) | {Just 2020-05-08 <= Just 2020-05-07}"
 --
 newRefined2 :: forall opts ip op i
@@ -421,7 +489,9 @@     ) => proxy '(opts,ip,op,i)
       -> i
       -> Either String (Refined2 opts ip op i)
-newRefined2P _ = fst . runIdentity . unRavelT . newRefined2T @_ @opts @ip @op
+newRefined2P _ x =
+  let (lr,xs) = runIdentity $ unRavelT $ newRefined2T @_ @opts @ip @op x
+  in left (\e -> e ++ (if all null xs then "" else "\n" ++ unlines xs)) lr
 
 -- | create a wrapped 'Refined2' type
 --

@@ -99,6 +99,7 @@ import Data.Functor.Identity (Identity(..))
 import Data.Tree
 import Data.Proxy
+import Control.Arrow (left)
 import Control.Monad.Except
 import Control.Monad.Writer (tell)
 import Data.Aeson (ToJSON(..), FromJSON(..))
@@ -124,7 +125,7 @@ -- >>> :m + Predicate.Prelude
 -- >>> :m + Data.Time
 
--- | Like 'Refined2' but additionally reconstructs the output value to a standardized format
+-- | Like 'Predicate.Refined2' but additionally reconstructs the output value to a standardized format
 --
 --   * @opts@ are the display options
 --   * @ip@ converts @i@ to @PP ip i@ which is the internal type and stored in 'r3In'
@@ -216,6 +217,14 @@ deriving instance (Eq i, Eq (PP ip i), Eq (PP fmt (PP ip i))) => Eq (Refined3 opts ip op fmt i)
 deriving instance (TH.Lift (PP ip i), TH.Lift (PP fmt (PP ip i))) => TH.Lift (Refined3 opts ip op fmt i)
 
+-- | 'IsString' instance for Refined3
+--
+-- >>> pureTryTest $ fromString @(Refined3 'OL (ReadP Int Id) (Id > 12) (ShowP Id) String) "523"
+-- Right (Refined3 {r3In = 523, r3Out = "523"})
+--
+-- >>> pureTryTest $ fromString @(Refined3 'OL (ReadP Int Id) (Id > 12) (ShowP Id) String) "2"
+-- Left ()
+--
 instance (Refined3C opts ip op fmt String, Show (PP ip String))
   => IsString (Refined3 opts ip op fmt String) where
   fromString s =
@@ -326,12 +335,24 @@                     Nothing -> fail $ "Refined3:" ++ show (prt3Impl (getOptT @opts) ret)
                     Just r -> return r
 
+-- | 'Arbitrary' instance for 'Refined3'
+--
+-- >>> xs <- generate (vectorOf 10 (arbitrary @(Refined3 'OU (ReadP Int Id) (1 <..> 120 && Even) (ShowP Id) String)))
+-- >>> all (\x -> let y = r3In x in y /= 0 && r3Out x == show y) xs
+-- True
+--
 instance ( Arbitrary (PP ip i)
          , Refined3C opts ip op fmt i
          ) => Arbitrary (Refined3 opts ip op fmt i) where
   arbitrary = genRefined3 arbitrary
 
--- | create a 'Refined3' generator
+-- | create a 'Refined3' generator using a generator to restrict the values (so it completes)
+--
+-- >>> g = genRefined3 @'OU @(ReadP Int Id) @(Between 10 100 Id && Even) @(ShowP Id) (choose (10,100))
+-- >>> xs <- generate (vectorOf 10 g)
+-- >>> all (\x -> let y = r3In x in y >= 0 && y <= 100 && even y) xs
+-- True
+--
 genRefined3 ::
     forall opts ip op fmt i
   . Refined3C opts ip op fmt i
@@ -339,7 +360,7 @@   -> Gen (Refined3 opts ip op fmt i)
 genRefined3 = genRefined3P Proxy
 
--- | create a 'Refined3' generator
+-- | create a 'Refined3' generator using a proxy
 genRefined3P ::
     forall opts ip op fmt i
   . Refined3C opts ip op fmt i
@@ -353,7 +374,7 @@         case mppi of
           Nothing ->
              if cnt >= oRecursion o
-             then error $ markBoundary o ("genRefined3 recursion exceeded(" ++ show (oRecursion o) ++ ")")
+             then error $ setOtherEffects o ("genRefined3P recursion exceeded(" ++ show (oRecursion o) ++ ")")
              else f (cnt+1)
           Just ppi -> do
              let lr = getValLRFromTT (runIdentity (eval @_ (Proxy @fmt) o ppi))
@@ -516,13 +537,13 @@ 
 -- | pure version for extracting Refined3
 --
--- >>> newRefined3 @'OU @(ParseTimeP TimeOfDay "%-H:%-M:%-S" Id) @'True @(FormatTimeP "%H:%M:%S" Id) "1:15:7"
+-- >>> newRefined3 @'OL @(ParseTimeP TimeOfDay "%-H:%-M:%-S" Id) @'True @(FormatTimeP "%H:%M:%S" Id) "1:15:7"
 -- Right (Refined3 {r3In = 01:15:07, r3Out = "01:15:07"})
 --
--- >>> newRefined3 @'OU @(ParseTimeP TimeOfDay "%-H:%-M:%-S" Id) @'True @(FormatTimeP "%H:%M:%S" Id) "1:2:x"
+-- >>> newRefined3 @'OL @(ParseTimeP TimeOfDay "%-H:%-M:%-S" Id) @'True @(FormatTimeP "%H:%M:%S" Id) "1:2:x"
 -- Left "Step 1. Initial Conversion(ip) Failed | ParseTimeP TimeOfDay (%-H:%-M:%-S) failed to parse"
 --
--- >>> newRefined3 @'OU @(Rescan "^(\\d{1,2}):(\\d{1,2}):(\\d{1,2})$" Id >> Snd (Head Id) >> Map (ReadP Int Id) Id) @(All (0 <..> 59) Id && Len == 3) @(PrintL 3 "%02d:%02d:%02d" Id) "1:2:3"
+-- >>> newRefined3 @'OL @(Rescan "^(\\d{1,2}):(\\d{1,2}):(\\d{1,2})$" Id >> Snd (Head Id) >> Map (ReadP Int Id) Id) @(All (0 <..> 59) Id && Len == 3) @(PrintL 3 "%02d:%02d:%02d" Id) "1:2:3"
 -- Right (Refined3 {r3In = [1,2,3], r3Out = "01:02:03"})
 --
 newRefined3 :: forall opts ip op fmt i
@@ -542,7 +563,9 @@    => proxy '(opts,ip,op,fmt,i)
    -> i
    -> Either String (Refined3 opts ip op fmt i)
-newRefined3P _ = fst . runIdentity . unRavelT . newRefined3T @_ @opts @ip @op @fmt
+newRefined3P _ x =
+  let (lr,xs) = runIdentity $ unRavelT $ newRefined3T @_ @opts @ip @op @fmt x
+  in left (\e -> e ++ (if all null xs then "" else "\n" ++ unlines xs)) lr
 
 -- | create a wrapped 'Refined3' type
 --
@@ -679,12 +702,12 @@   -> RefinedT m (Refined3 opts ip op fmt i)
 rapply3P p f ma mb = do
   let opts = getOptT @opts
-  tell [markBoundary opts "=== a ==="]
+  tell [setOtherEffects opts "=== a ==="]
   Refined3 x _ <- ma
-  tell [markBoundary opts "=== b ==="]
+  tell [setOtherEffects opts "=== b ==="]
   Refined3 y _ <- mb
   -- we skip the input value @Id and go straight to the internal value so PP fmt (PP ip i) /= i for this call
-  tell [markBoundary opts "=== a `op` b ==="]
+  tell [setOtherEffects opts "=== a `op` b ==="]
   Refined3 a b <- newRefined3TPSkipIPImpl (return . runIdentity) p (f x y)
   return (Refined3 a b)
 

@@ -7,7 +7,6 @@ {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
@@ -38,7 +37,6 @@ 
  -- ** BoolT
   , BoolT(..)
-  , BoolP
   , GetBoolT(..)
   , _FailT
   , _PresentT
@@ -46,11 +44,8 @@   , _TrueT
 
  -- ** BoolP
-  , boolT2P
---  , BoolP
-  , PE(PE)
+  , PE
   , pString
-  , pBool
 
  -- ** create tree functions
   , mkNode
@@ -74,17 +69,18 @@   , Debug(..)
   , Disp(..)
   , Color(..)
-  , markBoundary
   , colorMe
   , isVerbose
-  , colorBoolP
   , colorBoolT
   , colorBoolT'
+  , setOtherEffects
   , type Color1
   , type Color2
   , type Color3
   , type Color4
   , type Color5
+  , type Other1
+  , type Other2
 
   , HOpts(..)
   , OptT(..)
@@ -112,7 +108,7 @@   , compileRegex
   , GetROpts(..)
   , RReplace(..)
-  , ReplaceFnSubC(..)
+  , GetReplaceFnSub(..)
   , ReplaceFnSub(..)
 
   -- ** useful type families
@@ -150,9 +146,6 @@   , GetOrd(..)
 
  -- ** printing methods
-  , prtTTIO
-  , prtTT
-  , prtTree
   , prtTreePure
   , prettyRational
   , formatOMsg
@@ -160,6 +153,17 @@  -- ** boolean methods
   , (~>)
 
+  -- ** extract from n-tuple
+  , T4_1
+  , T4_2
+  , T4_3
+  , T4_4
+  , T5_1
+  , T5_2
+  , T5_3
+  , T5_4
+  , T5_5
+
  -- ** miscellaneous
   , Holder
   , hh
@@ -171,17 +175,9 @@   , readField
   , showThese
   , chkSize
-
-  -- ** extract from n-tuple
-  , T4_1
-  , T4_2
-  , T4_3
-  , T4_4
-  , T5_1
-  , T5_2
-  , T5_3
-  , T5_4
-  , T5_5
+  , pureTryTest
+  , pureTryTestPred
+  , isPrime
 
     ) where
 import qualified GHC.TypeNats as GN
@@ -207,6 +203,7 @@ import Control.Applicative (ZipList)
 import Data.Kind (Type)
 import Data.These (These(..))
+import Data.These.Combinators (isThis, isThat, isThese)
 import qualified Control.Exception as E
 import Control.DeepSeq
 import System.IO.Unsafe (unsafePerformIO)
@@ -223,7 +220,6 @@ import GHC.Stack
 import Data.Monoid (Last (..))
 import Data.Maybe
---import Data.Function (on)
 import Data.Coerce
 import Data.Foldable (toList)
 
@@ -239,18 +235,12 @@                } deriving Show
 
 -- | contains the typed result from evaluating the expression tree
---
 data BoolT a where
   FailT :: !String -> BoolT a  -- failure with string
   FalseT :: BoolT Bool        -- false predicate
   TrueT :: BoolT Bool         -- true predicate
   PresentT :: !a -> BoolT a    -- non predicate value
 
-{- too restrictive
-instance Semigroup a => Semigroup (BoolT a) where
-   PresentT a <> PresentT a1 = PresentT (a <> a1)
--}
-
 -- | semigroup instance for 'BoolT'
 --
 instance Semigroup (BoolT a) where
@@ -267,6 +257,7 @@ deriving instance Show a => Show (BoolT a)
 deriving instance Eq a => Eq (BoolT a)
 
+-- | extracts the 'BoolT a' constructors from the typelevel
 class GetBoolT a (x :: BoolT a) | x -> a where
   getBoolT :: Either Bool Bool
 instance GetBoolT Bool 'TrueT where
@@ -282,9 +273,11 @@ tBool :: Lens (TT a) (TT b) (BoolT a) (BoolT b)
 tBool afb s = (\b -> s { _tBool = b }) <$> afb (_tBool s)
 
+-- | lens for accessing the message from 'BoolT'
 tString :: Lens' (TT a) String
 tString afb s = (\b -> s { _tString = b }) <$> afb (_tString s)
 
+-- | lens for accessing the subtree from 'BoolT'
 tForest :: Lens' (TT a) (Forest PE)
 tForest afb s = (\b -> s { _tForest = b }) <$> afb (_tForest s)
 
@@ -309,9 +302,11 @@              , _pString :: !String -- ^ optional strings to include in the results
              } deriving Show
 
+-- | prism for accessing '_pBool'
 pBool :: Lens' PE BoolP
 pBool afb (PE x y) = flip PE y <$> afb x
 
+-- | prism for accessing 'PE'
 pString :: Lens' PE String
 pString afb s = (\b -> s { _pString = b }) <$> afb (_pString s)
 
@@ -381,18 +376,35 @@           )
           (getValLRFromTT tt)
 
+-- | wrapper for a show instance around 'Color'
+newtype SColor = SColor Color
+
+instance Show SColor where
+  show (SColor c) =
+    case c of
+      Black-> "Black"
+      Red-> "Red"
+      Green-> "Green"
+      Yellow-> "Yellow"
+      Blue-> "Blue"
+      Magenta-> "Magenta"
+      Cyan-> "Cyan"
+      White-> "White"
+      Default -> "Default"
+
 -- | the color palette for displaying the expression tree
 newtype PColor = PColor (BoolP -> String -> String)
 instance Show PColor where
   show PColor {} = "PColor <fn>"
 
+-- | elide the 'Identity' wrapper so it acts like a normal adt
 type family HKD f a where
   HKD Identity a = a
   HKD f a = f a
 
 type POpts = HOpts Identity
 
--- | customizable options
+-- | customizable options for running a typelevel expression
 data HOpts f =
   HOpts { oWidth :: !(HKD f Int) -- ^ length of data to display for 'showLitImpl'
         , oDebug :: !(HKD f Debug) -- ^ debug level
@@ -400,7 +412,7 @@         , oColor :: !(HKD f (String, PColor)) -- ^ color palette used
         , oMsg :: ![String] -- ^ messages associated with type
         , oRecursion :: !(HKD f Int) -- ^ max recursion
-        , oOther :: !(HKD f (Color, Color)) -- ^ other message effects
+        , oOther :: !(HKD f (Bool, SColor, SColor)) -- ^ other message effects
         , oNoColor :: !(HKD f Bool) -- ^ no colors
         }
 
@@ -410,9 +422,10 @@   , Show (HKD f Disp)
   , Show (HKD f (String, PColor))
   , Show (HKD f Bool)
-  , Show (HKD f (Color, Color))
+  , Show (HKD f (Bool, SColor, SColor))
   ) => Show (HOpts f)
 
+-- | combine options ala monoid
 reifyOpts :: HOpts Last -> HOpts Identity
 reifyOpts h =
   HOpts (fromMaybe (oWidth defOpts) (getLast (oWidth h)))
@@ -426,24 +439,31 @@          else fromMaybe (oOther defOpts) (getLast (oOther h)))
         (fromMaybe (oNoColor defOpts) (getLast (oNoColor h)))
 
+-- | set maximum display width of expressions
 setWidth :: Int -> POptsL
 setWidth i = mempty { oWidth = pure i }
 
+-- | set title message for the display tree
 setMessage :: String -> POptsL
 setMessage s = mempty { oMsg = pure s }
 
+-- | set maximum recursion eg when running regex
 setRecursion :: Int -> POptsL
 setRecursion i = mempty { oRecursion = pure i }
 
-setOther :: Color -> Color -> POptsL
-setOther c1 c2 = mempty { oOther = pure (c1, c2) }
+-- | set color of title message
+setOther :: Bool -> Color -> Color -> POptsL
+setOther b c1 c2 = mempty { oOther = pure $ coerce (b, c1, c2) }
 
+-- | turn on/off colors
 setNoColor :: Bool -> POptsL
 setNoColor b = mempty { oNoColor = pure b }
 
+-- | display type eg 'Unicode' or 'Ansi'
 setDisp :: Disp -> POptsL
 setDisp d = mempty { oDisp = pure d }
 
+-- | create color palette for the expression tree
 setCreateColor :: String
    -> Color
    -> Color
@@ -462,10 +482,12 @@        PresentP -> color c7 . bgColor c8
   in mempty { oColor = pure (s,PColor pc) }
 
+-- | set debug mode
 setDebug :: Debug -> POptsL
 setDebug d =
   mempty { oDebug = pure d }
 
+-- | monoid opts
 type POptsL = HOpts Last
 
 instance Monoid (HOpts Last) where
@@ -490,6 +512,7 @@           | Unicode  -- ^ use unicode
           deriving (Show, Eq)
 
+-- | default options
 defOpts :: POpts
 defOpts = HOpts
     { oWidth = 200
@@ -502,13 +525,15 @@     , oNoColor = False
     }
 
-otherDef :: (Color, Color)
-otherDef = (Magenta, Default)
+-- | default title message color and boundaries between multipart refine messages
+otherDef :: (Bool, SColor, SColor)
+otherDef = coerce (True, Default, Default)
 
 nocolor, colorDef :: (String, PColor)
 nocolor = ("nocolor", PColor $ flip const)
 colorDef = fromJust $ getLast $ oColor $ getOptT' @Color5
 
+-- | how much detail to show in the expression tree
 data Debug =
        DZero -- ^ one line summary used mainly for testing
      | DLite -- ^ one line summary with additional context from the head of the evaluation tree
@@ -521,14 +546,6 @@ isVerbose :: POpts -> Bool
 isVerbose = (DVerbose==) . oDebug
 
-markBoundary :: POpts -> String -> String
-markBoundary o =
-  if hasNoColor o then id else coerce (snd (oColor o)) PresentP
-
--- | color flag
-hasNoColor :: POpts -> Bool
-hasNoColor = oNoColor
-
 -- | color palettes
 type Color1 = 'OColor "color1" 'Default 'Blue 'Default 'Red 'Black 'Cyan 'Black 'Yellow
 type Color2 = 'OColor "color2" 'Default 'Magenta 'Default 'Red 'Black 'White 'Black 'Yellow
@@ -536,6 +553,9 @@ type Color4 = 'OColor "color4" 'Default 'Red 'Red 'Default 'Green 'Default 'Black 'Yellow
 type Color5 = 'OColor "color5" 'Blue 'Default 'Red 'Default 'Cyan 'Default 'Yellow 'Default
 
+type Other1 = 'OOther 'True 'Yellow 'Default
+type Other2 = 'OOther 'True 'Default 'Default
+
 -- | fix PresentT Bool to TrueT or FalseT
 fixBoolT :: TT Bool -> TT Bool
 fixBoolT t =
@@ -666,13 +686,15 @@ instance GetROpt 'Utf8 where getROpt = RL.utf8
 instance GetROpt 'No_utf8_check where getROpt = RL.no_utf8_check
 
+-- | simple regex string replacement options
 data ReplaceFnSub = RPrepend | ROverWrite | RAppend deriving (Show,Eq)
 
-class ReplaceFnSubC (k :: ReplaceFnSub) where
+-- | extract replacement options from typelevel
+class GetReplaceFnSub (k :: ReplaceFnSub) where
   getReplaceFnSub :: ReplaceFnSub
-instance ReplaceFnSubC 'RPrepend where getReplaceFnSub = RPrepend
-instance ReplaceFnSubC 'ROverWrite where getReplaceFnSub = ROverWrite
-instance ReplaceFnSubC 'RAppend where getReplaceFnSub = RAppend
+instance GetReplaceFnSub 'RPrepend where getReplaceFnSub = RPrepend
+instance GetReplaceFnSub 'ROverWrite where getReplaceFnSub = ROverWrite
+instance GetReplaceFnSub 'RAppend where getReplaceFnSub = RAppend
 
 -- | used by 'Predicate.ReplaceImpl' and 'RH.sub' and 'RH.gsub' to allow more flexible replacement
 --   These parallel the RegexReplacement (not exported) class in "Text.Regex.PCRE.Heavy" but have overlappable instances which is problematic for this code so I use 'RReplace'
@@ -689,7 +711,7 @@            RReplace2 {} -> "RReplace2 <fn>"
            RReplace3 {} -> "RReplace3 <fn>"
 
--- | extract values from the trees or if there are errors returned a tree with added context
+-- | extract values from the trees or if there are errors return a tree with context
 splitAndAlign :: Show x =>
                     POpts
                     -> String
@@ -704,6 +726,12 @@                        (map (hh . snd) ts)
      ([], tfs) -> Right tfs
 
+groupErrors :: [String] -> String
+groupErrors =
+     intercalate " | "
+   . map (\xs@(x :| _) -> x <> (if length xs > 1 then "(" <> show (length xs) <> ")" else ""))
+   . N.group
+
 partitionTTExtended :: (w, TT a) -> Either ((w, TT x), String) (a, w, TT a)
 partitionTTExtended (s, t) =
   case _tBool t of
@@ -732,28 +760,26 @@               FalseT -> Just False
               FailT {} -> Nothing
 
-groupErrors :: [String] -> String
-groupErrors =
-     intercalate " | "
-   . map (\xs@(x :| _) -> x <> (if length xs > 1 then "(" <> show (length xs) <> ")" else ""))
-   . N.group
-
+-- | 'FailT' prism
 _FailT :: Prism' (BoolT a) String
 _FailT = prism' FailT $ \case
                          FailT s -> Just s
                          _ -> Nothing
 
+-- | 'PresentT' prism
 _PresentT :: Prism' (BoolT a) a
 _PresentT = prism' PresentT $ \case
                                 PresentT a -> Just a
                                 _ -> Nothing
 
+-- | 'FalseT' prism
 _FalseT :: Prism' (BoolT Bool) ()
 _FalseT = prism' (const FalseT) $
             \case
                FalseT -> Just ()
                _ -> Nothing
 
+-- | 'TrueT' prism
 _TrueT :: Prism' (BoolT Bool) ()
 _TrueT = prism' (const TrueT) $
             \case
@@ -773,7 +799,7 @@ --
 -- >>> False ~> True
 -- True
-
+--
 (~>) :: Bool -> Bool -> Bool
 p ~> q = not p || q
 infixr 1 ~>
@@ -789,27 +815,27 @@              ':<>: 'GL.Text " and "
              ':<>: 'GL.ShowType n)
 
--- | helper method to fail with a msg when True
+-- | helper method that fails with a msg when True
 type family FailWhenT (b :: Bool) (msg :: GL.ErrorMessage) :: Constraint where
   FailWhenT 'False _ = ()
   FailWhenT 'True e = GL.TypeError e
 
--- | helper method to fail with msg when False
+-- | helper method that fails with msg when False
 type family FailUnlessT (b :: Bool) (msg :: GL.ErrorMessage) :: Constraint where
   FailUnlessT 'True _ = ()
   FailUnlessT 'False e = GL.TypeError e
 
--- | typelevel And
+-- | typelevel boolean And
 type family AndT (b :: Bool) (b1 :: Bool) :: Bool where
   AndT 'False _ = 'False
   AndT 'True b1 = b1
 
--- | typelevel Or
+-- | typelevel boolean Or
 type family OrT (b :: Bool) (b1 :: Bool) :: Bool where
   OrT 'True _ = 'True
   OrT 'False b1 = b1
 
--- | typelevel Not
+-- | typelevel boolean Not
 type family NotT (b :: Bool) :: Bool where
   NotT 'True = 'False
   NotT 'False = 'True
@@ -893,13 +919,14 @@ instance GetLen xs => GetLen (x ':| xs) where
   getLen = 1 + getLen @xs
 
-
+-- | display constructor name for 'These'
 showThese :: These a b -> String
 showThese = \case
   This {} -> "This"
   That {} -> "That"
   These {} -> "These"
 
+-- | get 'These' from typelevel
 class GetThese th where
   getThese :: (String, These w v -> Bool)
 instance GetThese ('This x) where
@@ -909,18 +936,6 @@ instance GetThese ('These x y) where
   getThese = ("These", isThese)
 
-isThis :: These a b -> Bool
-isThis This {} = True
-isThis _ = False
-
-isThat :: These a b -> Bool
-isThat That {} = True
-isThat _ = False
-
-isThese :: These a b -> Bool
-isThese These {} = True
-isThese _ = False
-
 -- | get ordering from the typelevel
 class GetOrdering (cmp :: Ordering) where
   getOrdering :: Ordering
@@ -931,7 +946,7 @@ instance GetOrdering 'GT where
   getOrdering = GT
 
--- | get Bool from the typelevel
+-- | get 'Bool' from the typelevel
 class GetBool (a :: Bool) where
   getBool :: Bool
 instance GetBool 'True where
@@ -939,7 +954,7 @@ instance GetBool 'False where
   getBool = False
 
--- | get Disp from the typelevel
+-- | get 'Disp' from the typelevel
 class GetDisp (a :: Disp) where
   getDisp :: Disp
 instance GetDisp 'Ansi where
@@ -947,7 +962,7 @@ instance GetDisp 'Unicode where
   getDisp = Unicode
 
--- | get Debug from the typelevel
+-- | get 'Debug' from the typelevel
 class GetDebug (a :: Debug) where
   getDebug :: Debug
 instance GetDebug 'DZero where
@@ -961,7 +976,7 @@ instance GetDebug 'DVerbose where
   getDebug = DVerbose
 
--- | get Color from the typelevel
+-- | get 'Color' from the typelevel
 class GetColor (a :: Color) where
   getColor :: Color
 instance GetColor 'Black where
@@ -983,8 +998,10 @@ instance GetColor 'Default where
   getColor = Default
 
+-- | all the ways to compare two values
 data OrderingP = CGt | CGe | CEq | CLe | CLt | CNe deriving (Show, Eq, Enum, Bounded)
 
+-- | extract 'OrderingP' from the typelevel
 class GetOrd (k :: OrderingP) where
   getOrd :: Ord a => (String, a -> a -> Bool)
 
@@ -995,9 +1012,11 @@ instance GetOrd 'CLt where getOrd = ("<", (<))
 instance GetOrd 'CNe where getOrd = ("/=",(/=))
 
+-- | pretty print a tree
 toNodeString :: POpts -> PE -> String
 toNodeString opts bpe =
-  if hasNoTree opts then errorInProgram $ "shouldnt be calling this if we are dropping details: toNodeString " <> show (oDebug opts) <> " " <> show bpe
+  if hasNoTree opts
+  then errorInProgram $ "shouldnt be calling this if we are dropping details: toNodeString " <> show (oDebug opts) <> " " <> show bpe
   else colorBoolP opts (_pBool bpe) <> " " <> _pString bpe
 
 hasNoTree :: POpts -> Bool
@@ -1013,6 +1032,7 @@ nullSpace s | null s = ""
             | otherwise = " " <> s
 
+-- | render the 'BoolP' value with colors
 colorBoolP :: POpts -> BoolP -> String
 colorBoolP o =
   \case
@@ -1021,8 +1041,9 @@     b@TrueP -> colorMe o b "True"
     b@FalseP -> colorMe o b "False"
 
-colorBoolT' :: Show a => POpts -> BoolT a -> String
-colorBoolT' o r =
+-- | render the 'BoolT' value with colors
+colorBoolT :: Show a => POpts -> BoolT a -> String
+colorBoolT o r =
   let f = colorMe o (r ^. boolT2P)
   in case r of
       FailT e -> f "Error" <> " " <> e
@@ -1030,8 +1051,8 @@       FalseT -> f "False"
       PresentT x -> f "Present" <> " " <> show x
 
-colorBoolT :: Show a => POpts -> BoolT a -> String
-colorBoolT o r =
+colorBoolT' :: Show a => POpts -> BoolT a -> String
+colorBoolT' o r =
   let f = colorMe o (r ^. boolT2P)
   in case r of
       FailT e -> f "FailT" <> " " <> e
@@ -1042,21 +1063,9 @@ -- | colors the result of the predicate based on the current color palette
 colorMe :: POpts -> BoolP -> String -> String
 colorMe o b s =
-  let (_, PColor f) = oColor o
+  let (_, PColor f) = if oNoColor o then nocolor else oColor o
   in f b s
 
-prtTTIO :: POpts -> IO (TT a) -> IO ()
-prtTTIO  = prtTT'
-
-prtTT :: POpts -> Identity (TT a) -> IO ()
-prtTT  = prtTT'
-
-prtTT' :: MonadEval m => POpts -> m (TT a) -> IO ()
-prtTT' o y = liftEval y >>= prtTree o . fromTT
-
-prtTree :: POpts -> Tree PE -> IO ()
-prtTree o = putStr . prtTreePure o
-
 fixLite :: forall a . Show a => POpts -> a -> Tree PE -> String
 fixLite opts a t
   | hasNoTree opts = fixPresentP opts (t ^. root . pBool) a <> "\n"
@@ -1328,6 +1337,7 @@   | OMsg !Symbol      -- ^ set text to add context to a failure message for refined types
   | ORecursion !Nat       -- ^ set recursion limit eg for regex
   | OOther                -- ^ set effects for messages
+     !Bool    -- ^ set underline
      !Color   -- ^ set foreground color
      !Color   -- ^ set background color
   | OEmpty                -- ^ mempty
@@ -1358,7 +1368,7 @@             OWidth _n -> "OWidth"
             OMsg _s -> "OMsg"
             ORecursion _n -> "ORecursion"
-            OOther _c1 _c2 -> "OOther"
+            OOther _b _c1 _c2 -> "OOther"
             OEmpty -> "OEmpty"
             a :# b -> show a ++ " ':# " ++ show b
             OColor _s _c1 _c2 _c3 _c4 _c5 _c6 _c7 _c8 -> "OColor"
@@ -1373,15 +1383,7 @@             OUB -> "OUB"
 
 infixr 6 :#
-{- type families/synonyms expand
-type OZ = 'ODisp 'Ansi ':# 'ONoColor 'True ':# 'ODebug 'DZero
-type OL = 'ODisp 'Ansi ':# 'ONoColor 'True ':# 'ODebug 'DLite
-type OAN = 'ODisp 'Ansi ':# 'ONoColor 'True
-type OA = 'ODisp 'Ansi ':# Color5
-type OAB = 'ODisp 'Ansi ':# Color1
-type OU = 'ODisp 'Unicode ':# Color5
-type OUB = 'ODisp 'Unicode ':# Color1
--}
+
 class OptTC (k :: OptT) where
    getOptT' :: POptsL
 instance GetDebug n => OptTC ('ODebug n) where
@@ -1392,8 +1394,8 @@    getOptT' = setMessage (symb @s)
 instance KnownNat n => OptTC ('ORecursion n) where
    getOptT' = setRecursion (nat @n)
-instance (GetColor c1, GetColor c2) => OptTC ('OOther c1 c2) where
-   getOptT' = setOther (getColor @c1) (getColor @c2)
+instance (GetBool b, GetColor c1, GetColor c2) => OptTC ('OOther b c1 c2) where
+   getOptT' = setOther (getBool @b) (getColor @c1) (getColor @c2)
 instance OptTC 'OEmpty where
    getOptT' = mempty
 instance (OptTC a, OptTC b) => OptTC (a ':# b) where
@@ -1429,13 +1431,13 @@ instance OptTC 'OAN where
    getOptT' = setDisp Ansi <> setNoColor True <> setDebug DNormal
 instance OptTC 'OA where
-   getOptT' = setDisp Ansi <> getOptT' @Color5 <> setDebug DNormal
+   getOptT' = setDisp Ansi <> getOptT' @Color5 <> setDebug DNormal <> getOptT' @Other2
 instance OptTC 'OAB where
-   getOptT' = setDisp Ansi <> getOptT' @Color1 <> setDebug DNormal
+   getOptT' = setDisp Ansi <> getOptT' @Color1 <> setDebug DNormal <> getOptT' @Other1
 instance OptTC 'OU where
-   getOptT' = setDisp Unicode <> getOptT' @Color5 <> setDebug DNormal
+   getOptT' = setDisp Unicode <> getOptT' @Color5 <> setDebug DNormal <> getOptT' @Other2
 instance OptTC 'OUB where
-   getOptT' = setDisp Unicode <> getOptT' @Color1 <> setDebug DNormal
+   getOptT' = setDisp Unicode <> getOptT' @Color1 <> setDebug DNormal <> getOptT' @Other1
 
 -- | convert typelevel options to 'POpts'
 --
@@ -1445,6 +1447,15 @@ -- >>> oMsg (getOptT @('OMsg "abc" ':# 'OMsg "def"))
 -- ["abc","def"]
 --
+-- >>> oOther (getOptT @('OOther 'False 'Red 'White ':# 'OOther 'True 'Red 'Black))
+-- (True,Red,Black)
+--
+-- >>> a = show (getOptT @('OEmpty ':# 'OU))
+-- >>> b = show (getOptT @('OU ':# 'OEmpty));
+-- >>> c = show (getOptT @'OU)
+-- >>> a==b && b==c
+-- True
+--
 getOptT :: forall o . OptTC o => POpts
 getOptT = reifyOpts (getOptT' @o)
 
@@ -1479,7 +1490,7 @@ formatOMsg o suffix =
   case oMsg o of
     [] -> mempty
-    s@(_:_) -> setOtherEffects o (intercalate " | " s) <> suffix
+    s@(_:_) -> intercalate " | " (map (setOtherEffects o) s) <> suffix
 
 subopts :: POpts -> POpts
 subopts opts =
@@ -1490,8 +1501,23 @@ setOtherEffects :: POpts -> String -> String
 setOtherEffects o =
   if oNoColor o then id
-  else case oOther o of
-         (Default, Default) -> id
-         (c1,c2) -> color c1 . bgColor c2
+  else case coerce (oOther o) of
+         (False, Default, Default) -> id
+         (b, c1, c2) -> (if b then style Underline else id) . color c1 . bgColor c2
 
-type family AnyT :: k where {}+type family AnyT :: k where {}
+
+pureTryTest :: a -> IO (Either () a)
+pureTryTest = fmap (left (const ())) . E.try @E.SomeException . E.evaluate
+
+pureTryTestPred :: (String -> Bool) -> a -> IO (Either String (Either () a))
+pureTryTestPred p a = do
+  lr <- left E.displayException <$> E.try @E.SomeException (E.evaluate a)
+  return $ case lr of
+    Left e | p e -> Right (Left ())
+           | otherwise -> Left ("no match found: e=" ++ e)
+    Right r -> Right (Right r)
+
+isPrime :: Int -> Bool
+isPrime n = n==2 || n>2 && all ((> 0).rem n) (2:[3,5 .. floor . sqrt @Double . fromIntegral $ n+1])
+

@@ -12,11 +12,7 @@ {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoOverloadedLists #-} -- overloaded lists breaks some predicates
-{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NoStarIsType #-}
 module TestRefined where
 import TastyExtras

@@ -11,10 +11,8 @@ {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoOverloadedLists #-} -- overloaded lists breaks some predicates
-{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NoStarIsType #-}
 module TestRefined2 where

@@ -11,10 +11,8 @@ {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoOverloadedLists #-} -- overloaded lists breaks some predicates
-{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NoStarIsType #-}
 module TestRefined3 where