predicate-typed 0.7.4.3 → 0.7.4.4

raw patch · 32 files changed

+585/−480 lines, 32 filesdep −constraintsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: constraints

API changes (from Hackage documentation)

Files

• predicate-typed.cabal +3/−7
• src/Predicate/Core.hs +7/−47
• src/Predicate/Data/Bits.hs +0/−1
• src/Predicate/Data/Condition.hs +18/−22
• src/Predicate/Data/Either.hs +2/−2
• src/Predicate/Data/Elr.hs +2/−2
• src/Predicate/Data/Extra.hs +70/−7
• src/Predicate/Data/Foldable.hs +44/−1
• src/Predicate/Data/IO.hs +24/−27
• src/Predicate/Data/Index.hs +0/−1
• src/Predicate/Data/Iterator.hs +6/−6
• src/Predicate/Data/Json.hs +14/−11
• src/Predicate/Data/Lifted.hs +4/−4
• src/Predicate/Data/List.hs +53/−17
• src/Predicate/Data/Maybe.hs +1/−1
• src/Predicate/Data/Monoid.hs +0/−1
• src/Predicate/Data/Numeric.hs +11/−23
• src/Predicate/Data/Ordering.hs +14/−8
• src/Predicate/Data/Proxy.hs +1/−1
• src/Predicate/Data/ReadShow.hs +3/−1
• src/Predicate/Data/Regex.hs +12/−13
• src/Predicate/Data/String.hs +48/−121
• src/Predicate/Data/These.hs +7/−7
• src/Predicate/Elr.hs +1/−1
• src/Predicate/Examples/Common.hs +26/−9
• src/Predicate/Examples/Refined3.hs +30/−3
• src/Predicate/Misc.hs +8/−26
• src/Predicate/Refined.hs +29/−21
• src/Predicate/Refined2.hs +48/−26
• src/Predicate/Refined3.hs +51/−29
• src/Predicate/Refined5.hs +47/−33
• src/Predicate/Util.hs +1/−1

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ce998dc318ca06d53f625b8ae47f833c8bfabd675847d56a78cfa35f25fd9d2b+-- hash: 8623bd3c0ca7069a75570832de0252b98526987f85c470818360b345547a9cff  name:           predicate-typed-version:        0.7.4.3+version:        0.7.4.4 synopsis:       Predicates, Refinement types and Dsl description:    Please see the README on GitHub at <https://github.com/gbwey/predicate-typed#readme> category:       Data@@ -70,7 +70,7 @@       Paths_predicate_typed   hs-source-dirs:       src-  ghc-options: -Wall -Wcompat -Wno-star-is-type -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wunused-type-patterns -Wredundant-constraints+  ghc-options: -Wall -Wcompat -Wno-star-is-type -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wunused-type-patterns -Wredundant-constraints -Wnoncanonical-monad-instances -Wmissing-export-lists   build-depends:       QuickCheck     , aeson@@ -79,13 +79,11 @@     , binary     , bytestring     , comonad-    , constraints     , containers     , deepseq     , directory     , hashable     , lens-    , lens-action     , pcre-heavy >=1.0.0.2     , pcre-light     , pretty-terminal >=0.1.0.0@@ -117,7 +115,6 @@     , binary     , bytestring     , comonad-    , constraints     , containers     , deepseq     , directory@@ -163,7 +160,6 @@     , binary     , bytestring     , comonad-    , constraints     , containers     , deepseq     , directory

@@ -31,7 +31,6 @@   , Map'
   , Map
   , Do
-  , OneP
   , Swap
   , Arg'
 
@@ -128,7 +127,6 @@ import qualified GHC.TypeLits as GL
 import GHC.TypeLits (Symbol,Nat,KnownSymbol,KnownNat,ErrorMessage((:$$:),(:<>:)))
 import Control.Lens
-import Data.Foldable (toList)
 import Data.Proxy (Proxy(..))
 import Data.Typeable (Typeable)
 import Data.Kind (Type)
@@ -273,7 +271,6 @@ 
 -- | run the expression @p@ but remove the subtrees
 data Hide p deriving Show
--- type H p = Hide p -- doesnt work with %   -- unsaturated!
 
 instance P p x => P (Hide p) x where
   type PP (Hide p) x = PP p x
@@ -898,6 +895,9 @@ -- >>> pz @'Proxy 'x' ^!? acts . _Val . to typeRep
 -- Just Char
 --
+-- >>> pz @'Proxy 'x' >>= return . preview (_Val . to typeRep)
+-- Just Char
+--
 -- >>> pz @'Proxy 45 ^!? acts . _Val . to typeRep
 -- Just Integer
 --
@@ -1430,47 +1430,6 @@   type PP (FailP p) x = PP (Fail UnproxyT p) x
   eval _ = eval (Proxy @(Fail UnproxyT p))
 
--- | gets the singleton value from a foldable
---
--- >>> pl @OneP [10..15]
--- Error OneP:expected one element(6)
--- Fail "OneP:expected one element(6)"
---
--- >>> pl @OneP [10]
--- Present 10 (OneP)
--- Val 10
---
--- >>> pl @OneP []
--- Error OneP:expected one element(empty)
--- Fail "OneP:expected one element(empty)"
---
--- >>> pl @OneP (Just 10)
--- Present 10 (OneP)
--- Val 10
---
--- >>> pl @OneP Nothing
--- Error OneP:expected one element(empty)
--- Fail "OneP:expected one element(empty)"
---
-data OneP deriving Show
-
-instance ( Foldable t
-         , x ~ t a
-         ) => P OneP x where
-  type PP OneP x = ExtractAFromTA x
-  eval _ opts x = do
-    let msg0 = "OneP"
-    pure $ case toList x of
-      [] -> mkNode opts (Fail (msg0 <> ":expected one element(empty)")) "" []
-      [a] -> mkNode opts (Val a) msg0 []
-      as' -> case chkSize opts msg0 as' [] of
-               Left e -> e
-               Right (asLen,_) ->
-                 mkNode opts (Fail (msg0 <> ":expected one element(" <> show asLen <> ")")) "" []
-
---type OneP = Guard "expected list of length 1" (Len == 1) >> Head
---type OneP = Guard (PrintF "expected list of length 1 but found length=%d" Len) (Len == 1) >> Head
-
 -- | A predicate that determines if the value is between @p@ and @q@
 --
 -- >>> pz @(Between 5 8 Len) [1,2,3,4,5,5,7]
@@ -1510,9 +1469,10 @@           Left e -> e
           Right (p,q,pp,qq) ->
             let hhs = [hh rr, hh pp, hh qq]
-            in if p <= r && r <= q then mkNodeB opts True (showL opts p <> " <= " <> showL opts r <> " <= " <> showL opts q) hhs
-               else if p > r then mkNodeB opts False (showL opts p <> " <= " <> showL opts r) hhs
-               else mkNodeB opts False (showL opts r <> " <= " <> showL opts q) hhs
+            in case (compare r p, compare r q) of
+                 (LT,_) -> mkNodeB opts False (showL opts p <> " <= " <> showL opts r) hhs
+                 (_,GT) -> mkNodeB opts False (showL opts r <> " <= " <> showL opts q) hhs
+                 _ -> mkNodeB opts True (showL opts p <> " <= " <> showL opts r <> " <= " <> showL opts q) hhs
 
 
 -- | A operator predicate that determines if the value is between @p@ and @q@

@@ -19,7 +19,6 @@ {-# LANGUAGE DerivingStrategies #-}
 -- | promoted bit manipulation functions
 module Predicate.Data.Bits (
-  -- ** functions
     type (.&.)
   , type (.|.)
   , type (.^.)

@@ -386,11 +386,11 @@         n = getLen @ps
     case chkSize opts msg0 as' [] of
       Left e -> pure e
-      Right (asLen,as) ->
-        if n /= asLen then
-           let msg1 = msg0 <> badLength asLen n
-           in pure $ mkNode opts (Fail msg1) "" []
-        else eval (Proxy @(GuardsImpl (LenT ps) ps)) opts as
+      Right (asLen,as)
+           | n == asLen -> eval (Proxy @(GuardsImpl (LenT ps) ps)) opts as
+           | otherwise ->
+               let msg2 = msg0 <> badLength asLen n
+               in pure $ mkNode opts (Fail msg2) "" []
 
 instance ( [a] ~ x
          , Show a
@@ -528,17 +528,17 @@          , PP (BoolsImpl (LenT ps) ps) x ~ Bool
          ) => P (Bools ps) x where
   type PP (Bools ps) x = Bool
-  eval _ opts as = do
+  eval _ opts as' = do
     let msg0 = "Bools"
         msg1 = "Bool(" <> show (n-1) <> ")"
         n = getLen @ps
-    case chkSize opts msg1 as [] of
+    case chkSize opts msg1 as' [] of
       Left e -> pure e
-      Right (wsLen,ws) ->
-        if n /= wsLen then
-           let msg2 = msg0 <> badLength wsLen n
-           in pure $ mkNode opts (Fail msg2) "" []
-        else evalBool (Proxy @(BoolsImpl (LenT ps) ps)) opts ws
+      Right (asLen,as)
+           | n == asLen -> evalBool (Proxy @(BoolsImpl (LenT ps) ps)) opts as
+           | otherwise ->
+               let msg2 = msg0 <> badLength asLen n
+               in pure $ mkNode opts (Fail msg2) "" []
 
 data BoolsImpl (n :: Nat) (os :: [(k,k1)]) deriving Show
 
@@ -649,11 +649,11 @@         n = getLen @ps
     case chkSize opts msg0 as' [] of
       Left e -> pure e
-      Right (asLen,as) ->
-        if n /= asLen then
-           let msg1 = msg0 <> badLength asLen n
-           in pure $ mkNode opts (Fail msg1) "" []
-        else eval (Proxy @(GuardsImpl (LenT ps) ps)) opts as
+      Right (asLen,as)
+           | n == asLen -> eval (Proxy @(GuardsImpl (LenT ps) ps)) opts as
+           | otherwise ->
+               let msg1 = msg0 <> badLength asLen n
+               in pure $ mkNode opts (Fail msg1) "" []
 
 -- | if a predicate fails then then the corresponding symbol and value will be passed to the print function
 --
@@ -856,11 +856,7 @@ -- | similar to 'Guard' but uses the root message of the False predicate case as the failure message
 --
 -- >>> pz @(GuardSimple IsLuhn) [1..4]
--- Fail "(IsLuhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])"
---
--- >>> pl @IsLuhn [1..4]
--- False (IsLuhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])
--- Val False
+-- Fail "(IsLuhn map=[2,2,6,4] sum=14 ret=4 | [1,2,3,4])"
 --
 -- >>> pz @(GuardSimple IsLuhn) [1,2,3,0]
 -- Val [1,2,3,0]

@@ -17,7 +17,7 @@ -- | promoted 'Either' functions
 module Predicate.Data.Either (
 
- -- ** boolean predicates
+ -- ** predicates
     IsLeft
   , IsRight
 
@@ -45,7 +45,7 @@   , LeftDef'
   , RightDef'
 
- -- type families
+ -- ** type families
   , EitherInT
  ) where
 import Predicate.Core

@@ -45,7 +45,7 @@   , MkELeft'
   , MkERight'
 
- -- ** boolean predicates
+ -- ** predicates
   , IsENone
   , IsELeft
   , IsERight
@@ -492,7 +492,7 @@ -- >>> pz @(ElrId '(999,"oops") '(Id,"fromleft") '(888,Id) Id) (ELeft 123)
 -- Val (123,"fromleft")
 --
--- >>> pl @(ElrId (FailT _ "none found" ) '(Id,"fromleft") '(888,Id) Id) ENone
+-- >>> pl @(ElrId (FailT _ "none found") '(Id,"fromleft") '(888,Id) Id) ENone
 -- Error none found (ElrIn(ENone) n failed)
 -- Fail "none found"
 --

@@ -40,6 +40,7 @@ 
  -- ** luhn check
   , IsLuhn
+  , LuhnDigit
  ) where
 import Predicate.Core
 import Predicate.Misc
@@ -50,6 +51,7 @@ import Control.Lens
 import qualified Safe (headNote)
 import Data.Proxy (Proxy(..))
+import Data.Bool (bool)
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -452,6 +454,14 @@ 
 -- | IsLuhn predicate check on last digit
 --
+-- >>> pl @IsLuhn [9,8,7,5,6]
+-- True (IsLuhn map=[9,7,7,1,6] sum=30 ret=0 | [9,8,7,5,6])
+-- Val True
+--
+-- >>> pl @IsLuhn [9,8,7,5,4]
+-- False (IsLuhn map=[9,7,7,1,4] sum=28 ret=8 | [9,8,7,5,4])
+-- Val False
+--
 -- >>> pz @IsLuhn [1,2,3,0]
 -- Val True
 --
@@ -459,12 +469,15 @@ -- Val False
 --
 -- >>> pz @(GuardSimple IsLuhn) [15,4,3,1,99]
--- Fail "(IsLuhn map=[90,2,3,8,6] sum=109 ret=9 | [15,4,3,1,99])"
+-- Fail "(IsLuhn map=[6,8,3,2,90] sum=109 ret=9 | [15,4,3,1,99])"
 --
 -- >>> pl @IsLuhn [15,4,3,1,99]
--- False (IsLuhn map=[90,2,3,8,6] sum=109 ret=9 | [15,4,3,1,99])
+-- False (IsLuhn map=[6,8,3,2,90] sum=109 ret=9 | [15,4,3,1,99])
 -- Val False
 --
+-- >>> pz @(Ones >> Map (ReadP Int Id) >> IsLuhn) "9501234400008"
+-- Val True
+--
 data IsLuhn deriving Show
 
 instance x ~ [Int]
@@ -474,11 +487,61 @@     let msg0 = "IsLuhn"
     in pure $ case chkSize opts msg0 x [] of
          Left e -> e
-         Right (_,ws) ->
-          let xs = zipWith (*) (ws ^. reversed) (cycle' [1,2])
-              ys = map (\w -> if w>=10 then w-9 else w) xs
+         Right (wsLen,ws) ->
+          let ys = luhnImpl (even wsLen) ws
               z = sum' ys
               ret = z `mod` 10
-          in if ret == 0 then mkNodeB opts True (joinStrings msg0 (showL opts ws)) []
-             else mkNodeB opts False (msg0 <> " map=" <> showL opts ys <> " sum=" <> showL opts z <> " ret=" <> showL opts ret <> showVerbose opts " | " ws) []
+          in mkNodeB opts (ret == 0) (msg0 <> " map=" <> showL opts ys <> " sum=" <> showL opts z <> " ret=" <> showL opts ret <> showVerbose opts " | " ws) []
+
+-- | get Luhn check digit
+--
+-- >>> pz @(Ones >> Map (ReadP Int Id) >> LuhnDigit) "7992739871"
+-- Val 3
+--
+-- >>> pl @LuhnDigit [9,8,7,6]
+-- Present 4 (LuhnDigit map=[9,7,7,3] sum=26 | sum*9=234 | mod 10=4 | [9,8,7,6])
+-- Val 4
+--
+-- >>> pz @LuhnDigit [1,2,3]
+-- Val 0
+--
+-- >>> pz @(Ones >> Map (ReadP Int Id) >> LuhnDigit) "950123440000"
+-- Val 8
+--
+-- >>> pz @(Ones >> Map (ReadP Int Id) >> GuardSimple (Len == 18) >> '(Id,Drop 6 Id) >> Both LuhnDigit) "896101950123440000"
+-- Val (1,8)
+--
+-- >>> pz @(Ones >> Map (ReadP Int Id) >> GuardSimple (Len == 18) >> '(Id,Drop 6 Id) >> Both LuhnDigit) "89610195012344000"
+-- Fail "(17 == 18)"
+--
+-- >>> pz @(Ones >> Map (ReadP Int Id) >> GuardSimple (Len == 18) >> '(Id,Drop 6 Id) >> Both LuhnDigit >> GuardSimple (Id == '(2,8))) "896101950123440000"
+-- Fail "((1,8) == (2,8))"
+--
+-- >>> pz @(Ones >> Map (ReadP Int Id) >> GuardSimple (Len == 20) >> SplitAt 18 Id >> '(LuhnDigit << Fst,LuhnDigit << Drop 6 Fst,Snd) >> GuardSimple (Thd == '[ Fst, Snd ])) "89610195012344000018"
+-- Val (1,8,[1,8])
+--
+-- >>> pl @(IterateNWhile 5 'True (Id +: LuhnDigit) >> Map IsLuhn) [1]
+-- Present [False,True,True,True,True] ((>>) [False,True,True,True,True] | {Map [False,True,True,True,True] | [[1],[1,8],[1,8,2],[1,8,2,6],[1,8,2,6,7]]})
+-- Val [False,True,True,True,True]
+--
+data LuhnDigit deriving Show
+
+instance x ~ [Int]
+         => P LuhnDigit x where
+  type PP LuhnDigit x = Int
+  eval _ opts x =
+    let msg0 = "LuhnDigit"
+    in pure $ case chkSize opts msg0 x [] of
+         Left e -> e
+         Right (wsLen,ws) ->
+          let ys = luhnImpl (odd wsLen) ws
+              z = sum' ys
+              ret = (z*9) `mod` 10
+          in mkNode opts (Val ret) (msg0 <> " map=" <> showL opts ys <> " sum=" <> showL opts z <> " | sum*9=" <> showL opts (z*9) <> " | mod 10=" <> showL opts ret <> showVerbose opts " | " ws) []
+
+luhnImpl :: Bool -> [Int] -> [Int]
+luhnImpl b ws =
+  let xs = zipWith (*) ws (cycle' (bool [1,2] [2,1] b))
+  in map (ifM (>=10) (subtract 9) id) xs
+ -- in map (\w -> if w>=10 then w-9 else w) xs
 

@@ -17,7 +17,6 @@ {-# LANGUAGE ViewPatterns #-}
 -- | promoted foldable functions
 module Predicate.Data.Foldable (
-  -- ** functions
     Concat
   , ConcatMap
   , Cycle
@@ -35,6 +34,8 @@ 
   , ToNEList
 
+  , OneP
+
   , Null
   , Null'
   , IsEmpty
@@ -364,6 +365,7 @@ -- Val [9,2,7,4]
 --
 data ToList deriving Show
+
 instance ( Show (t a)
          , Foldable t
          ) => P ToList (t a) where
@@ -608,4 +610,45 @@                      Nothing -> ""
                      Just i -> " i="++show i
            in mkNodeB opts (or x) (msg1 <> w <> showVerbose opts " | " x) []
+
+-- | gets the singleton value from a foldable
+--
+-- >>> pl @OneP [10..15]
+-- Error OneP:expected one element(6)
+-- Fail "OneP:expected one element(6)"
+--
+-- >>> pl @OneP [10]
+-- Present 10 (OneP)
+-- Val 10
+--
+-- >>> pl @OneP []
+-- Error OneP:expected one element(empty)
+-- Fail "OneP:expected one element(empty)"
+--
+-- >>> pl @OneP (Just 10)
+-- Present 10 (OneP)
+-- Val 10
+--
+-- >>> pl @OneP Nothing
+-- Error OneP:expected one element(empty)
+-- Fail "OneP:expected one element(empty)"
+--
+data OneP deriving Show
+
+instance ( Foldable t
+         , x ~ t a
+         ) => P OneP x where
+  type PP OneP x = ExtractAFromTA x
+  eval _ opts x = do
+    let msg0 = "OneP"
+    pure $ case toList x of
+      [] -> mkNode opts (Fail (msg0 <> ":expected one element(empty)")) "" []
+      [a] -> mkNode opts (Val a) msg0 []
+      as' -> case chkSize opts msg0 as' [] of
+               Left e -> e
+               Right (asLen,_) ->
+                 mkNode opts (Fail (msg0 <> ":expected one element(" <> show asLen <> ")")) "" []
+
+--type OneP = Guard "expected list of length 1" (Len == 1) >> Head
+--type OneP = Guard (PrintF "expected list of length 1 but found length=%d" Len) (Len == 1) >> Head
 

@@ -56,7 +56,7 @@ import Control.Arrow (ArrowChoice(left))
 import Data.Time (UTCTime, ZonedTime, getCurrentTime, getZonedTime)
 import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
-import System.IO (hPutStr, withFile, IOMode(WriteMode, AppendMode))
+import System.IO (hPutStr, withFile, IOMode(WriteMode, AppendMode), stderr)
 import System.Environment (getEnvironment, lookupEnv)
 import qualified Data.ByteString.Char8 as BS8
 -- $setup
@@ -87,12 +87,11 @@       Left e -> pure e
       Right p -> do
         let msg1 = msg0 <> "[" <> p <> "]"
-        mb <- runIO $ do
-                b <- doesFileExist p
-                if b then Just <$> readFile p
-                else pure Nothing
+        mb <- runIO $ ifM (doesFileExist p)
+                          (Just <$> readFile p)
+                          mempty
         pure $ case mb of
-          Nothing -> mkNode opts (Fail msg1) "" [hh pp]
+          Nothing -> mkNode opts (Fail (msg1 <> " must run in IO")) "" [hh pp]
           Just Nothing -> mkNode opts (Val Nothing) (msg1 <> " does not exist") [hh pp]
           Just (Just b) -> mkNode opts (Val (Just b)) (msg1 <> " len=" <> show (length b) <> " Just " <> litL opts b) [hh pp]
 
@@ -110,12 +109,11 @@       Left e -> pure e
       Right p -> do
         let msg1 = msg0 <> "[" <> p <> "]"
-        mb <- runIO $ do
-                b <- doesFileExist p
-                if b then Just <$> BS8.readFile p
-                else pure Nothing
+        mb <- runIO $ ifM (doesFileExist p)
+                          (Just <$> BS8.readFile p)
+                          mempty
         pure $ case mb of
-          Nothing -> mkNode opts (Fail msg1) "" [hh pp]
+          Nothing -> mkNode opts (Fail (msg1 <> " must run in IO")) "" [hh pp]
           Just Nothing -> mkNode opts (Val Nothing) (msg1 <> " does not exist") [hh pp]
           Just (Just b) -> mkNode opts (Val (Just b)) (msg1 <> " len=" <> show (BS8.length b) <> " Just " <> litBS opts b) [hh pp]
 
@@ -155,20 +153,23 @@       Left e -> pure e
       Right p -> do
         let msg1 = msg0 <> "[" <> p <> "]"
-        mb <- runIO $ do
-                b <- doesDirectoryExist p
-                if b then Just <$> listDirectory p
-                else pure Nothing
+        mb <- runIO $ ifM (doesDirectoryExist p)
+                          (Just <$> listDirectory p)
+                          mempty
         pure $ case mb of
-          Nothing -> mkNode opts (Fail msg1) "" [hh pp]
+          Nothing -> mkNode opts (Fail (msg1 <> " must run in IO")) "" [hh pp]
           Just Nothing -> mkNode opts (Val Nothing) (msg1 <> " does not exist") [hh pp]
           Just (Just b) -> mkNode opts (Val (Just b)) (msg1 <> " len=" <> show (length b) <> " Just " <> showL opts b) [hh pp]
 
 -- | read an environment variable: similar to 'System.Environment.getEnv'
 --
--- >>> pz @(ReadEnv "PATH" >> 'Just Id >> 'True) ()
+-- >>> pz @(ReadEnv "PATH" >> Just' >> Not Null) ()
 -- Val True
 --
+-- >>> pl @(ReadEnv "xyzzy") ()
+-- Present Nothing (ReadEnv[xyzzy] does not exist)
+-- Val Nothing
+--
 data ReadEnv p deriving Show
 
 instance ( PP p x ~ String
@@ -184,7 +185,7 @@         let msg1 = msg0 <> "[" <> p <> "]"
         mb <- runIO $ lookupEnv p
         pure $ case mb of
-          Nothing -> mkNode opts (Fail msg1) "" [hh pp]
+          Nothing -> mkNode opts (Fail (msg1 <> " must run in IO")) "" [hh pp]
           Just Nothing -> mkNode opts (Val Nothing) (msg1 <> " does not exist") [hh pp]
           Just (Just v) -> mkNode opts (Val (Just v)) (msg1 <> " " <> litL opts v) [hh pp]
 
@@ -304,8 +305,8 @@       Left e -> pure e
       Right ss -> do
           mb <- runIO $ case fh of
-                  FStdout -> fmap (left show) $ E.try @E.SomeException $ putStr ss
-                  FStderr -> fmap (left show) $ E.try @E.SomeException $ putStr ss
+                  FStdout -> left E.displayException <$> E.try @E.SomeException (putStr ss)
+                  FStderr -> left E.displayException <$> E.try @E.SomeException (hPutStr stderr ss)
                   FOther s w -> do
                      b <- doesFileExist s
                      if b && w == WFWrite then pure $ Left $ "file [" <> s <> "] already exists"
@@ -314,7 +315,7 @@                                        WFAppend -> AppendMode
                                        WFWrite -> WriteMode
                                        WFWriteForce -> WriteMode
-                            fmap (left show) $ E.try @E.SomeException $ withFile s md (`hPutStr` ss)
+                            left E.displayException <$> E.try @E.SomeException (withFile s md (`hPutStr` ss))
           pure $ case mb of
             Nothing -> mkNode opts (Fail (msg0 <> " must run in IO")) "" [hh pp]
             Just (Left e) -> mkNode opts (Fail $ msg0 <> ":" <> e) "" [hh pp]
@@ -333,13 +334,9 @@   type PP Stdin x = String
   eval _ opts _ = do
     let msg0 = "Stdin"
-    mb <- runIO $ do
-                      lr <- E.try getLine
-                      pure $ case lr of
-                        Left (e :: E.SomeException) -> Left $ show e
-                        Right ss -> Right ss
+    mb <- runIO $ E.try @E.SomeException getLine
     pure $ case mb of
       Nothing -> mkNode opts (Fail (msg0 <> " must run in IO")) "" []
-      Just (Left e) -> mkNode opts (Fail $ msg0 <> ":" <> e) "" []
+      Just (Left e) -> mkNode opts (Fail $ msg0 <> ":" <> E.displayException e) "" []
       Just (Right ss) -> mkNode opts (Val ss) (msg0 <> "[" <> litVerbose opts "" ss <> "]") []
 

@@ -16,7 +16,6 @@ {-# LANGUAGE EmptyDataDeriving #-}
 -- | promoted indexing functions
 module Predicate.Data.Index (
-  -- ** functions
     Ix
   , Ix'
   , IxL

@@ -352,7 +352,7 @@                    Left e -> mkNodeCopy opts e msg1 (hh qq : map (hh . prefixNumberToTT) itts)
                    Right () ->
                      let ret = fst <$> catMaybes vals
-                     in mkNode opts (Val ret) (show3' opts msg1 ret "s=" q ) (hh qq : map (hh . prefixNumberToTT) itts)
+                     in mkNode opts (Val ret) (show3' opts msg1 ret "s=" q) (hh qq : map (hh . prefixNumberToTT) itts)
 
 type family UnfoldrT (mbs :: Type) where
   UnfoldrT (Maybe (b, _)) = b
@@ -471,11 +471,11 @@         n = getLen @ps
     case chkSize opts msg0 as' [] of
       Left e -> pure e
-      Right (asLen,as) ->
-        if n /= asLen then
-           let msg1 = msg0 <> badLength asLen n
-           in pure $ mkNode opts (Fail msg1) "" []
-        else eval (Proxy @(ParaImpl (LenT ps) ps)) opts as
+      Right (asLen,as)
+           | n == asLen -> eval (Proxy @(ParaImpl (LenT ps) ps)) opts as
+           | otherwise ->
+               let msg1 = msg0 <> badLength asLen n
+               in pure $ mkNode opts (Fail msg1) "" []
 
 -- only allow non empty lists -- might need [a] ~ x but it seems fine
 instance GL.TypeError ('GL.Text "ParaImpl '[] invalid: requires at least one value in the list")

@@ -16,13 +16,15 @@ {-# LANGUAGE EmptyDataDeriving #-}
 -- | promoted json encoding and decoding functions
 module Predicate.Data.Json (
-  -- ** functions
+  -- ** parse
     ParseJson'
   , ParseJson
-  , EncodeJson
-  , EncodeJsonFile
   , ParseJsonFile'
   , ParseJsonFile
+
+  -- ** encode
+  , EncodeJson
+  , EncodeJsonFile
  ) where
 import Predicate.Core
 import Predicate.Misc
@@ -35,6 +37,7 @@ import qualified Data.ByteString.Char8 as BS8
 import qualified Data.ByteString.Lazy.Char8 as BL8
 import System.Directory (doesFileExist)
+import Data.Bool (bool)
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -63,7 +66,7 @@             msg1 = msg0 <> "(" ++ litBL opts { oWidth = oWidth opts `div` 3 } s ++ ")"
         in case A.eitherDecode' s of
            Right b -> mkNode opts (Val b) (msg0 <> " " ++ showL opts { oWidth = oWidth opts `div` 2 } b) hhs
-           Left e -> mkNode opts (Fail (msg1 <> " " <> e) ) (litBL opts s) hhs
+           Left e -> mkNode opts (Fail (msg1 <> " " <> e)) (litBL opts s) hhs
 
 -- | parse json data using the type @t@
 --
@@ -113,12 +116,12 @@       Right p -> do
         let hhs = [hh pp]
             msg1 = msg0 <> "(" <> p <> ")"
-        mb <- runIO $ do
-                b <- doesFileExist p
-                if b then Just <$> BS8.readFile p
-                else pure Nothing
+        mb <- runIO $
+                ifM (doesFileExist p)
+                    (Just <$> BS8.readFile p)
+                    mempty
         pure $ case mb of
-          Nothing -> mkNode opts (Fail msg1) "" hhs
+          Nothing -> mkNode opts (Fail (msg1 <> " must run in IO")) "" hhs
           Just Nothing -> mkNode opts (Fail (msg1 <> " file does not exist")) "" hhs
           Just (Just s) ->
             case A.eitherDecodeStrict' s of
@@ -161,7 +164,7 @@     pure $ case getValueLR NoInline opts msg0 pp [] of
       Left e -> e
       Right p ->
-        let d = (if pretty then AP.encodePretty else A.encode) p
+        let d = bool A.encode AP.encodePretty pretty p
         in mkNode opts (Val d) (msg0 <> " " <> litL opts (litBL opts d)) [hh pp]
 
 -- | encode a json file with pretty option
@@ -181,7 +184,7 @@     case lr of
       Left e -> pure e
       Right (p,q,pp,qq) -> do
-        let d = (if pretty then AP.encodePretty else A.encode) q
+        let d = bool A.encode AP.encodePretty pretty q
             hhs = [hh pp, hh qq]
         mb <- runIO $ BL8.writeFile p d
         pure $ case mb of

@@ -320,7 +320,7 @@ 
 -- | creates an empty list for the given pointer to a type @t@
 --
--- >>> pz @(EmptyList' 123 <> '[Id]) 99
+-- >>> pz @(EmptyList' 123 +: Id) 99
 -- Val [99]
 --
 data EmptyList' (t :: k) deriving Show
@@ -1117,7 +1117,7 @@ -- >>> pz @(FPair Fst Snd >> FMap (Fst + Snd)) (Just 10, Just 13)
 -- Val (Just 23)
 --
--- >>> pz @(FPair (EnumFromTo Fst Snd) ('LT ... 'GT) ) (10,11)
+-- >>> pz @(FPair (EnumFromTo Fst Snd) ('LT ... 'GT)) (10,11)
 -- Val [(10,LT),(10,EQ),(10,GT),(11,LT),(11,EQ),(11,GT)]
 --
 data FPair p q deriving Show
@@ -1517,10 +1517,10 @@ -- Present (["hap"],["bcd"]) (BiFoldMap(B) '(["hap"],[]) | '([],["bcd"]))
 -- Val (["hap"],["bcd"])
 --
--- >>> pz @(BiFoldMap '( Wrap (SG.Sum _) Id, MEmptyT _) '( MEmptyT _, Id)) (SG.Arg 123 "xyz")
+-- >>> pz @(BiFoldMap '(Wrap (SG.Sum _) Id, MEmptyT _) '(MEmptyT _, Id)) (SG.Arg 123 "xyz")
 -- Val (Sum {getSum = 123},"xyz")
 --
--- >>> pl @(BiFoldMap '( Wrap (SG.Sum _) Id, MEmptyT _) '( MEmptyT _, Id)) (Left 123)
+-- >>> pl @(BiFoldMap '(Wrap (SG.Sum _) Id, MEmptyT _) '(MEmptyT _, Id)) (Left 123)
 -- Present (Sum {getSum = 123},()) (BiFoldMap(L) '(Sum {getSum = 123},()))
 -- Val (Sum {getSum = 123},())
 --

@@ -516,7 +516,7 @@                      let kvs = map (view _1 &&& ((:[]) . view (_2 . _2))) abcs
                          itts = map (view _2 &&& view _3) abcs
                          ret = M.fromListWith (++) kvs
-                     in mkNode opts (Val ret) (show3' opts msg0 ret "s=" q ) (hh qq : map (hh . prefixNumberToTT) itts)
+                     in mkNode opts (Val ret) (show3' opts msg0 ret "s=" q) (hh qq : map (hh . prefixNumberToTT) itts)
 
 -- | similar to 'Data.List.groupBy'
 --
@@ -612,7 +612,7 @@                    Right abcs ->
                      let ret = gp1 x abcs
                          itts = map (view _2 &&& view _3) abcs
-                     in mkNode opts (Val ret) (show3' opts msg0 ret "s=" q ) (hh qq : map (hh . prefixNumberToTT) itts)
+                     in mkNode opts (Val ret) (show3' opts msg0 ret "s=" q) (hh qq : map (hh . prefixNumberToTT) itts)
 
 -- | version of 'GroupCnt' that retains the original ordering
 --
@@ -640,7 +640,7 @@   eval _ opts zs =
     let msg0 = "GroupCntStable"
         xs = map (NE.head &&& length) $ NE.group $ sortOn (ys M.!) zs
-        ys = M.fromListWith (flip const) $ zip zs [0::Int ..]
+        ys = M.fromListWith (const id) $ zip zs [0::Int ..]
     in pure $ mkNode opts (Val xs) msg0 []
 
 
@@ -684,8 +684,8 @@   go ret =
      \case
        [] -> [ret]
-       (tf, (_, a), _):as -> if tf then go (ret <> [a]) as
-                             else ret : go [a] as
+       (tf, (_, a), _):as | tf -> go (ret <> [a]) as
+                          | otherwise -> ret : go [a] as
 
 -- | similar to 'Data.List.filter'
 --
@@ -951,7 +951,7 @@          ) => P (PadImpl left n p q) a where
   type PP (PadImpl left n p q) a = PP q a
   eval _ opts a = do
-    let msg0 = "Pad" <> (if lft then "L" else "R")
+    let msg0 = "Pad" <> bool "R" "L" lft
         lft = getBool @left
     lr <- runPQ NoInline msg0 (Proxy @n) (Proxy @p) opts a []
     case lr of
@@ -967,9 +967,7 @@               Left e -> e
               Right (qLen,q) ->
                 let diff = if n<=qLen then 0 else n-qLen
-                    bs = if lft
-                         then replicate diff p <> q
-                         else q <> replicate diff p
+                    bs = bool (q <>) (<> q) lft (replicate diff p)
                 in mkNode opts (Val bs) (show3 opts msg1 bs q) (hhs <> [hh qq])
 
 -- | left pad @q@ with @n@ values from @p@
@@ -1204,7 +1202,7 @@           Right p ->
             let hhs1 = hhs ++ [hh pp]
             in if n <= 0 then mkNode opts (Fail (msg0 <> " n<=0")) "" hhs1
-               else if i < 1 then mkNode opts (Fail (msg0 <> " i<1")) "" hhs1
+               else if i <= 0 then mkNode opts (Fail (msg0 <> " i<=0")) "" hhs1
                else let ret = unfoldr (\s -> if null s then Nothing else Just (take n s,drop i s)) p
                     in mkNode opts (Val ret) (show3' opts msg1 ret "n,i=" (n,i) <> showVerbose opts " | " p) hhs1
 
@@ -1222,7 +1220,7 @@          ) => P (KeepImpl keep p q) x where
   type PP (KeepImpl keep p q) x = PP q x
   eval _ opts x = do
-    let msg0 = if keep then "Keep" else "Remove"
+    let msg0 = bool "Remove" "Keep" keep
         keep = getBool @keep
     lr <- runPQ NoInline msg0 (Proxy @p) (Proxy @q) opts x []
     pure $ case lr of
@@ -1658,8 +1656,8 @@         let hhs = [hh qq, hh rr]
         in case chkSize2 opts msg0 q' r' hhs of
           Left e -> pure e
-          Right ((qLen,q),(rLen,r)) -> do
-            if qLen == rLen then do
+          Right ((qLen,q),(rLen,r))
+            | qLen == rLen -> do
                ts <- zipWithM (\i (x,y) -> ((i, (x,y)),) <$> evalHide @p opts (x,y)) [0::Int ..] (zip q r)
                pure $ case splitAndAlign opts msg0 ts of
                  Left e -> e
@@ -1667,11 +1665,11 @@                    let kvs = map (view _1 &&& ((:[]) . view (_2 . _2))) abcs
                        itts = map (view _2 &&& view _3) abcs
                        ret = map fst kvs
-                   in mkNode opts (Val ret) (show3' opts msg0 ret "s=" q ) (hh qq : map (hh . prefixNumberToTT) itts)
+                   in mkNode opts (Val ret) (show3' opts msg0 ret "s=" q) (hh qq : map (hh . prefixNumberToTT) itts)
 
-             else do
+            | otherwise ->
                    let msg1 = msg0 ++ show (qLen,rLen)
-                   pure $ mkNode opts (Fail (msg1 <> " length mismatch")) (showVerbose opts "q=" q <> showVerbose opts " | r=" r) hhs
+                   in pure $ mkNode opts (Fail (msg1 <> " length mismatch")) (showVerbose opts "q=" q <> showVerbose opts " | r=" r) hhs
 
 -- | Zip two lists to their maximum length using optional padding
 --
@@ -2018,6 +2016,17 @@ -- False (IsPrefix | [2,3] [1,2,3])
 -- Val False
 --
+-- >>> pl @(IsPrefix "xy" Id) "xyzabw"
+-- True (IsPrefix | "xy" "xyzabw")
+-- Val True
+--
+-- >>> pl @(IsPrefix "ab" Id) "xyzbaw"
+-- False (IsPrefix | "ab" "xyzbaw")
+-- Val False
+--
+-- >>> pz @(IsPrefix "abc" "aBcbCd") ()
+-- Val False
+--
 data IsPrefix p q deriving Show
 type IsPrefixT p q = IsFixImpl 'LT p q
 
@@ -2035,6 +2044,22 @@ -- False (IsInfix | [2,3] [1,2,1,3])
 -- Val False
 --
+-- >>> pl @(IsInfix "ab" Id) "xyzabw"
+-- True (IsInfix | "ab" "xyzabw")
+-- Val True
+--
+-- >>> pl @(IsInfix "aB" Id) "xyzAbw"
+-- False (IsInfix | "aB" "xyzAbw")
+-- Val False
+--
+-- >>> pl @(IsInfix "ab" Id) "xyzbaw"
+-- False (IsInfix | "ab" "xyzbaw")
+-- Val False
+--
+-- >>> pl @(IsInfix Fst Snd) ("ab","xyzabw")
+-- True (IsInfix | "ab" "xyzabw")
+-- Val True
+--
 data IsInfix p q deriving Show
 type IsInfixT p q = IsFixImpl 'EQ p q
 
@@ -2052,6 +2077,17 @@ -- False (IsSuffix | [2,3] [2,3,4])
 -- Val False
 --
+-- >>> pl @(IsSuffix "bw" Id) "xyzabw"
+-- True (IsSuffix | "bw" "xyzabw")
+-- Val True
+--
+-- >>> pl @(IsSuffix "bw" Id) "xyzbaw"
+-- False (IsSuffix | "bw" "xyzbaw")
+-- Val False
+--
+-- >>> pz @(IsSuffix "bCd" "aBcbCd") ()
+-- Val True
+--
 data IsSuffix p q deriving Show
 type IsSuffixT p q = IsFixImpl 'GT p q
 
@@ -2084,7 +2120,7 @@ 
 -- | zip cartesian product for lists: see 'Predicate.Data.Extra.LiftA2' for Applicative version
 --
--- >>> pz @(ZipCartesian (EnumFromTo Fst Snd) ('LT ... 'GT) ) (10,11)
+-- >>> pz @(ZipCartesian (EnumFromTo Fst Snd) ('LT ... 'GT)) (10,11)
 -- Val [(10,LT),(10,EQ),(10,GT),(11,LT),(11,EQ),(11,GT)]
 --
 -- >>> pz @(ZipCartesian '[ '() ] (1 ... 5)) True

@@ -17,7 +17,7 @@ -- | promoted 'Maybe' functions
 module Predicate.Data.Maybe (
 
- -- ** boolean predicates
+ -- ** predicates
     IsNothing
   , IsJust
 

@@ -17,7 +17,6 @@ {-# LANGUAGE EmptyDataDeriving #-}
 -- | promoted 'Semigroup' and 'Monoid' functions
 module Predicate.Data.Monoid (
-  -- ** functions
     type (<>)
   , MConcat
   , SConcat

@@ -72,15 +72,13 @@ import Predicate.Util
 import Predicate.Data.Ordering (type (==))
 import GHC.TypeLits (Nat,KnownNat)
-import Data.List (elemIndex)
 import Data.Function (fix)
 import Data.Typeable (Typeable, Proxy(Proxy))
 import Data.Kind (Type)
-import qualified Numeric
-import Data.Char (toLower)
+import qualified Numeric.Lens (base)
 import Data.Ratio ((%))
 import GHC.Real (Ratio((:%)))
-import qualified Safe (fromJustNote, atNote)
+import Control.Lens
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -966,23 +964,16 @@          ) => P (ReadBase' t n p) x where
   type PP (ReadBase' t n p) x = PP t x
   eval _ opts x = do
-    let n = nat @n
-        xs = getValidBase n
+    let n = nat @n @Int
         msg0 = "ReadBase(" <> t <> "," <> show n <> ")"
         t = showT @(PP t x)
     pp <- eval (Proxy @p) opts x
     pure $ case getValueLR NoInline opts msg0 pp [] of
       Left e -> e
       Right p ->
-        let (ff,p1) = case p of
-                        '-':q -> (negate,q)
-                        _ -> (id,p)
-        in case Numeric.readInt (fromIntegral n)
-            ((`elem` xs) . toLower)
-            (Safe.fromJustNote "ReadBase" . (`elemIndex` xs) . toLower)
-            p1 of
-             [(b,"")] -> mkNode opts (Val (ff b)) (msg0 <> " " <> showL opts (ff b) <> showVerbose opts " | " p) [hh pp]
-             o -> mkNode opts (Fail ("invalid base " <> show n)) (msg0 <> " as=" <> p <> " err=" <> showL opts o) [hh pp]
+        case p ^? Numeric.Lens.base @Integer n of
+          Just (fromIntegral -> b) -> mkNode opts (Val b) (msg0 <> " " <> showL opts b <> showVerbose opts " | " p) [hh pp]
+          Nothing -> mkNode opts (Fail ("invalid base " <> show n)) (msg0 <> " p=" <> p) [hh pp]
 
 -- | Read a number using base 2 through a maximum of 36
 --
@@ -1019,7 +1010,7 @@ -- Val 255
 --
 -- >>> pl @(ReadBase Int 22) "zzz"
--- Error invalid base 22 (ReadBase(Int,22) as=zzz err=[])
+-- Error invalid base 22 (ReadBase(Int,22) p=zzz)
 -- Fail "invalid base 22"
 --
 -- >>> pl @((ReadBase Int 16 &&& Id) >> First (ShowBase 16)) "fFe0"
@@ -1071,14 +1062,11 @@          ) => P (ShowBase n) x where
   type PP (ShowBase n) x = String
   eval _ opts x =
-    let n = nat @n
-        xs = getValidBase n
+    let n = nat @n @Int
         msg0 = "ShowBase(" <> show n <> ")"
-        p :: Integer
-        p = fromIntegral x
-        (ff,a') = if p < 0 then (('-':), abs p) else (id,p)
-        b = Numeric.showIntAtBase (fromIntegral n) (Safe.atNote "ShowBase out of range" xs) a' ""
-    in pure $ mkNode opts (Val (ff b)) (msg0 <> " " <> litL opts (ff b) <> showVerbose opts " | " p) []
+        p = fromIntegral @_ @Integer x
+        b = Numeric.Lens.base n # p
+    in pure $ mkNode opts (Val b) (msg0 <> " " <> litL opts b <> showVerbose opts " | " p) []
 
 -- | Display a number at base >= 2 but just show as a list of ints: ignores the sign
 --

@@ -16,19 +16,13 @@ {-# LANGUAGE EmptyDataDeriving #-}
 -- | promoted 'Ordering' functions
 module Predicate.Data.Ordering (
-  -- ** functions
+  -- ** comparison
     type (>)
   , type (>=)
   , type (==)
   , type (/=)
   , type (<=)
   , type (<)
-  , type (>~)
-  , type (>=~)
-  , type (==~)
-  , type (/=~)
-  , type (<=~)
-  , type (<~)
   , Gt
   , Ge
   , Same
@@ -38,14 +32,26 @@   , type (==!)
   , Comparing
   , Compare
+
+  -- ** case insensitive comparison
+  , type (>~)
+  , type (>=~)
+  , type (==~)
+  , type (/=~)
+  , type (<=~)
+  , type (<~)
   , type (===~)
+
+  -- ** lists
   , Asc
   , Asc'
   , Desc
   , Desc'
+
+ -- ** numeric
   , AllPositive
-  , Positive
   , AllNegative
+  , Positive
   , Negative
  ) where
 import Predicate.Core

@@ -464,7 +464,7 @@ --    `- P hello '"there"
 -- Val "there"
 --
--- >>> pz @(PApp (Proxy Proxy) (Proxy "abc") >> Pop0 Id () >> Pop0 Id () ) ()
+-- >>> pz @(PApp (Proxy Proxy) (Proxy "abc") >> Pop0 Id () >> Pop0 Id ()) ()
 -- Val "abc"
 --
 -- >>> pz @(PApp (Proxy '(,,)) (Proxy 10) >> PApp Id (Proxy "ss") >> PApp Id (Proxy Fst) >> Pop0 Id '(13 % 44,C "x")) ()

@@ -16,8 +16,10 @@ {-# LANGUAGE EmptyDataDeriving #-}
 -- | promoted read, show, and printf functions
 module Predicate.Data.ReadShow (
- -- ** read-show
+ -- ** show
     ShowP
+
+ -- ** read
   , ReadP
   , ReadP'
   , ReadMaybe

@@ -16,7 +16,6 @@ {-# LANGUAGE EmptyDataDeriving #-}
 -- | promoted regular expression functions
 module Predicate.Data.Regex (
-  -- ** functions
     Re
   , Re'
   , Rescan
@@ -43,7 +42,7 @@ import Predicate.Util
 import Data.Proxy (Proxy(Proxy))
 import qualified Text.Regex.PCRE.Heavy as RH
-
+import Data.Bool (bool)
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -377,7 +376,7 @@ 
 data ReplaceImpl (alle :: Bool) (rs :: [ROpt]) p q r deriving Show
 
-instance ( GetBool b
+instance ( GetBool alle
          , GetROpts rs
          , PP p x ~ String
          , PP q x ~ RReplace
@@ -385,12 +384,12 @@          , P p x
          , P q x
          , P r x
-         ) => P (ReplaceImpl b rs p q r) x where
-  type PP (ReplaceImpl b rs p q r) x = String
+         ) => P (ReplaceImpl alle rs p q r) x where
+  type PP (ReplaceImpl alle rs p q r) x = String
   eval _ opts x = do
-    let msg0 = "Replace" <> (if alle then "All" else "One") <> unlessNull rs ("' " <> displayROpts fs)
+    let msg0 = "Replace" <> bool "One" "All" alle <> unlessNull rs ("' " <> displayROpts fs)
         (fs,rs) = getROpts @rs
-        alle = getBool @b
+        alle = getBool @alle
     lr <- runPQ NoInline msg0 (Proxy @p) (Proxy @q) opts x []
     case lr of
       Left e -> pure e
@@ -407,14 +406,14 @@                let ret :: String
                    ret = case q of
                            RReplace o s ->
-                             let g fn = (if alle then RH.gsub else RH.sub) regex fn r
+                             let g fn = bool RH.sub RH.gsub alle regex fn r
                              in g (case o of
                                   RPrepend -> (s <>)
                                   ROverWrite -> const s
                                   RAppend -> (<> s))
-                           RReplace1 s -> (if alle then RH.gsub else RH.sub) regex s r
-                           RReplace2 s -> (if alle then RH.gsub else RH.sub) regex s r
-                           RReplace3 s -> (if alle then RH.gsub else RH.sub) regex s r
+                           RReplace1 s -> bool RH.sub RH.gsub alle regex s r
+                           RReplace2 s -> bool RH.sub RH.gsub alle regex s r
+                           RReplace3 s -> bool RH.sub RH.gsub alle regex s r
                in mkNode opts (Val ret) (msg1 <> " " <> litL opts r <> litVerbose opts " | " ret) (hhs <> [hh rr])
 
 -- | replaces all values using regex @p@ with a replacement function @q@ inside the value @r@ using regex options @rs@
@@ -535,8 +534,8 @@     pure $ case getValueLR NoInline opts msg0 pp [] of
       Left e -> e
       Right p ->
-        let b = RReplace (getReplaceFnSub @r) p
-        in mkNode opts (Val b) (msg0 <> showVerbose opts " | " p) [hh pp]
+        let ret = RReplace (getReplaceFnSub @r) p
+        in mkNode opts (Val ret) (msg0 <> showVerbose opts " | " p) [hh pp]
 
 -- | A replacement function @(String -> [String] -> String)@ which returns the whole match and the groups
 -- Used by 'RH.sub' and 'RH.gsub'

@@ -17,31 +17,29 @@ {-# LANGUAGE EmptyDataDeriving #-}
 -- | promoted String functions
 module Predicate.Data.String (
-  -- ** functions
-    TrimBoth
-  , TrimL
-  , TrimR
-  , StripR
-  , StripL
+  -- ** converters
+    ToString
+  , ToStringC (..)
+  , FromString
+  , FromString'
 
-  , IsPrefixC
-  , IsInfixC
-  , IsSuffixC
+  -- ** predicates
   , IsPrefixCI
   , IsInfixCI
   , IsSuffixCI
 
-  , ToString
-  , ToStringC (..)
-  , FromString
-  , FromString'
+  -- ** mutators
+  , TrimBoth
+  , TrimL
+  , TrimR
+  , StripR
+  , StripL
  ) where
 import Predicate.Core
 import Predicate.Misc
 import Predicate.Util
-import qualified GHC.TypeLits as GL
 import Control.Lens
-import Data.List (dropWhileEnd)
+import Data.List (stripPrefix, dropWhileEnd)
 import qualified Data.Text.Lens as DTL
 import Data.Proxy (Proxy(Proxy))
 import Data.Kind (Type)
@@ -53,6 +51,9 @@ import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import Control.Arrow (second)
+import Data.Bool (bool)
+import Data.These
+import qualified Data.List.Lens
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -62,23 +63,20 @@ -- >>> import Predicate.Prelude
 -- >>> import qualified Data.Sequence as Seq
 
-data TrimImpl (left :: Bool) (right :: Bool) deriving Show
+data TrimImpl (th :: These () ()) deriving Show
 
-instance ( FailUnlessT (OrT l r)
-            ('GL.Text "TrimImpl: left and right cannot both be False")
-         , GetBool l
-         , GetBool r
+instance ( GetThese th
          , DTL.IsText x
-         ) => P (TrimImpl l r) x where
-  type PP (TrimImpl l r) x = x
+         ) => P (TrimImpl th) x where
+  type PP (TrimImpl th) x = x
   eval _ opts x =
-    let msg0 = "Trim" ++ (if l && r then "Both" else if l then "L" else "R")
-        l = getBool @l
-        r = getBool @r
+    let (vv,fn) = case getThese @_ @_ @th of
+                    These () () -> ("Both", dropWhile isSpace . dropWhileEnd isSpace)
+                    This () -> ("L", dropWhile isSpace)
+                    That () -> ("R", dropWhileEnd isSpace)
+        msg0 = "Trim" ++ vv
         p = view DTL.unpacked x
-        fl = if l then dropWhile isSpace else id
-        fr = if r then dropWhileEnd isSpace else id
-        b =  (fl . fr) p
+        b =  fn p
      in pure $ mkNode opts (Val (b ^. DTL.packed)) (msg0 <> litL opts b <> litVerbose opts " | " p) []
 
 -- | similar to 'Data.Text.stripStart'
@@ -87,7 +85,7 @@ -- Val "abc   "
 --
 data TrimL deriving Show
-type TrimLT = TrimImpl 'True 'False
+type TrimLT = TrimImpl ('This '())
 
 instance P TrimLT x => P TrimL x where
   type PP TrimL x = PP TrimLT x
@@ -105,7 +103,7 @@ -- Val ""
 --
 data TrimR deriving Show
-type TrimRT = TrimImpl 'False 'True
+type TrimRT = TrimImpl ('That '())
 
 instance P TrimRT x => P TrimR x where
   type PP TrimR x = PP TrimRT x
@@ -126,7 +124,7 @@ -- Val ""
 --
 data TrimBoth deriving Show
-type TrimBothT = TrimImpl 'True 'True
+type TrimBothT = TrimImpl ('These '() '())
 
 instance P TrimBothT x => P TrimBoth x where
   type PP TrimBoth x = PP TrimBothT x
@@ -134,27 +132,23 @@ 
 data StripImpl(left :: Bool) p q deriving Show
 
-instance ( GetBool l
+instance ( GetBool lft
          , PP p x ~ String
          , P p x
          , DTL.IsText (PP q x)
          , P q x
-         ) => P (StripImpl l p q) x where
-  type PP (StripImpl l p q) x = Maybe (PP q x)
+         ) => P (StripImpl lft p q) x where
+  type PP (StripImpl lft p q) x = Maybe (PP q x)
   eval _ opts x = do
-    let msg0 = "Strip" ++ if l then "L" else "R"
-        l = getBool @l
+    let msg0 = "Strip" <> bool "R" "L" lft
+        lft = getBool @lft
     lr <- runPQ NoInline msg0 (Proxy @p) (Proxy @q) opts x []
     pure $ case lr of
       Left e -> e
       Right (p,view DTL.unpacked -> q,pp,qq) ->
-        let b = if l then
-                  let (before,after) = splitAt (length p) q
-                  in if before == p then Just after else Nothing
-                else
-                  let (before,after) = splitAt (length q - length p) q
-                  in if after == p then Just before else Nothing
-        in mkNode opts (Val (fmap (view DTL.packed) b)) (msg0 <> showL opts b <> litVerbose opts " | p=" p <> litVerbose opts " | q=" q) [hh pp, hh qq]
+        let b | lft = stripPrefix p q
+              | otherwise = Data.List.Lens.stripSuffix p q
+        in mkNode opts (Val (view DTL.packed <$> b)) (msg0 <> showL opts b <> litVerbose opts " | p=" p <> litVerbose opts " | q=" q) [hh pp, hh qq]
 
 -- | similar to 'Data.Text.stripLeft'
 --
@@ -195,21 +189,18 @@   type PP (StripR p q) x = PP (StripRT p q) x
   eval _ = eval (Proxy @(StripRT p q))
 
-data IsFixImplC (cmp :: Ordering) (ignore :: Bool) p q deriving Show
+data IsFixStringCI (cmp :: Ordering) p q deriving Show
 
-instance ( GetBool ignore
-         , P p x
+instance ( P p x
          , P q x
          , PP p x ~ String
          , PP q x ~ String
          , GetOrdering cmp
-         ) => P (IsFixImplC cmp ignore p q) x where
-  type PP (IsFixImplC cmp ignore p q) x = Bool
+         ) => P (IsFixStringCI cmp p q) x where
+  type PP (IsFixStringCI cmp p q) x = Bool
   eval _ opts x = do
     let cmp = getOrdering @cmp
-        ignore = getBool @ignore
-        lwr = if ignore then map toLower else id
-        (ff,msg0) = second (<>"C") $ cmpOf cmp
+        (ff,msg0) = second (<> "CI") $ cmpOf cmp
     lr <- runPQ NoInline msg0 (Proxy @p) (Proxy @q) opts x []
     pure $ case lr of
       Left e -> e
@@ -218,73 +209,8 @@         in case chkSize2 opts msg0 p' q' hhs of
           Left e -> e
           Right ((_,p),(_,q)) ->
-            let msg1 = joinStrings (msg0 <> if ignore then "I" else "") p
-            in mkNodeB opts (on ff lwr p q) (msg1 <> " " <> litL opts q) hhs
-
--- | similar to 'Data.List.isPrefixOf' for strings
---
--- >>> pl @(IsPrefixC "xy" Id) "xyzabw"
--- True (IsPrefixC | xy xyzabw)
--- Val True
---
--- >>> pl @(IsPrefixC "ab" Id) "xyzbaw"
--- False (IsPrefixC | ab xyzbaw)
--- Val False
---
--- >>> pz @(IsPrefixC "abc" "aBcbCd") ()
--- Val False
---
-data IsPrefixC p q deriving Show
-type IsPrefixCT p q = IsFixImplC 'LT 'False p q
-
-instance P (IsPrefixCT p q) x => P (IsPrefixC p q) x where
-  type PP (IsPrefixC p q) x = PP (IsPrefixCT p q) x
-  eval _ = evalBool (Proxy @(IsPrefixCT p q))
-
--- | similar to 'Data.List.isInfixOf' for strings
---
--- >>> pl @(IsInfixC "ab" Id) "xyzabw"
--- True (IsInfixC | ab xyzabw)
--- Val True
---
--- >>> pl @(IsInfixC "aB" Id) "xyzAbw"
--- False (IsInfixC | aB xyzAbw)
--- Val False
---
--- >>> pl @(IsInfixC "ab" Id) "xyzbaw"
--- False (IsInfixC | ab xyzbaw)
--- Val False
---
--- >>> pl @(IsInfixC Fst Snd) ("ab","xyzabw")
--- True (IsInfixC | ab xyzabw)
--- Val True
---
-data IsInfixC p q deriving Show
-type IsInfixCT p q = IsFixImplC 'EQ 'False p q
-
-instance P (IsInfixCT p q) x => P (IsInfixC p q) x where
-  type PP (IsInfixC p q) x = PP (IsInfixCT p q) x
-  eval _ = evalBool (Proxy @(IsInfixCT p q))
-
--- | similar to 'Data.List.isSuffixOf' for strings
---
--- >>> pl @(IsSuffixC "bw" Id) "xyzabw"
--- True (IsSuffixC | bw xyzabw)
--- Val True
---
--- >>> pl @(IsSuffixC "bw" Id) "xyzbaw"
--- False (IsSuffixC | bw xyzbaw)
--- Val False
---
--- >>> pz @(IsSuffixC "bCd" "aBcbCd") ()
--- Val True
---
-data IsSuffixC p q deriving Show
-type IsSuffixCT p q = IsFixImplC 'GT 'False p q
-
-instance P (IsSuffixCT p q) x => P (IsSuffixC p q) x where
-  type PP (IsSuffixC p q) x = PP (IsSuffixCT p q) x
-  eval _ = evalBool (Proxy @(IsSuffixCT p q))
+            let msg1 = joinStrings msg0 p
+            in mkNodeB opts (on ff (map toLower) p q) (msg1 <> " " <> litL opts q) hhs
 
 -- | similar to case insensitive 'Data.List.isPrefixOf' for strings
 --
@@ -292,7 +218,7 @@ -- Val True
 --
 data IsPrefixCI p q deriving Show
-type IsPrefixCIT p q = IsFixImplC 'LT 'True p q
+type IsPrefixCIT p q = IsFixStringCI 'LT p q
 
 instance P (IsPrefixCIT p q) x => P (IsPrefixCI p q) x where
   type PP (IsPrefixCI p q) x = PP (IsPrefixCIT p q) x
@@ -308,7 +234,7 @@ -- Val True
 --
 data IsInfixCI p q deriving Show
-type IsInfixCIT p q = IsFixImplC 'EQ 'True p q
+type IsInfixCIT p q = IsFixStringCI 'EQ p q
 
 instance P (IsInfixCIT p q) x => P (IsInfixCI p q) x where
   type PP (IsInfixCI p q) x = PP (IsInfixCIT p q) x
@@ -317,7 +243,7 @@ -- | similar to case insensitive 'Data.List.isSuffixOf' for strings
 --
 data IsSuffixCI p q deriving Show
-type IsSuffixCIT p q = IsFixImplC 'GT 'True p q
+type IsSuffixCIT p q = IsFixStringCI 'GT p q
 
 instance P (IsSuffixCIT p q) x => P (IsSuffixCI p q) x where
   type PP (IsSuffixCI p q) x = PP (IsSuffixCIT p q) x
@@ -329,6 +255,7 @@   type PP ToString x = String
   eval _ opts x = pure $ mkNode opts (Val (toStringC x)) "ToString" []
 
+-- | convert string-like value to a string
 class ToStringC (a :: Type) where
   toStringC :: a -> String
 instance ToStringC String where

@@ -16,7 +16,7 @@ {-# LANGUAGE EmptyDataDeriving #-}
 -- | promoted 'These' functions
 module Predicate.Data.These (
- -- ** boolean predicates
+ -- ** predicates
     IsThis
   , IsThat
   , IsThese
@@ -251,9 +251,6 @@   type PP (MkThat t p) x = PP (MkThatT t p) x
   eval _ = eval (Proxy @(MkThatT t p))
 
--- type MkThat t p = MkThis t p >> Swap
--- type MkThat' (t :: Type) = Pure (These t) Id -- t has to be a semigroup
-
 -- | 'Data.These.These' constructor
 --
 -- >>> pz @(MkThese Fst Snd) (44,'x')
@@ -291,9 +288,12 @@   type PP (IsTh th) x = Bool
   eval _ opts x =
     let msg0 = "Is"
-        (t,f) = getThese @_ @_ @th
-        b = f x
-    in pure $ mkNodeB opts b (msg0 <> t <> showVerbose opts " | " x) []
+        th = getThese @_ @_ @th
+        fn = case th of
+               This () -> TheseC.isThis
+               That () -> TheseC.isThat
+               These () () -> TheseC.isThese
+    in pure $ mkNodeB opts (fn x) (msg0 <> showThese th <> showVerbose opts " | " x) []
 
 -- | predicate on 'Data.These.This'
 --

@@ -36,7 +36,7 @@   , _elr2Maybe
   , _elr2These
 
- -- ** boolean predicates
+ -- ** predicates
   , isENone
   , isELeft
   , isERight

@@ -232,17 +232,34 @@         ,Guard (PrintT "expected %d mod 10 = 0 but found %d" '(Id, Id `Mod` 10)) (Mod Id 10 == 0)
         ])
 
--- convert json microsoft datetime to zonedtime
---type JsonMicrosoftDateTime = Rescan "^Date\\((\\d+[+-]\\d{4})\\)" >> Head >> Snd >> Id !! 0 >> ReplaceOneString 'RPrepend "\\d{3}[+-]" "." Id >> ParseTimeP ZonedTime "%s%Q%z"
-
--- type JsonMicrosoftDateTime = Rescan "^Date\\((\\d+)(\\d{3}[+-]\\d{4})\\)" >> Head >> Snd >> (Id !! 0 <> "." <> Id !! 1)  >> ParseTimeP ZonedTime "%s%Q%z"
-
--- jam the values together
--- eg pu @JsonMicrosoftDateTime "Date(1593460089052+0800)"
+-- | convert json microsoft datetime to zonedtime
+--
+-- >>> pz @JsonMicrosoftDateTime "Date(1593460089052+0800)"
+-- Val 2020-06-30 03:48:09.052 +0800
+--
+-- >>> pz @JsonMicrosoftDateTime "Date(0+0800)"
+-- Val 1970-01-01 08:00:00 +0800
+--
+-- >>> pz @JsonMicrosoftDateTime "Date(12+0800)"
+-- Val 1970-01-01 08:00:00.012 +0800
+--
+-- >>> pz @JsonMicrosoftDateTime "Date(123+0800)"
+-- Val 1970-01-01 08:00:00.123 +0800
+--
+-- >>> pz @JsonMicrosoftDateTime "Date(+1234+0800)"
+-- Val 1970-01-01 08:00:01.234 +0800
+--
+-- >>> pz @JsonMicrosoftDateTime "Date(-123456+0000)"
+-- Val 1969-12-31 23:57:57.456 +0000
+--
 type JsonMicrosoftDateTime =
-  Do '[ Rescan "^Date\\((\\d+)(\\d{3}[+-]\\d{4})\\)"
+  Do '[ Rescan "^Date\\(([-+])?(\\d*?)(\\d{0,3})([+-]\\d{4})\\)"
       , Head
       , Snd
-      , Id !! 0 <> "." <> Id !! 1
+      , If (Id !! 0 == "-") "-" ""
+        <> PadL 1 (C "0") (Id !! 1)
+        <> "."
+        <> PadL 3 (C "0") (Id !! 2)
+        <> Id !! 3
       , ParseTimeP ZonedTime "%s%Q%z"
       ]

@@ -36,6 +36,8 @@   , Luhn11
   , LuhnR
   , LuhnT
+  -- *** sim card
+  , SimT
 
   -- ** ssn
   , ssn
@@ -343,20 +345,45 @@ 
 type LuhnR (opts :: Opt) (n :: Nat) = MakeR3 (LuhnT opts n)
 
--- | Luhn check
+-- | Luhn check using builtin 'Predicate.Data.Extra.IsLuhn'
 --
 -- >>> newRefined3P (Proxy @(LuhnT OZ 4)) "1230"
 -- Right (Refined3 [1,2,3,0] "1230")
 --
 -- >>> newRefined3P (Proxy @(LuhnT OL 4)) "1234"
--- Left Step 2. False Boolean Check(op) | {True && False | (IsLuhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])}
+-- Left Step 2. False Boolean Check(op) | {True && False | (IsLuhn map=[2,2,6,4] sum=14 ret=4 | [1,2,3,4])}
 --
--- | uses builtin 'IsLuhn'
 type LuhnT (opts :: Opt) (n :: Nat) =
    '(opts
     , Map' (ReadP Int Id) Ones
     , Msg "incorrect number of digits:"
           (Len == n) && IsLuhn
+    , ConcatMap (ShowP Id) Id
+    , String)
+
+-- | Sim card check using builtin 'Predicate.Data.Extra.LuhnDigit'
+--
+-- >>> newRefined3P (Proxy @(SimT OZ)) "12345678901234567859"
+-- Right (Refined3 [1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,5,9] "12345678901234567859")
+--
+-- >>> newRefined3P (Proxy @(SimT OZ)) "12345678901234567"
+-- Left Step 2. Failed Boolean Check(op) | invalid length expected 20 found 17
+--
+-- >>> newRefined3P (Proxy @(SimT OZ)) "12345678901234567819"
+-- Left Step 2. Failed Boolean Check(op) | bad first checkdigit was given as 1 but should be 5
+--
+-- >>> newRefined3P (Proxy @(SimT OZ)) "12345678901234567852"
+-- Left Step 2. Failed Boolean Check(op) | bad second checkdigit was given as 2 but should be 9
+--
+type SimT (opts :: Opt) =
+   '(opts
+    , Map' (ReadP Int Id) Ones
+    , Guard (PrintF "invalid length expected 20 found %d" Len) (Len == 20)
+   >> SplitAt 18 Id
+   >> '(LuhnDigit << Fst,LuhnDigit << Drop 6 Fst,Snd)
+   >> Guard (PrintT "bad first checkdigit was given as %d but should be %d" '(Head << Thd,Fst)) ((Head << Thd) == Fst)
+   >> Guard (PrintT "bad second checkdigit was given as %d but should be %d" '(Last << Thd,Snd)) ((Last << Thd) == Snd)
+   >> 'True
     , ConcatMap (ShowP Id) Id
     , String)
 

@@ -131,7 +131,6 @@   , ifM
   , AssocC(..)
   , simpleAlign
-  , getValidBase
   ) where
 import qualified GHC.TypeNats as GN
 import GHC.TypeLits (Symbol,Nat,KnownSymbol,KnownNat,ErrorMessage((:$$:),(:<>:)))
@@ -149,19 +148,19 @@ import Control.Applicative (ZipList)
 import Data.Kind (Type)
 import Data.These (These(..))
-import Data.These.Combinators (isThis, isThat, isThese)
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.ByteString (ByteString)
 import GHC.Stack (HasCallStack)
 import Data.Containers.ListUtils (nubOrd)
 import Control.Arrow (Arrow((***)),ArrowChoice(left))
-import Data.List (foldl', intercalate, unfoldr, isPrefixOf, isInfixOf, isSuffixOf)
+import Data.List (foldl', intercalate, unfoldr, isPrefixOf, isInfixOf)
 import qualified Safe (headNote)
 import Data.Char (isSpace)
 import qualified Control.Exception as E
 import Data.Tree (Tree(Node))
 import Control.Lens
 import qualified Data.Semigroup as SG
+import Data.List.Lens (suffixed)
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -254,13 +253,13 @@ 
 -- | get 'These' from typelevel
 class GetThese (th :: These a b) where
-  getThese :: (String, These w v -> Bool)
+  getThese :: These () ()
 instance GetThese ('This x) where
-  getThese = ("This", isThis)
+  getThese = This ()
 instance GetThese ('That y) where
-  getThese = ("That", isThat)
+  getThese = That ()
 instance GetThese ('These x y) where
-  getThese = ("These", isThese)
+  getThese = These () ()
 
 -- | get ordering from the typelevel
 class GetOrdering (cmp :: Ordering) where
@@ -1337,11 +1336,12 @@ foldMapStrict :: (Foldable t, Monoid m) => (a -> m) -> t a -> m
 foldMapStrict f = foldl' (\z a -> z <> f a) mempty
 
+-- | return a function that compares two lists based on the Ordering parameter
 cmpOf :: Eq a => Ordering -> ([a] -> [a] -> Bool, String)
 cmpOf = \case
            LT -> (isPrefixOf, "IsPrefix")
            EQ -> (isInfixOf, "IsInfix")
-           GT -> (isSuffixOf, "IsSuffix")
+           GT -> (has . suffixed, "IsSuffix")
 
 -- | lifted if statement
 ifM :: Monad m => m Bool -> m a -> m a -> m a
@@ -1403,21 +1403,3 @@ simpleAlign as [] = map This as
 simpleAlign [] bs = map That bs
 simpleAlign (a:as) (b:bs) = These a b : simpleAlign as bs
-
--- | get base values for n between 2 and 36
---
--- >>> getValidBase 36
--- "0123456789abcdefghijklmnopqrstuvwxyz"
---
--- >>> getValidBase 2
--- "01"
---
--- >>> getValidBase 8
--- "01234567"
---
-getValidBase :: Int -> String
-getValidBase n
-  | n < 2 = errorInProgram $ "getValidBase: oops invalid base: found n<2 ie " ++ show n
-  | n > 36 = errorInProgram $ "getValidBase: oops invalid base: found n>36 ie " ++ show n
-  | otherwise = take n (['0'..'9'] <> ['a'..'z'])
-

@@ -1,4 +1,3 @@-{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -13,6 +12,8 @@ {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE NoStarIsType #-}
 {-# LANGUAGE TypeOperators #-}
@@ -36,6 +37,9 @@   , unsafeRefined
   , unsafeRefined'
 
+ -- ** exception
+  , RefinedException(..)
+
  ) where
 import Predicate.Core
 import Predicate.Misc (nullIf)
@@ -52,9 +56,11 @@ import Data.Binary (Binary)
 import Data.String (IsString(..))
 import Data.Hashable (Hashable(..))
-import GHC.Stack (HasCallStack)
 import Data.Coerce (coerce)
 import Control.DeepSeq (NFData)
+import qualified Control.Exception as E
+import GHC.Generics (Generic)
+--import GHC.Stack (HasCallStack)
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -91,7 +97,7 @@       => IsString (Refined opts p String) where
   fromString s =
     case newRefined @opts @p s of
-      Left w -> error $ "Refined(IsString:fromString):" ++ errorDisplay (getOpt @opts) w
+      Left w -> E.throw $ RefinedException $ "IsString:fromString:\n" ++ errorDisplay (getOpt @opts) w
       Right r -> r
 
 errorDisplay :: POpts -> Msg0 -> String
@@ -222,21 +228,17 @@ 
 -- | create 'Refined' generator using a generator to restrict the values
 genRefined :: forall opts p a .
-   ( RefinedC opts p a
-   , HasCallStack
-   )
+   RefinedC opts p a
    => Gen a
    -> Gen (Refined opts p a)
 genRefined g =
-  let f !cnt = do
+  let o = getOpt @opts
+      r = getMaxRecursionValue o
+      f !cnt = do
         ma <- suchThatMaybe g $ \a -> evalQuick @opts @p a == Right True
         case ma of
-          Nothing ->
-             let o = getOpt @opts
-                 r = getMaxRecursionValue o
-             in if cnt >= r
-                then error $ setOtherEffects o ("genRefined recursion exceeded(" ++ show r ++ ")")
-                else f (cnt+1)
+          Nothing | cnt >= r -> E.throw $ RefinedException $ "\n" ++ setOtherEffects o ("genRefined recursion exceeded(" ++ show r ++ ")")
+                  | otherwise -> f (cnt+1)
           Just a -> pure $ unsafeRefined a
   in f 0
 
@@ -245,7 +247,7 @@                  , m0Short :: !String
                  , m0Long :: !String
                  , m0ValBoolColor :: !String
-                 } deriving Eq
+                 } deriving stock Eq
 
 -- | verbose display of 'Msg0'
 showMsg0 :: Msg0 -> String
@@ -339,9 +341,8 @@ 
 -- | create an unsafe 'Refined' value and also run the predicate
 unsafeRefined' :: forall opts p a
-  . ( RefinedC opts p a
-    , HasCallStack
-    ) => a -> Refined opts p a
+  . RefinedC opts p a
+     => a -> Refined opts p a
 unsafeRefined' a =
   let o = getOpt @opts
       tt = runIdentity $ evalBool (Proxy @p) o a
@@ -349,7 +350,14 @@        Right True -> Refined a
        _ -> let s = prtTree o tt
                 bp = colorValBool o (tt ^. ttVal)
-            in case oDebug o of
-                 DZero -> error bp
-                 DLite -> error $ bp ++ nullIf "\n" s
-                 _ -> error $ bp ++ nullIf "\n" s
+            in E.throw $ RefinedException $ bp ++ nullIf "\n" s
+
+-- | refinement exception
+newtype RefinedException = RefinedException String
+  deriving stock Generic
+
+instance Show RefinedException where
+  show (RefinedException e) = "RefinedException:" ++ e
+
+instance E.Exception RefinedException where
+  displayException = show

@@ -19,6 +19,8 @@ {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE NoStarIsType #-}
 -- | a refinement type allowing the external type to differ from the internal type
@@ -56,6 +58,9 @@   , unsafeRefined2
   , unsafeRefined2'
 
+ -- ** exception
+  , Refined2Exception(..)
+
  ) where
 import Predicate.Core
 import Predicate.Misc
@@ -78,6 +83,8 @@ import GHC.Stack (HasCallStack)
 import Test.QuickCheck
 import Control.DeepSeq (rnf, rnf2, NFData)
+import qualified Control.Exception as E
+import GHC.Generics (Generic)
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -115,7 +122,7 @@                   )
                 => i
                 -> Refined2 opts ip op i
-unsafeRefined2' = either (error . show) id . newRefined2
+unsafeRefined2' = either (E.throw . Refined2Exception . show) id . newRefined2
 
 -- | directly load values into 'Refined2' without any checking
 unsafeRefined2 :: forall opts ip op i
@@ -133,23 +140,30 @@        , PP op (PP ip i) ~ Bool   -- the internal value needs to pass the predicate check
        )
 
-deriving instance ( Refined2C opts ip op i
-                  , Show i
-                  , Show (PP ip i)
-                  ) => Show (Refined2 opts ip op i)
-deriving instance ( Refined2C opts ip op i
-                  , Eq i
-                  , Eq (PP ip i)
-                  ) => Eq (Refined2 opts ip op i)
-deriving instance ( Refined2C opts ip op i
-                  , Ord i
-                  , Ord (PP ip i)
-                  ) => Ord (Refined2 opts ip op i)
-deriving instance ( Refined2C opts ip op i
-                  , TH.Lift (PP ip i)
-                  , TH.Lift i
-                  ) => TH.Lift (Refined2 opts ip op i)
+deriving stock instance
+  ( Refined2C opts ip op i
+  , Show i
+  , Show (PP ip i)
+  ) => Show (Refined2 opts ip op i)
 
+deriving stock instance
+  ( Refined2C opts ip op i
+  , Eq i
+  , Eq (PP ip i)
+  ) => Eq (Refined2 opts ip op i)
+
+deriving stock instance
+  ( Refined2C opts ip op i
+  , Ord i
+  , Ord (PP ip i)
+  ) => Ord (Refined2 opts ip op i)
+
+deriving stock instance
+  ( Refined2C opts ip op i
+  , TH.Lift (PP ip i)
+  , TH.Lift i
+  ) => TH.Lift (Refined2 opts ip op i)
+
 instance ( Refined2C opts ip op i
          , NFData i
          , NFData (PP ip i)
@@ -170,7 +184,7 @@          ) => IsString (Refined2 opts ip op i) where
   fromString i =
     case newRefined2 i of
-      Left e -> error $ "Refined2(IsString:fromString):" ++ show e
+      Left e -> E.throw $ Refined2Exception  $ "IsString:fromString:" ++ show e
       Right r -> r
 
 -- read instance from -ddump-deriv
@@ -305,18 +319,16 @@   -> Gen (Refined2 opts ip op i)
 genRefined2P _ g =
   let o = getOpt @opts
+      r = getMaxRecursionValue o
       f !cnt = do
         mi <- suchThatMaybe g (isJust . snd . runIdentity . eval2M @opts @ip @op)
         case mi of
-          Nothing ->
-             let r = getMaxRecursionValue o
-             in if cnt >= r
-                then error $ setOtherEffects o ("genRefined2P recursion exceeded(" ++ show r ++ ")")
-                else f (cnt+1)
+          Nothing | cnt >= r -> E.throw $ Refined2Exception $ setOtherEffects o $ "genRefined2P recursion exceeded(" ++ show r ++ ")"
+                  | otherwise -> f (cnt+1)
           Just i ->
              case newRefined2 i of
                Left e -> errorInProgram $ "conversion failed:" ++ show e
-               Right r -> pure r
+               Right ret -> pure ret
   in f 0
 
 -- | 'Binary' instance for 'Refined2'
@@ -371,7 +383,7 @@      | RTF !a !(Tree PE) !String !(Tree PE)    -- op fails
      | RTFalse !a !(Tree PE) !(Tree PE)        -- op false
      | RTTrue !a !(Tree PE) !(Tree PE) -- op true
-     deriving Show
+     deriving stock Show
 
 -- | version for creating a 'Refined2' value that works for any 'MonadEval' instance
 newRefined2' :: forall opts ip op i m
@@ -495,7 +507,7 @@                  , m2Short :: !String
                  , m2Long :: !String
                  , m2ValP :: !ValP
-                 } deriving Eq
+                 } deriving stock Eq
 
 instance Show Msg2 where
   show (Msg2 a b c _d) = joinStrings a b <> nullIf "\n" c
@@ -574,3 +586,13 @@ -- | type family for converting from a 4-tuple '(opts,ip,op,i) to a 'Refined2' type
 type family MakeR2 p where
   MakeR2 '(opts,ip,op,i) = Refined2 opts ip op i
+
+-- | refinement exception
+newtype Refined2Exception = Refined2Exception String
+  deriving Generic
+
+instance Show Refined2Exception where
+  show (Refined2Exception e) = "Refined2Exception:\n" ++ e
+
+instance E.Exception Refined2Exception where
+  displayException = show

@@ -18,6 +18,8 @@ {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE NoStarIsType #-}
 -- |
@@ -63,6 +65,9 @@   , genRefined3
   , genRefined3P
 
+ -- ** exception
+  , Refined3Exception(..)
+
  ) where
 import Predicate.Core
 import Predicate.Misc
@@ -85,6 +90,8 @@ import Data.Hashable (Hashable(..))
 import GHC.Stack (HasCallStack)
 import Control.DeepSeq (rnf, rnf2, NFData)
+import qualified Control.Exception as E
+import GHC.Generics (Generic)
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -133,7 +140,7 @@                   , Refined3C opts ip op fmt i
                 ) => i
                   -> Refined3 opts ip op fmt i
-unsafeRefined3' = either (error . show) id . newRefined3
+unsafeRefined3' = either (E.throw . Refined3Exception . show) id . newRefined3
 
 -- | directly load values into 'Refined3' without any checking
 unsafeRefined3 ::
@@ -155,23 +162,30 @@        , PP fmt (PP ip i) ~ i  -- the output type must match the original input type
        )
 
-deriving instance ( Refined3C opts ip op fmt i
-                  , Show (PP ip i)
-                  , Show i
-                  ) => Show (Refined3 opts ip op fmt i)
-deriving instance ( Refined3C opts ip op fmt i
-                  , Eq (PP ip i)
-                  , Eq i
-                  ) => Eq (Refined3 opts ip op fmt i)
-deriving instance ( Refined3C opts ip op fmt i
-                  , Ord (PP ip i)
-                  , Ord i
-                  ) => Ord (Refined3 opts ip op fmt i)
-deriving instance ( Refined3C opts ip op fmt i
-                  , TH.Lift (PP ip i)
-                  , TH.Lift i
-                  ) => TH.Lift (Refined3 opts ip op fmt i)
+deriving stock instance
+  ( Refined3C opts ip op fmt i
+  , Show (PP ip i)
+  , Show i
+  ) => Show (Refined3 opts ip op fmt i)
 
+deriving stock instance
+  ( Refined3C opts ip op fmt i
+  , Eq (PP ip i)
+  , Eq i
+  ) => Eq (Refined3 opts ip op fmt i)
+
+deriving stock instance
+  ( Refined3C opts ip op fmt i
+  , Ord (PP ip i)
+  , Ord i
+  ) => Ord (Refined3 opts ip op fmt i)
+
+deriving stock instance
+  ( Refined3C opts ip op fmt i
+  , TH.Lift (PP ip i)
+  , TH.Lift i
+  ) => TH.Lift (Refined3 opts ip op fmt i)
+
 instance ( Refined3C opts ip op fmt i
          , NFData i
          , NFData (PP ip i)
@@ -191,7 +205,7 @@          ) => IsString (Refined3 opts ip op fmt String) where
   fromString s =
     case newRefined3 s of
-      Left e -> error $ "Refined3(IsString:fromString):" ++ show e
+      Left e -> E.throw $ Refined3Exception $ "IsString:fromString:" ++ show e
       Right r -> r
 
 -- read instance from -ddump-deriv
@@ -321,19 +335,17 @@   -> Gen (PP ip i)
   -> Gen (Refined3 opts ip op fmt i)
 genRefined3P _ g =
-  let f !cnt = do
+  let o = getOpt @opts
+      r = getMaxRecursionValue o
+      f !cnt = do
         mppi <- suchThatMaybe g $ \a -> evalQuick @opts @op a == Right True
         case mppi of
-          Nothing ->
-             let o = getOpt @opts
-                 r = getMaxRecursionValue o
-             in if cnt >= r
-                then error $ setOtherEffects o ("genRefined3P recursion exceeded(" ++ show r ++ ")")
-                else f (cnt+1)
+          Nothing | cnt >= r -> E.throw $ Refined3Exception $ setOtherEffects o ("genRefined3P recursion exceeded(" ++ show r ++ ")")
+                  | otherwise -> f (cnt+1)
           Just ppi ->
              case evalQuick @opts @fmt ppi of
-               Left e -> error $ "genRefined3P: formatting failed!! " ++ e
-               Right r -> pure $ unsafeRefined3 ppi r
+               Left e -> E.throw $ Refined3Exception $ "genRefined3P: formatting failed!! " ++ e
+               Right ret -> pure $ unsafeRefined3 ppi ret
   in f 0
 
 -- | 'Binary' instance for 'Refined3'
@@ -423,7 +435,7 @@      | RTFalse !a !(Tree PE) !(Tree PE)        -- Right a + Right False
      | RTTrueF !a !(Tree PE) !(Tree PE) !String !(Tree PE) -- Right a + Right True + Left e
      | RTTrueT !a !(Tree PE) !(Tree PE) !(Tree PE)      -- Right a + Right True + Right b
-     deriving Show
+     deriving stock Show
 
 -- | same as 'newRefined3P'' but passes in the proxy
 newRefined3' :: forall opts ip op fmt i m
@@ -585,7 +597,7 @@                  , m3Short :: !String
                  , m3Long :: !String
                  , m3ValP :: !ValP
-                 } deriving Eq
+                 } deriving stock Eq
 
 instance Show Msg3 where
   show (Msg3 a b c _d) = joinStrings a b <> nullIf "\n" c
@@ -645,3 +657,13 @@               <> outmsg m
               <> prtTreePure opts t3
          in mkMsg3 m n r (t3 ^. root . peValP)
+
+-- | refinement exception
+newtype Refined3Exception = Refined3Exception String
+  deriving stock Generic
+
+instance Show Refined3Exception where
+  show (Refined3Exception e) = "Refined3Exception:\n" ++ e
+
+instance E.Exception Refined3Exception where
+  displayException = show

@@ -23,6 +23,7 @@ {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE NoStarIsType #-}
 -- | refinement type allowing the external type to differ from the internal type
@@ -51,6 +52,8 @@   , unsafeRefined5
   , unsafeRefined5'
 
+ -- ** exception
+  , Refined5Exception(..)
  ) where
 import Predicate.Refined2 (Msg2(..), RResults2(..), prt2Impl, Refined2C)
 import Predicate.Refined (RefinedC)
@@ -67,7 +70,6 @@ import Control.Lens
 import Data.String (IsString(..))
 import Data.Hashable (Hashable(..))
-import GHC.Stack (HasCallStack)
 import Test.QuickCheck
 import Data.Coerce (coerce)
 import Data.Either (isRight)
@@ -75,7 +77,8 @@ import Control.Arrow (left)
 import Data.Tree.Lens (root)
 import Control.DeepSeq (NFData)
-
+import qualified Control.Exception as E
+import GHC.Generics (Generic)
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -105,11 +108,10 @@ -- | directly load values into 'Refined5'. It still checks to see that those values are valid
 unsafeRefined5' :: forall opts ip op i
                 . ( Refined2C opts ip op i
-                  , HasCallStack
                   )
                 => PP ip i
                 -> Refined5 opts ip op i
-unsafeRefined5' = either error Refined5 . evalBool5 @opts @op
+unsafeRefined5' = either (E.throw . Refined5Exception) Refined5 . evalBool5 @opts @op
 
 -- | directly load values into 'Refined5' without any checking
 unsafeRefined5 :: forall opts ip op i
@@ -117,22 +119,31 @@   -> Refined5 opts ip op i
 unsafeRefined5 = Refined5
 
-deriving newtype instance ( Refined2C opts ip op i
-                          , NFData (PP ip i)
-                          ) => NFData (Refined5 opts ip op i)
-deriving stock instance  ( Refined2C opts ip op i
-                         , Show (PP ip i)
-                         ) => Show (Refined5 opts ip op i)
-deriving stock instance ( Refined2C opts ip op i
-                        , Eq (PP ip i)
-                        ) => Eq (Refined5 opts ip op i)
-deriving stock instance ( Refined2C opts ip op i
-                        , Ord (PP ip i)
-                        ) => Ord (Refined5 opts ip op i)
-deriving stock instance ( Refined2C opts ip op i
-                        , TH.Lift (PP ip i)
-                        ) => TH.Lift (Refined5 opts ip op i)
+deriving newtype instance
+  ( Refined2C opts ip op i
+  , NFData (PP ip i)
+  ) => NFData (Refined5 opts ip op i)
 
+deriving stock instance
+  ( Refined2C opts ip op i
+  , Show (PP ip i)
+  ) => Show (Refined5 opts ip op i)
+
+deriving stock instance
+  ( Refined2C opts ip op i
+  , Eq (PP ip i)
+  ) => Eq (Refined5 opts ip op i)
+
+deriving stock instance
+  ( Refined2C opts ip op i
+  , Ord (PP ip i)
+  ) => Ord (Refined5 opts ip op i)
+
+deriving stock instance
+  ( Refined2C opts ip op i
+  , TH.Lift (PP ip i)
+  ) => TH.Lift (Refined5 opts ip op i)
+
 -- | 'IsString' instance for Refined5
 --
 -- >>> pureTryTest $ fromString @(Refined5 OL (ReadP Int Id) (Id > 12) String) "523"
@@ -147,7 +158,7 @@          ) => IsString (Refined5 opts ip op i) where
   fromString i =
     case newRefined5 i of
-      Left e -> error $ "Refined5(IsString:fromString):" ++ show e
+      Left e -> E.throw $ Refined5Exception $ "IsString:fromString:" ++ show e
       Right r -> r
 
 -- read instance from -ddump-deriv
@@ -255,9 +266,7 @@ -- | create a 'Refined5' generator using a generator to restrict the values (so it completes)
 genRefined5 ::
     forall opts ip op i
-  . ( Refined2C opts ip op i
-    , HasCallStack
-    )
+  . Refined2C opts ip op i
   => Gen (PP ip i)
   -> Gen (Refined5 opts ip op i)
 genRefined5 = genRefined5P Proxy
@@ -266,22 +275,18 @@ -- | create a 'Refined5' generator using a proxy
 genRefined5P ::
     forall opts ip op i
-  . ( Refined2C opts ip op i
-    , HasCallStack
-    )
+  . Refined2C opts ip op i
   => Proxy '(opts,ip,op,i)
   -> Gen (PP ip i)
   -> Gen (Refined5 opts ip op i)
 genRefined5P _ g =
-  let f !cnt = do
+  let o = getOpt @opts
+      r = getMaxRecursionValue o
+      f !cnt = do
         mi <- suchThatMaybe g (isRight . evalBool5 @opts @op)
         case mi of
-          Nothing ->
-             let o = getOpt @opts
-                 r = getMaxRecursionValue o
-             in if cnt >= r
-                then error $ setOtherEffects o ("genRefined5P recursion exceeded(" ++ show r ++ ")")
-             else f (cnt+1)
+          Nothing | cnt >= r -> E.throw $ Refined5Exception $ setOtherEffects o ("genRefined5P recursion exceeded(" ++ show r ++ ")")
+                  | otherwise -> f (cnt+1)
           Just i -> pure $ unsafeRefined5 i
   in f 0
 
@@ -449,3 +454,12 @@             Left e -> Left $ joinStrings "failed boolean check " e
   in left (++ ("\n" ++ prtTreePure opts p2)) w
 
+-- | refinement exception
+newtype Refined5Exception = Refined5Exception String
+  deriving stock Generic
+
+instance Show Refined5Exception where
+  show (Refined5Exception e) = "Refined5Exception:\n" ++ e
+
+instance E.Exception Refined5Exception where
+  displayException = show

@@ -616,7 +616,7 @@ 
 nocolor, colorDef :: (String, PColor)
 -- | skip colors
-nocolor = ("nocolor", PColor $ flip const)
+nocolor = ("nocolor", PColor $ const id)
 -- | use default coloring from 'Color5'
 colorDef = Safe.fromJustNote "colorDef" $ coerce $ oColor $ getOptC @Color5