packages feed

predicate-typed 0.2.0.0 → 0.3.0.0

raw patch · 14 files changed

+9524/−8358 lines, 14 files

Files

predicate-typed.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 9961ce22931302992ba8b3575d0e54df9b5f7496b264f0e8467ba27a6f182438+-- hash: e5d65164036af58b0334ef901a340d7945c6977a38df30c57429cef3eb434369  name:           predicate-typed-version:        0.2.0.0+version:        0.3.0.0 synopsis:       Predicates, Refinement types and Dsl description:    Please see the README on GitHub at <https://github.com/gbwey/predicate-typed#readme> category:       Data
src/Predicate.hs view
@@ -1,7 +1,7 @@ {- |
      Provides a type-level Dsl for refinement types
 
-     To use refinement types you will need to also import 'Predicate.Refined' and/or 'Predicate.Refined3'
+     To use refinement types you will need to also import "Predicate.Refined" and/or "Predicate.Refined3"
 -}
 module Predicate (
    module Predicate.Core
src/Predicate/Core.hs view
@@ -19,10 +19,9 @@      Dsl for evaluating and displaying type level expressions
 -}
 module Predicate.Core (
-    P(..)
 
  -- ** basic types
-  , I
+    I
   , Id
   , IdT
   , W
@@ -37,11 +36,16 @@   , pe3
   , pl
   , plc
+  , pz
 
+  -- ** P class
+  , P(..)
+
   -- ** evaluation methods
   , runPQ
   , evalBool
   , evalQuick
+--  , prtTreeX
   ) where
 import Predicate.Util
 import GHC.TypeLits (Symbol,Nat,KnownSymbol,KnownNat)
@@ -57,7 +61,7 @@ -- >>> :set -XTypeOperators
 -- >>> :set -XNoStarIsType
 
--- | This is the core class. Each instance of this class can be combined into a dsl using 'Main.>>'
+-- | This is the core class. Each instance of this class can be combined into a dsl using 'Predicate.Prelude.>>'
 class P p a where
   type PP (p :: k) a :: Type -- PP is the output type
   eval :: MonadEval m => Proxy p -> POpts -> a -> m (TT (PP p a)) -- ^ returns a tree of results
@@ -67,12 +71,12 @@ evalBool p opts a = fixBoolT <$> eval p opts a
 
 evalQuick :: forall p i . P p i => i -> Either String (PP p i)
-evalQuick i = getValLRFromTT (runIdentity (eval (Proxy @p) o0 i))
+evalQuick i = getValLRFromTT (runIdentity (eval (Proxy @p) ol i))
 
 
 -- | identity function
 --
--- >>> pl @I 23
+-- >>> pz @I 23
 -- Present 23
 -- PresentT 23
 data I
@@ -87,7 +91,7 @@ --
 -- even more constraints than 'I' so we might need to add explicit type signatures
 --
--- >>> pl @Id 23
+-- >>> pz @Id 23
 -- Present 23
 -- PresentT 23
 data Id
@@ -101,7 +105,7 @@ -- even more constraints than 'Id' so we might need to explicitly add types (Typeable)
 -- | identity function that also displays the type information for debugging
 --
--- >>> pl @IdT 23
+-- >>> pz @IdT 23
 -- Present 23
 -- PresentT 23
 data IdT
@@ -112,13 +116,13 @@         t = showT @a
     in pure $ mkNode opts (PresentT a) [msg0 <> show0 opts " " a] []
 
--- | transparent predicate wrapper to make k of kind 'Type' so it can be in a promoted list (cant mix kinds) see 'Predicate.Do'
+-- | transparent predicate wrapper to make k of kind 'Type' so it can be in a promoted list (cant mix kinds) see 'Predicate.Core.Do'
 --
--- >>> pl @'[W 123, Id] 99
+-- >>> pz @'[W 123, Id] 99
 -- Present [123,99]
 -- PresentT [123,99]
 --
--- >>> pl @'[W "abc", W "def", Id, Id] "ghi"
+-- >>> pz @'[W "abc", W "def", Id, Id] "ghi"
 -- Present ["abc","def","ghi","ghi"]
 -- PresentT ["abc","def","ghi","ghi"]
 --
@@ -152,7 +156,7 @@ 
 -- | 'const' () function
 --
--- >>> pl @() "Asf"
+-- >>> pz @() "Asf"
 -- Present ()
 -- PresentT ()
 --
@@ -173,11 +177,11 @@ 
 -- | pulls the type level 'Bool' to the value level
 --
--- >>> pl @'True "not used"
+-- >>> pz @'True "not used"
 -- True
 -- TrueT
 --
--- >>> pl @'False ()
+-- >>> pz @'False ()
 -- False
 -- FalseT
 instance GetBool b => P (b :: Bool) a where
@@ -188,7 +192,7 @@ 
 -- | pulls the type level 'Symbol' to the value level as a 'GHC.Base.String'
 --
--- >>> pl @"hello world" ()
+-- >>> pz @"hello world" ()
 -- Present "hello world"
 -- PresentT "hello world"
 instance KnownSymbol s => P (s :: Symbol) a where
@@ -199,7 +203,7 @@ 
 -- | run the predicates in a promoted 2-tuple; similar to 'Control.Arrow.&&&'
 --
--- >>> pl @'(Id, 4) "hello"
+-- >>> pz @'(Id, 4) "hello"
 -- Present ("hello",4)
 -- PresentT ("hello",4)
 --
@@ -207,7 +211,7 @@   type PP '(p,q) a = (PP p a, PP q a)
   eval _ opts a = do
     let msg = "'(,)"
-    lr <- runPQ msg (Proxy @p) (Proxy @q) opts a
+    lr <- runPQ msg (Proxy @p) (Proxy @q) opts a []
     pure $ case lr of
        Left e -> e
        Right (p,q,pp,qq) ->
@@ -215,7 +219,7 @@ 
 -- | run the predicates in a promoted 3-tuple
 --
--- >>> pl @'(4, Id, "goodbye") "hello"
+-- >>> pz @'(4, Id, "goodbye") "hello"
 -- Present (4,"hello","goodbye")
 -- PresentT (4,"hello","goodbye")
 --
@@ -226,7 +230,7 @@   type PP '(p,q,r) a = (PP p a, PP q a, PP r a)
   eval _ opts a = do
     let msg = "'(,,)"
-    lr <- runPQ msg (Proxy @p) (Proxy @q) opts a
+    lr <- runPQ msg (Proxy @p) (Proxy @q) opts a []
     case lr of
       Left e -> pure e
       Right (p,q,pp,qq) -> do
@@ -238,7 +242,7 @@ 
 -- | run the predicates in a promoted 4-tuple
 --
--- >>> pl @'(4, Id, "inj", 999) "hello"
+-- >>> pz @'(4, Id, "inj", 999) "hello"
 -- Present (4,"hello","inj",999)
 -- PresentT (4,"hello","inj",999)
 --
@@ -250,11 +254,11 @@   type PP '(p,q,r,s) a = (PP p a, PP q a, PP r a, PP s a)
   eval _ opts a = do
     let msg = "'(,,)"
-    lr <- runPQ msg (Proxy @p) (Proxy @q) opts a
+    lr <- runPQ msg (Proxy @p) (Proxy @q) opts a []
     case lr of
       Left e -> pure e
       Right (p,q,pp,qq) -> do
-        lr1 <- runPQ msg (Proxy @r) (Proxy @s) opts a
+        lr1 <- runPQ msg (Proxy @r) (Proxy @s) opts a [hh pp, hh qq]
         pure $ case lr1 of
           Left e -> e
           Right (r,s,rr,ss) ->
@@ -262,11 +266,11 @@ 
 -- | extracts the value level representation of the promoted 'Ordering'
 --
--- >>> pl @'LT "not used"
+-- >>> pz @'LT "not used"
 -- Present LT
 -- PresentT LT
 --
--- >>> pl @'EQ ()
+-- >>> pz @'EQ ()
 -- Present EQ
 -- PresentT EQ
 instance GetOrdering cmp => P (cmp :: Ordering) a where
@@ -278,7 +282,7 @@ 
 -- | extracts the value level representation of the type level 'Nat'
 --
--- >>> pl @123 ()
+-- >>> pz @123 ()
 -- Present 123
 -- PresentT 123
 instance KnownNat n => P (n :: Nat) a where
@@ -287,9 +291,9 @@     let n = nat @n
     in pure $ mkNode opts (PresentT n) ["'" <> show n] []
 
--- | extracts the value level representation of the type level \'()
+-- | extracts the value level representation of the type level '()
 --
--- >>> pl @'() ()
+-- >>> pz @'() ()
 -- Present ()
 -- PresentT ()
 instance P '() a where
@@ -298,9 +302,9 @@ 
 -- todo: the type has to be [a] so we still need type PP '[p] a = [PP p a] to keep the types in line
 
--- | extracts the value level representation of the type level \'[]
+-- | extracts the value level representation of the type level '[]
 --
--- >>> pl @'[] False
+-- >>> pz @'[] False
 -- Present []
 -- PresentT []
 instance P ('[] :: [k]) a where
@@ -309,11 +313,11 @@ 
 -- | runs each predicate in turn from the promoted list
 --
--- >>> pl @'[1, 2, 3] 999
+-- >>> pz @'[1, 2, 3] 999
 -- Present [1,2,3]
 -- PresentT [1,2,3]
 --
--- >>> pl @'[W 1, W 2, W 3, Id] 999
+-- >>> pz @'[W 1, W 2, W 3, Id] 999
 -- Present [1,2,3,999]
 -- PresentT [1,2,3,999]
 --
@@ -321,10 +325,10 @@   type PP '[p] a = [PP p a]
   eval _ opts a = do
     pp <- eval (Proxy @p) opts a
-    let msg0 = "" -- "'[](end)"
+    let msg0 = ""
     pure $ case getValueLR opts msg0 pp [] of
        Left e -> e
-       Right b -> mkNode opts (PresentT [b]) [show01 opts msg0 b a] [hh pp] --  <> show0 opts " " a <> show1 opts " b=" b]) [hh pp]
+       Right b -> mkNode opts (PresentT [b]) [show01 opts msg0 b a] [hh pp]
 
 instance (Show (PP p a)
         , Show a
@@ -336,7 +340,7 @@   type PP (p ': p1 ': ps) a = [PP p a]
   eval _ opts a = do
     let msg0 = "'(p':q)"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @(p1 ': ps)) opts a
+    lr <- runPQ msg0 (Proxy @p) (Proxy @(p1 ': ps)) opts a []
     pure $ case lr of
       Left e -> e
       Right (p,q,pp,qq) ->
@@ -346,15 +350,15 @@ 
 -- | extracts the \'a\' from type level \'Maybe a\' if the value exists
 --
--- >>> pl @('Just Id) (Just 123)
+-- >>> pz @('Just Id) (Just 123)
 -- Present 123
 -- PresentT 123
 --
--- >>> pl @('Just Id) (Just True)
+-- >>> pz @('Just Id) (Just True)
 -- Present True
 -- PresentT True
 --
--- >>> pl @('Just Id) Nothing
+-- >>> pz @('Just Id) Nothing
 -- Error 'Just found Nothing
 -- FailT "'Just found Nothing"
 --
@@ -376,11 +380,11 @@ -- | expects Nothing otherwise it fails
 -- if the value is Nothing then it returns \'Proxy a\' as this provides more information than '()'
 --
--- >>> pl @'Nothing Nothing
+-- >>> pz @'Nothing Nothing
 -- Present Proxy
 -- PresentT Proxy
 --
--- >>> pl @'Nothing (Just True)
+-- >>> pz @'Nothing (Just True)
 -- Error 'Nothing found Just
 -- FailT "'Nothing found Just"
 --
@@ -395,11 +399,11 @@ -- omitted Show x so we can have less ambiguity
 -- | extracts the \'a\' from type level \'Either a b\' if the value exists
 --
--- >>> pl @('Left Id) (Left 123)
+-- >>> pz @('Left Id) (Left 123)
 -- Present 123
 -- PresentT 123
 --
--- >>> pl @('Left Id) (Right "aaa")
+-- >>> pz @('Left Id) (Right "aaa")
 -- Error 'Left found Right
 -- FailT "'Left found Right"
 --
@@ -420,11 +424,11 @@ 
 -- | extracts the \'b\' from type level \'Either a b\' if the value exists
 --
--- >>> pl @('Right Id) (Right 123)
+-- >>> pz @('Right Id) (Right 123)
 -- Present 123
 -- PresentT 123
 --
--- >>> pl @('Right Id) (Left "aaa")
+-- >>> pz @('Right Id) (Left "aaa")
 -- Error 'Right found Left
 -- FailT "'Right found Left"
 --
@@ -447,15 +451,15 @@ 
 -- | extracts the \'a\' from type level \'These a b\' if the value exists
 --
--- >>> pl @('This Id) (This 123)
+-- >>> pz @('This Id) (This 123)
 -- Present 123
 -- PresentT 123
 --
--- >>> pl @('This Id) (That "aaa")
+-- >>> pz @('This Id) (That "aaa")
 -- Error 'This found That
 -- FailT "'This found That"
 --
--- >>> pl @('This Id) (These 999 "aaa")
+-- >>> pz @('This Id) (These 999 "aaa")
 -- Error 'This found These
 -- FailT "'This found These"
 --
@@ -476,15 +480,15 @@ 
 -- | extracts the \'b\' from type level \'These a b\' if the value exists
 --
--- >>> pl @('That Id) (That 123)
+-- >>> pz @('That Id) (That 123)
 -- Present 123
 -- PresentT 123
 --
--- >>> pl @('That Id) (This "aaa")
+-- >>> pz @('That Id) (This "aaa")
 -- Error 'That found This
 -- FailT "'That found This"
 --
--- >>> pl @('That Id) (These 44 "aaa")
+-- >>> pz @('That Id) (These 44 "aaa")
 -- Error 'That found These
 -- FailT "'That found These"
 --
@@ -506,19 +510,19 @@ 
 -- | extracts the (a,b) from type level 'These a b' if the value exists
 --
--- >>> pl @('These Id Id) (These 123 "abc")
+-- >>> pz @('These Id Id) (These 123 "abc")
 -- Present (123,"abc")
 -- PresentT (123,"abc")
 --
--- >>> pl @('These Id 5) (These 123 "abcde")
+-- >>> pz @('These Id 5) (These 123 "abcde")
 -- Present (123,5)
 -- PresentT (123,5)
 --
--- >>> pl @('These Id Id) (This "aaa")
+-- >>> pz @('These Id Id) (This "aaa")
 -- Error 'These found This
 -- FailT "'These found This"
 --
--- >>> pl @('These Id Id) (That "aaa")
+-- >>> pz @('These Id Id) (That "aaa")
 -- Error 'These found That
 -- FailT "'These found That"
 --
@@ -548,7 +552,7 @@ 
 -- | converts the value to the corresponding 'Proxy'
 --
--- >>> pl @'Proxy 'x'
+-- >>> pz @'Proxy 'x'
 -- Present Proxy
 -- PresentT Proxy
 --
@@ -561,25 +565,27 @@ -- End non-Type kinds
 -----------------------
 
-pe, pe2, pe2n, pu, pun, pe3, pl, plc :: forall p a . (Show (PP p a), P p a) => a -> IO (BoolT (PP p a))
+pe, pe2, pe2n, pu, pun, pe3, pl, plc, pz :: forall p a . (Show (PP p a), P p a) => a -> IO (BoolT (PP p a))
 -- | displays the evaluation tree in plain text without colors
 pe  = peWith @p o0
 -- | displays the evaluation tree using colors
 pe2 = peWith @p o2
--- | same as 'pe2' but truncates the display tree horizontally: see 'o2n'
+-- | same as 'pe2' but truncates the display tree width: see 'o2n'
 pe2n = peWith @p o2n
--- | same as 'pe2' but wider display
+-- | same as 'pe2' but allows for wider data
 pe3 = peWith @p o3
 -- | skips the evaluation tree and just displays the end result
+pz = peWith @p oz
+-- | same as 'pz' but adds context to the end result
 pl = peWith @p ol
--- | same as 'pl' but with colors
+-- | same as 'pz' but with colors
 plc = peWith @p olc
 -- | display the evaluation tree using unicode and colors
 -- @
 --   pu @'(Id, "abc", 123) [1..4]
 -- @
 pu = peWith @p ou
--- | same as 'pu' but truncates the display tree horizontally: see 'ou'
+-- | same as 'pu' but truncates the display tree width: see 'ou'
 pun = peWith @p oun
 
 peWith :: forall p a
@@ -590,30 +596,37 @@ peWith opts a = do
   pp <- eval (Proxy @p) opts a
   let r = pp ^. tBool
-  if oLite opts then
-    let f = colorMe opts (r ^. boolT2P)
-    in putStrLn $ case r of
-         FailT e -> f "Error" <> " " <> e
-         TrueT -> f "True"
-         FalseT -> f "False"
-         PresentT x -> f "Present" <> " " <> show x
-  else prtTree opts (fromTT pp)
+  putStr $ prtTreeX opts pp
   return r
 
+prtTreeX :: Show x => POpts -> TT x -> String
+prtTreeX opts pp =
+  let r = pp ^. tBool
+  in if hasNoTree opts then
+      let f = colorMe opts (r ^. boolT2P)
+          tm = if oDebug opts == OZero then "" else topMessage pp
+      in (<>"\n") $ case r of
+           FailT e -> f "Error" <> " " <> e
+           TrueT -> f "True " <> tm
+           FalseT -> f "False " <> tm
+           PresentT x -> f "Present" <> " " <> show x <> " " <> tm
+    else prtTreePure opts (fromTT pp)
+
 runPQ :: (P p a, P q a, MonadEval m)
    => String
    -> Proxy p
    -> Proxy q
    -> POpts
    -> a
+   -> [Holder]
    -> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
-runPQ msg0 proxyp proxyq opts a = do
+runPQ msg0 proxyp proxyq opts a hhs = do
     pp <- eval proxyp opts a
-    case getValueLR opts msg0 pp [] of
+    case getValueLR opts msg0 pp hhs of
       Left e -> pure $ Left e
       Right p -> do
          qq <- eval proxyq opts a
-         pure $ case getValueLR opts msg0 qq [hh pp] of
+         pure $ case getValueLR opts msg0 qq (hhs <> [hh pp]) of
            Left e -> Left e
            Right q -> Right (p, q, pp, qq)
src/Predicate/Prelude.hs view
@@ -22,7435 +22,8486 @@ {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE NoStarIsType #-}
-{-# LANGUAGE OverloadedLists #-}
-{- |
-     Dsl for evaluating and displaying type level expressions
-
-     Contains instances of the class 'P' for evaluating expressions at the type level.
--}
-module Predicate.Prelude (
-  -- ** boolean methods
-    type (&&)
-  , type (||)
-  , type (~>)
-  , Not
-  , Ands
-  , Ors
-  , Asc
-  , Asc'
-  , Desc
-  , Desc'
-  , Between
-  , type (<..>)
-  , Between'
-  , All
-  , Any
-  , AllPositive
-  , AllPositive'
-  , Positive
-  , AllNegative
-  , AllNegative'
-  , Negative
-
-  -- ** regex methods
-  , Re
-  , Re'
-  , Rescan
-  , Rescan'
-  , RescanRanges
-  , RescanRanges'
-  , Resplit
-  , Resplit'
-  , ReplaceAll
-  , ReplaceAll'
-  , ReplaceOne
-  , ReplaceOne'
-  , ReplaceAllString
-  , ReplaceAllString'
-  , ReplaceOneString
-  , ReplaceOneString'
-  , MakeRR
-  , MakeRR1
-  , MakeRR2
-  , MakeRR3
-
-  -- ** tuple methods
-  , Fst
-  , Snd
-  , Thd
-  , L1
-  , L2
-  , L3
-  , L4
-  , L5
-  , L6
-  , Dup
-  , Swap
-  , Assoc
-  , Unassoc
-  , ReverseTupleN
-  , TupleI
-  , Pairs
-
- -- ** character methods
-  , CharSet(..)
-  , IsLower
-  , IsUpper
-  , IsNumber
-  , IsSpace
-  , IsPunctuation
-  , IsControl
-  , IsHexDigit
-  , IsOctDigit
-  , IsSeparator
-  , IsLatin1
-
-  -- ** date time methods
-  , FormatTimeP
-  , ParseTimeP
-  , ParseTimeP'
-  , ParseTimes
-  , ParseTimes'
-  , MkDay
-  , MkDay'
-  , UnMkDay
-
-  -- ** numeric methods
-  , type (+)
-  , type (-)
-  , type (*)
-  , type (/)
-
-  , type (%)
-  , type (%-)
-  , type (-%)
-  , Negate
-  , Abs
-  , Signum
-  , FromInteger
-  , FromInteger'
-  , FromIntegral
-  , FromIntegral'
-  , ToRational
-  , FromRational
-  , FromRational'
-  , Truncate
-  , Truncate'
-  , Ceiling
-  , Ceiling'
-  , Floor
-  , Floor'
-  , Even
-  , Odd
-  , Div
-  , Mod
-  , DivMod
-  , QuotRem
-  , Quot
-  , Rem
-
- -- ** proxy methods
-  , MkProxy
-  , ProxyT
-  , ProxyT'
-  , Unproxy
-
- -- ** read / show methods
-  , ShowP
-  , ReadP
-  , ReadP'
-  , ReadP''
-  , ReadBase
-  , ReadBase'
-  , ReadBaseInt
-  , ShowBase
-  , ShowBase'
-
-  -- ** arrow methods
-  , type (&&&)
-  , type (***)
-  , First
-  , Second
-  , type (|||)
-  , type (+++)
-
- -- ** compare methods
-  , type (>)
-  , type (>=)
-  , type (==)
-  , type (/=)
-  , type (<=)
-  , type (<)
-  , type (>~)
-  , type (>=~)
-  , type (==~)
-  , type (/=~)
-  , type (<=~)
-  , type (<~)
-  , Gt
-  , Ge
-  , Same
-  , Le
-  , Lt
-  , Ne
-  , OrdP
-  , type (==!)
-  , OrdA'
-  , OrdA
-  , OrdI
-  , type (===~)
-  , Cmp
-  , CmpI
-
-  -- ** enum methods
-  , Succ
-  , Pred
-  , FromEnum
-  , ToEnum
-  , ToEnum'
-  , EnumFromTo
-  , SuccB
-  , SuccB'
-  , PredB
-  , PredB'
-  , ToEnumB
-  , ToEnumB'
-  , ToEnumBF
-
- -- ** wrap / unwrap methods
-  , Unwrap
-  , Wrap
-  , Wrap'
-  , Coerce
-  , Coerce2
-
-  -- ** list / foldable methods
-  , Map
-  , Concat
-  , ConcatMap
-  , Partition
-  , FilterBy
-  , Break
-  , Span
-  , Intercalate
-  , Elem
-  , Inits
-  , Tails
-  , Ones
-  , OneP
-  , Len
-  , Length
-  , PadL
-  , PadR
-  , SplitAts
-  , SplitAt
-  , Take
-  , Drop
-  , Head
-  , Tail
-  , Init
-  , Last
-  , Min
-  , Max
-  , Sum
-  , IsEmpty
-  , Null
-  , ToList
-  , ToList'
-  , IToList
-  , IToList'
-  , ToListExt
-  , FromList
-  , FromListExt
-  , EmptyList
-  , EmptyList'
-  , Singleton
-  , Reverse
-  , ReverseL
-  , SortBy
-  , SortOn
-  , SortOnDesc
-  , Remove
-  , Keep
-  , HeadDef
-  , HeadP
-  , HeadFail
-  , TailDef
-  , TailP
-  , TailFail
-  , LastDef
-  , LastP
-  , LastFail
-  , InitDef
-  , InitP
-  , InitFail
-  , Head'
-  , Tail'
-  , Last'
-  , Init'
-
- -- ** maybe methods
-  , MkNothing
-  , MkNothing'
-  , MkJust
-  , IsNothing
-  , IsJust
-  , MapMaybe
-  , CatMaybes
-  , Just'
-  , JustDef
-  , JustP
-  , JustFail
-  , MaybeX
-  , MaybeIn
-  , MaybeBool
-  , JustDef'
-  , JustDef''
-  , JustDef'''
-
- -- ** either methods
-  , PartitionEithers
-  , IsLeft
-  , IsRight
-  , MkLeft
-  , MkLeft'
-  , MkRight
-  , MkRight'
-  , Left'
-  , Right'
-  , LeftDef
-  , LeftP
-  , LeftFail
-  , RightDef
-  , RightP
-  , RightFail
-  , EitherBool
-  , MkRightAlt
-  , MkLeftAlt
-  , EitherIn
-
-  -- ** semigroup / monoid methods
-  , type (<>)
-  , MConcat
-  , STimes
-  , Ands'
-  , Ors'
-  , Min'
-  , Max'
-  , Sum'
-  , Sapa
-  , Sapa'
-  , MEmptyT
-  , MEmptyT'
-  , MEmptyP
-  , MEmptyT2
-  , MEmptyT2'
-
-  -- ** indexing methods
-  , Ix
-  , Ix'
-  , IxL
-  , type (!!)
-  , Lookup
-  , type (!!!)
-  , Lookup'
-  , LookupDef
-  , LookupDef'
-  , LookupP
-  , LookupP'
-  , LookupFail
-  , LookupFail'
-
- -- cons / uncons methods
-  , type (:+)
-  , type (+:)
-  , Uncons
-  , Unsnoc
-
- -- ** these methods
-  , PartitionThese
-  , Thiss
-  , Thats
-  , Theses
-  , This'
-  , That'
-  , IsThis
-  , IsThat
-  , IsThese
-  , MkThis
-  , MkThis'
-  , MkThat
-  , MkThat'
-  , MkThese
-  , ThisDef
-  , ThisP
-  , ThisFail
-  , ThatDef
-  , ThatP
-  , ThatFail
-  , TheseDef
-  , TheseP
-  , TheseFail
-  , TheseIn
-  , TheseIn'
-  , TheseId
-  , TheseX
-
- -- ** fold / unfold methods
-  , Scanl
-  , ScanN
-  , ScanNA
-  , FoldN
-  , Foldl
-  , Unfoldr
-  , IterateN
-  , IterateUntil
-  , IterateWhile
-  , IterateNWhile
-  , IterateNUntil
-
-  -- ** failure methods
-  , Fail
-  , Failp
-  , Failt
-  , FailS
-  , FailPrt
-  , FailPrt2
-  , Catch
-  , Catch'
-
-  -- ** zip methods
-  , ZipThese
-  , ZipL
-  , ZipR
-  , ZipTrunc
-  , Unzip
-
-  -- ** conditional methods
-  , If
-  , Case
-  , Case'
-  , Case''
-  , Guards
-  , GuardsLax
-  , GuardsQuick
-  , GuardsQuickLax
-  , Guard
-  , Guard'
-  , ExitWhen
-  , ExitWhen'
-  , GuardSimple
-  , Guards'
-  , ToGuards
-  , GuardsN
-  , GuardsNLax
-  , GuardsDetail
-
--- ** parallel methods
-  , ToPara
-  , Para
-  , ParaLax
-  , ParaN
-  , ParaNLax
-  , Repeat
-
-  -- ** IO methods
-  , ReadFile
-  , FileExists
-  , ReadDir
-  , DirExists
-  , ReadEnv
-  , ReadEnvAll
-  , TimeUtc
-  , TimeZt
-  , AppendFile
-  , WriteFile
-  , WriteFile'
-  , Stdout
-  , Stderr
-  , Stdin
-
-  -- ** string methods
-  , ToLower
-  , ToUpper
-  , Trim
-  , TrimStart
-  , TrimEnd
-  , StripLR
-  , StripRight
-  , StripLeft
-  , IsPrefix
-  , IsInfix
-  , IsSuffix
-  , IsPrefixI
-  , IsInfixI
-  , IsSuffixI
-  , FromStringP
-  , FromStringP'
-
-  -- ** printf methods
-  , Printf
-  , Printfn
-  , Printfnt
-  , PrintfntLax
-  , Printf2
-  , Printf3
-  , Printf3'
-
-  -- ** higher order methods
-  , Pure
-  , Pure2
-  , FoldMap
-  , type (<$)
-  , type (<*)
-  , type (*>)
-  , Fmap_1
-  , Fmap_2
-  , Sequence
-  , Traverse
-  , Join
-  , EmptyT
-  , type (<|>)
-  , Extract
-  , Duplicate
-
-  -- ** expression combinators
-  , type ($)
-  , type (&)
-  , Do
-  , type (>>)
-  , type (<<)
-  , DoN
-
-  -- ** miscellaneous
-  , Prime
-  , Luhn
-  , Char1
-  , Hide
-  , Hole
-  , H
-  , Skip
-  , type (|>)
-  , type (>|)
- ) where
-import Predicate.Core
-import Predicate.Util
-import Safe
-import GHC.TypeLits (Symbol,Nat,KnownSymbol,KnownNat,ErrorMessage((:$$:),(:<>:)))
-import qualified GHC.TypeLits as GL
-import Control.Lens hiding (strict,iall)
---import Control.Lens (Unwrapped, Wrapped, _Unwrapped', _Wrapped', Ixed, IxValue, Index, Reversing, Cons, Snoc, AsEmpty, FoldableWithIndex, allOf, (%~), (<&>), (^.), (^?), coerced, view, reversed, ix, cons, snoc, _Cons, _Snoc, (^?!), (.~), itoList, Identity(..), _Empty, has)
-import Data.List
-import qualified Data.Text.Lens as TL
-import Data.Proxy
-import Control.Applicative
-import Data.Typeable
-import Control.Monad.Except
-import qualified Control.Exception as E
-import Data.Kind (Type)
-import qualified Text.Regex.PCRE.Heavy as RH
-import Data.String
-import Data.Foldable
-import Data.Maybe
-import Control.Arrow
-import qualified Data.Semigroup as SG
-import Numeric
-import Data.Char
-import Data.Function
-import Data.These (These(..), these, partitionThese)
-import qualified Data.Bifunctor.Swap as SW (Swap(..))
-import qualified Data.Bifunctor.Assoc as AS (Assoc(..))
-import Data.Ratio
-import Data.Time
-import Data.Coerce
-import Data.Void
-import qualified Data.Sequence as Seq
-import Text.Printf
-import System.Directory
-import Control.Comonad
-import System.IO
-import System.Environment
-import qualified GHC.Exts as GE
-import Data.Bool
-import Data.Either
-import qualified Data.Type.Equality as DE
-import Data.Time.Calendar.WeekDate
-
--- $setup
--- >>> :set -XDataKinds
--- >>> :set -XTypeApplications
--- >>> :set -XTypeOperators
--- >>> :set -XNoStarIsType
--- >>> :set -XOverloadedStrings
--- >>> :set -XNoOverloadedLists
--- >>> import qualified Data.Map.Strict as M
--- >>> import qualified Data.Text as T
-
--- | a type level predicate for a monotonic increasing list
---
--- >>> pl @Asc "aaacdef"
--- True
--- TrueT
---
--- >>> pl @Asc [1,2,3,4,5,5,7]
--- True
--- TrueT
---
--- >>> pl @Asc' [1,2,3,4,5,5,7]
--- False
--- FalseT
---
--- >>> pl @Asc "axacdef"
--- False
--- FalseT
---
-
-
--- | a type level predicate for a monotonic increasing list
-type Asc = Ands (Map (Fst Id <= Snd Id) Pairs)
--- | a type level predicate for a strictly increasing list
-type Asc' = Ands (Map (Fst Id < Snd Id) Pairs)
--- | a type level predicate for a monotonic decreasing list
-type Desc = Ands (Map (Fst Id >= Snd Id) Pairs)
--- | a type level predicate for a strictly decreasing list
-type Desc' = Ands (Map (Fst Id > Snd Id) Pairs)
-
---type AscAlt = SortOn Id Id == Id
---type DescAlt = SortOnDesc Id Id == Id
-
--- | A predicate that determines if the value is between \'p\' and \'q\'
---
--- >>> pl @(Between' 5 8 Len) [1,2,3,4,5,5,7]
--- True
--- TrueT
---
--- >>> pl @(Between 5 8) 6
--- True
--- TrueT
---
--- >>> pl @(Between 5 8) 9
--- False
--- FalseT
---
--- >>> pl @(10 % 4 <..> 40 % 5) 4
--- True
--- TrueT
---
--- >>> pl @(10 % 4 <..> 40 % 5) 33
--- False
--- FalseT
---
-type Between p q = Ge p && Le q
-type p <..> q = Ge p && Le q
-infix 4 <..>
-
--- | This is the same as 'Between' but where \'r\' is 'Id'
-type Between' p q r = r >= p && r <= q
-
--- | a type level predicate for all positive elements in a list
---
--- >>> pl @AllPositive [1,5,10,2,3]
--- True
--- TrueT
---
--- >>> pl @AllPositive [0,1,5,10,2,3]
--- False
--- FalseT
---
--- >>> pl @AllPositive [3,1,-5,10,2,3]
--- False
--- FalseT
---
--- >>> pl @AllNegative [-1,-5,-10,-2,-3]
--- True
--- TrueT
---
-type AllPositive = Ands (Map Positive Id)
--- | a type level predicate for all negative elements in a list
-type AllNegative = Ands (Map Negative Id)
-type Positive = Gt 0
-type Negative = Lt 0
-
-type AllPositive' = FoldMap SG.All (Map Positive Id)
-type AllNegative' = FoldMap SG.All (Map Negative Id)
-
--- | similar to 'all'
---
--- >>> pl @(All Even Id) [1,5,11,5,3]
--- False
--- FalseT
---
--- >>> pl @(All Odd Id) [1,5,11,5,3]
--- True
--- TrueT
---
--- >>> pl @(All Odd Id) []
--- True
--- TrueT
---
-type All x p = Ands (Map x p)
--- | similar to 'any'
---
--- >>> pl @(Any Even Id) [1,5,11,5,3]
--- False
--- FalseT
---
--- >>> pl @(Any Even Id) [1,5,112,5,3]
--- True
--- TrueT
---
--- >>> pl @(Any Even Id) []
--- False
--- FalseT
---
-type Any x p = Ors (Map x p)
-
--- | 'unzip' equivalent
---
--- >>> pl @Unzip (zip [1..5] "abcd")
--- Present ([1,2,3,4],"abcd")
--- PresentT ([1,2,3,4],"abcd")
---
-type Unzip = '(Map (Fst Id) Id, Map (Snd Id) Id)
-
--- | represents a predicate using a 'Symbol' as a regular expression
--- evaluates 'Re' and returns True if there is a match
---
--- >>> pl @(Re "^\\d{2}:\\d{2}:\\d{2}$" Id) "13:05:25"
--- True
--- TrueT
---
-data Re' (rs :: [ROpt]) p q
-type Re p q = Re' '[] p q
-
-instance (GetROpts rs
-        , PP p x ~ String
-        , PP q x ~ String
-        , P p x
-        , P q x
-        ) => P (Re' rs p q) x where
-  type PP (Re' rs p q) x = Bool
-  eval _ opts x = do
-    let msg0 = "Re" <> (if null rs then "' " <> show rs else "")
-        rs = getROpts @rs
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let msg1 = msg0 <> " (" <> p <> ")"
-            hhs = [hh pp, hh qq]
-        in case compileRegex @rs opts msg1 p hhs of
-            Left tta -> tta
-            Right regex ->
-               let b = q RH.=~ regex
-               in mkNodeB opts b [msg1 <> showLit1 opts " | " q] hhs
-
--- only way with rescan is to be explicit: no repeats! and useanchors but not (?m)
--- or just use Re' but then we only get a bool ie doesnt capture groups
--- rescan returns Right [] as an failure!
--- [] is failure!
-
-
--- | runs a regex matcher returning the original values and optionally any groups
---
--- >>> pl @(Rescan "^(\\d{2}):(\\d{2}):(\\d{2})$" Id) "13:05:25"
--- Present [("13:05:25",["13","05","25"])]
--- PresentT [("13:05:25",["13","05","25"])]
---
--- >>> pl @(Rescan (Snd Id) "13:05:25") ('a',"^(\\d{2}):(\\d{2}):(\\d{2})$")
--- Present [("13:05:25",["13","05","25"])]
--- PresentT [("13:05:25",["13","05","25"])]
---
-data Rescan' (rs :: [ROpt]) p q
-type Rescan p q = Rescan' '[] p q
-
-instance (GetROpts rs
-        , PP p x ~ String
-        , PP q x ~ String
-        , P p x
-        , P q x
-        ) => P (Rescan' rs p q) x where
-  type PP (Rescan' rs p q) x = [(String, [String])]
-  eval _ opts x = do
-    let msg0 = "Rescan" <> (if null rs then "' " <> show rs else "")
-        rs = getROpts @rs
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let msg1 = msg0 <> " (" <> p <> ")"
-            hhs = [hh pp, hh qq]
-        in case compileRegex @rs opts msg1 p hhs of
-          Left tta -> tta
-          Right regex ->
-            case splitAt _MX $ RH.scan regex q of
-              (b, _:_) -> mkNode opts (FailT "Regex looping") [msg1 <> " Looping? " <> show (take 10 b) <> "..." <> show1 opts " | " q] hhs
-              ([], _) -> -- this is a failure cos empty string returned: so reuse p?
-                         mkNode opts (FailT "Regex no results") [msg1 <> " no match" <> show1 opts " | " q] [hh pp, hh qq]
-              (b, _) -> mkNode opts (PresentT b) [lit01 opts msg1 b q] [hh pp, hh qq]
-
-
--- | similar to 'Rescan' but gives the column start and ending positions instead of values
---
--- >>> pl @(RescanRanges "^(\\d{2}):(\\d{2}):(\\d{2})$" Id) "13:05:25"
--- Present [((0,8),[(0,2),(3,5),(6,8)])]
--- PresentT [((0,8),[(0,2),(3,5),(6,8)])]
---
-data RescanRanges' (rs :: [ROpt]) p q
-type RescanRanges p q = RescanRanges' '[] p q
-
-instance (GetROpts rs
-        , PP p x ~ String
-        , PP q x ~ String
-        , P p x
-        , P q x
-        ) => P (RescanRanges' rs p q) x where
-  type PP (RescanRanges' rs p q) x = [((Int,Int), [(Int,Int)])]
-  eval _ opts x = do
-    let msg0 = "RescanRanges" <> (if null rs then "' " <> show rs else "")
-        rs = getROpts @rs
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let msg1 = msg0 <> " (" <> p <> ")"
-            hhs = [hh pp, hh qq]
-        in case compileRegex @rs opts msg1 p hhs of
-          Left tta -> tta
-          Right regex ->
-            case splitAt _MX $ RH.scanRanges regex q of
-              (b, _:_) -> mkNode opts (FailT "Regex looping") [msg1 <> " Looping? " <> show (take 10 b) <> "..." <> show1 opts " | " q] hhs
-              ([], _) -> -- this is a failure cos empty string returned: so reuse p?
-                         mkNode opts (FailT "Regex no results") [msg1 <> " no match" <> show1 opts " | " q] hhs
-              (b, _) -> mkNode opts (PresentT b) [lit01 opts msg1 b q] hhs
-
--- | splits a string on a regex delimiter
---
--- >>> pl @(Resplit "\\." Id) "141.201.1.22"
--- Present ["141","201","1","22"]
--- PresentT ["141","201","1","22"]
---
--- >>> pl @(Resplit (Singleton (Fst Id)) (Snd Id)) (':', "12:13:1")
--- Present ["12","13","1"]
--- PresentT ["12","13","1"]
---
-data Resplit' (rs :: [ROpt]) p q
-type Resplit p q = Resplit' '[] p q
-
-instance (GetROpts rs
-        , PP p x ~ String
-        , PP q x ~ String
-        , P p x
-        , P q x
-        ) => P (Resplit' rs p q) x where
-  type PP (Resplit' rs p q) x  = [String]
-  eval _ opts x = do
-    let msg0 = "Resplit" <> (if null rs then "' " <> show rs else "")
-        rs = getROpts @rs
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let msg1 = msg0 <> " (" <> p <> ")"
-            hhs = [hh pp, hh qq]
-        in case compileRegex @rs opts msg1 p hhs of
-          Left tta -> tta
-          Right regex ->
-            case splitAt _MX $ RH.split regex q of
-              (b, _:_) -> mkNode opts (FailT "Regex looping") [msg1 <> " Looping? " <> show (take 10 b) <> "..." <> show1 opts " | " q] hhs
-              ([], _) -> -- this is a failure cos empty string returned: so reuse p?
-                         mkNode opts (FailT "Regex no results") [msg1 <> " no match" <> show1 opts " | " q] hhs
-              (b, _) -> mkNode opts (PresentT b) [lit01 opts msg1 b q] hhs
-
-_MX :: Int
-_MX = 100
-
--- | replaces regex \'s\' with a string \'s1\' inside the value
---
--- >>> pl @(ReplaceAllString "\\." ":" Id) "141.201.1.22"
--- Present "141:201:1:22"
--- PresentT "141:201:1:22"
---
-data ReplaceImpl (alle :: Bool) (rs :: [ROpt]) p q r
-type ReplaceAll' (rs :: [ROpt]) p q r = ReplaceImpl 'True rs p q r
-type ReplaceAll p q r = ReplaceAll' '[] p q r
-type ReplaceOne' (rs :: [ROpt]) p q r = ReplaceImpl 'False rs p q r
-type ReplaceOne p q r = ReplaceOne' '[] p q r
-
-type ReplaceAllString' (rs :: [ROpt]) p q r = ReplaceAll' rs p (MakeRR q) r
-type ReplaceAllString p q r = ReplaceAllString' '[] p q r
-
-type ReplaceOneString' (rs :: [ROpt]) p q r = ReplaceOne' rs p (MakeRR q) r
-type ReplaceOneString p q r = ReplaceOneString' '[] p q r
-
--- | Simple replacement string: see 'ReplaceAllString' and 'ReplaceOneString'
---
-data MakeRR p
-
-instance (PP p x ~ String
-        , P p x) => P (MakeRR p) x where
-  type PP (MakeRR p) x = RR
-  eval _ opts x = do
-    let msg0 = "MakeRR"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = RR p
-        in mkNode opts (PresentT b) [msg0 <> show1 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'
---
--- Requires "Text.Show.Functions"
---
-data MakeRR1 p
-
-instance (PP p x ~ (String -> [String] -> String)
-        , P p x) => P (MakeRR1 p) x where
-  type PP (MakeRR1 p) x = RR
-  eval _ opts x = do
-    let msg0 = "MakeRR1 (String -> [String] -> String)"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right f -> mkNode opts (PresentT (RR1 f)) [msg0] [hh pp]
-
--- | A replacement function (String -> String) that yields the whole match
--- Used by 'RH.sub' and 'RH.gsub'
---
--- Requires "Text.Show.Functions"
---
--- >>> :m + Text.Show.Functions
--- >>> pl @(ReplaceAll "\\." (MakeRR2 (Fst Id)) (Snd Id)) (\x -> x <> ":" <> x, "141.201.1.22")
--- Present "141.:.201.:.1.:.22"
--- PresentT "141.:.201.:.1.:.22"
---
-data MakeRR2 p
-
-instance (PP p x ~ (String -> String)
-        , P p x) => P (MakeRR2 p) x where
-  type PP (MakeRR2 p) x = RR
-  eval _ opts x = do
-    let msg0 = "MakeRR2 (String -> String)"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right f -> mkNode opts (PresentT (RR2 f)) [msg0] [hh pp]
-
--- | A replacement function ([String] -> String) which yields the groups
--- Used by 'RH.sub' and 'RH.gsub'
---
--- Requires "Text.Show.Functions"
---
--- >>> :m + Text.Show.Functions
--- >>> pl @(ReplaceAll "^(\\d+)\\.(\\d+)\\.(\\d+)\\.(\\d+)$" (MakeRR3 (Fst Id)) (Snd Id)) (\ys -> intercalate  " | " $ map (show . succ . read @Int) ys, "141.201.1.22")
--- Present "142 | 202 | 2 | 23"
--- PresentT "142 | 202 | 2 | 23"
---
-data MakeRR3 p
-
-instance (PP p x ~ ([String] -> String)
-        , P p x) => P (MakeRR3 p) x where
-  type PP (MakeRR3 p) x = RR
-  eval _ opts x = do
-    let msg0 = "MakeRR3 ([String] -> String)"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right f -> mkNode opts (PresentT (RR3 f)) [msg0] [hh pp]
-
-instance (GetBool b
-        , GetROpts rs
-        , PP p x ~ String
-        , PP q x ~ RR
-        , PP r x ~ String
-        , 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
-  eval _ opts x = do
-    let msg0 = "Replace" <> (if alle then "All" else "One") <> (if null rs then "' " <> show rs else "")
-        rs = getROpts @rs
-        alle = getBool @b
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    case lr of
-      Left e -> pure e
-      Right (p,q,pp,qq) ->
-        let msg1 = msg0 <> " (" <> p <> ")"
-            hhs = [hh pp, hh qq]
-        in case compileRegex @rs opts msg1 p hhs of
-          Left tta -> pure tta
-          Right regex -> do
-            rr <- eval (Proxy @r) opts x
-            pure $ case getValueLR opts msg0 rr hhs of
-              Left e -> e
-              Right r ->
-               let ret :: String
-                   ret = case q of
-                           RR s -> (if alle then RH.gsub else RH.sub) regex s r
-                           RR1 s -> (if alle then RH.gsub else RH.sub) regex s r
-                           RR2 s -> (if alle then RH.gsub else RH.sub) regex s r
-                           RR3 s -> (if alle then RH.gsub else RH.sub) regex s r
-               in mkNode opts (PresentT ret) [msg1 <> showLit0 opts " " r <> showLit1 opts " | " ret] (hhs <> [hh rr])
-
--- | a predicate for determining if a string 'Data.Text.IsText' belongs to the given character set
---
--- >>> pl @IsLower "abc"
--- True
--- TrueT
---
--- >>> pl @IsLower "abcX"
--- False
--- FalseT
---
--- >>> pl @IsLower (T.pack "abcX")
--- False
--- FalseT
---
--- >>> pl @IsHexDigit "01efA"
--- True
--- TrueT
---
--- >>> pl @IsHexDigit "01egfA"
--- False
--- FalseT
---
-data IsCharSet (cs :: CharSet)
-
-data CharSet = CLower
-             | CUpper
-             | CNumber
-             | CSpace
-             | CPunctuation
-             | CControl
-             | CHexDigit
-             | COctDigit
-             | CSeparator
-             | CLatin1
-             deriving Show
-
-class GetCharSet (cs :: CharSet) where
-  getCharSet :: (CharSet, Char -> Bool)
-instance GetCharSet 'CLower where
-  getCharSet = (CLower, isLower)
-instance GetCharSet 'CUpper where
-  getCharSet = (CUpper, isUpper)
-instance GetCharSet 'CNumber where
-  getCharSet = (CNumber, isNumber)
-instance GetCharSet 'CPunctuation where
-  getCharSet = (CPunctuation, isPunctuation)
-instance GetCharSet 'CControl where
-  getCharSet = (CControl, isControl)
-instance GetCharSet 'CHexDigit where
-  getCharSet = (CHexDigit, isHexDigit)
-instance GetCharSet 'COctDigit where
-  getCharSet = (COctDigit, isOctDigit)
-instance GetCharSet 'CSeparator where
-  getCharSet = (CSeparator, isSeparator)
-instance GetCharSet 'CLatin1 where
-  getCharSet = (CLatin1, isLatin1)
-
--- | predicate for determining if a string is all lowercase
--- >>> pl @IsLower "abcdef213"
--- False
--- FalseT
---
--- >>> pl @IsLower "abcdef"
--- True
--- TrueT
---
--- >>> pl @IsLower ""
--- True
--- TrueT
---
--- >>> pl @IsLower "abcdefG"
--- False
--- FalseT
---
-type IsLower = IsCharSet 'CLower
-type IsUpper = IsCharSet 'CUpper
--- | predicate for determining if the string is all digits
--- >>> pl @IsNumber "213G"
--- False
--- FalseT
---
--- >>> pl @IsNumber "929"
--- True
--- TrueT
---
-type IsNumber = IsCharSet 'CNumber
-type IsSpace = IsCharSet 'CSpace
-type IsPunctuation = IsCharSet 'CPunctuation
-type IsControl = IsCharSet 'CControl
-type IsHexDigit = IsCharSet 'CHexDigit
-type IsOctDigit = IsCharSet 'COctDigit
-type IsSeparator = IsCharSet 'CSeparator
-type IsLatin1 = IsCharSet 'CLatin1
-
-instance (GetCharSet cs
-        , Show a
-        , TL.IsText a
-        ) => P (IsCharSet cs) a where
-  type PP (IsCharSet cs) a = Bool
-  eval _ opts as =
-    let b = allOf TL.text f as
-        msg0 = "IsCharSet " ++ show cs
-        (cs,f) = getCharSet @cs
-    in pure $ mkNodeB opts b [msg0 <> show1 opts " | " as] []
-
-
--- | converts a string 'Data.Text.Lens.IsText' value to lower case
---
--- >>> pl @ToLower "HeLlO wOrld!"
--- Present "hello world!"
--- PresentT "hello world!"
---
-data ToLower
-
-instance (Show a, TL.IsText a) => P ToLower a where
-  type PP ToLower a = a
-  eval _ opts as =
-    let msg0 = "ToLower"
-        xs = as & TL.text %~ toLower
-    in pure $ mkNode opts (PresentT xs) [show01 opts msg0 xs as] []
-
--- | converts a string 'Data.Text.Lens.IsText' value to upper case
---
--- >>> pl @ToUpper "HeLlO wOrld!"
--- Present "HELLO WORLD!"
--- PresentT "HELLO WORLD!"
---
-data ToUpper
-
-instance (Show a, TL.IsText a) => P ToUpper a where
-  type PP ToUpper a = a
-  eval _ opts as =
-    let msg0 = "ToUpper"
-        xs = as & TL.text %~ toUpper
-    in pure $ mkNode opts (PresentT xs) [show01 opts msg0 xs as] []
-
-
--- | similar to 'Data.List.inits'
---
--- >>> pl @Inits [4,8,3,9]
--- Present [[],[4],[4,8],[4,8,3],[4,8,3,9]]
--- PresentT [[],[4],[4,8],[4,8,3],[4,8,3,9]]
---
--- >>> pl @Inits []
--- Present [[]]
--- PresentT [[]]
---
-data Inits
-
-instance Show a => P Inits [a] where
-  type PP Inits [a] = [[a]]
-  eval _ opts as =
-    let msg0 = "Inits"
-        xs = inits as
-    in pure $ mkNode opts (PresentT xs) [show01 opts msg0 xs as] []
-
--- | similar to 'Data.List.tails'
---
--- >>> pl @Tails [4,8,3,9]
--- Present [[4,8,3,9],[8,3,9],[3,9],[9],[]]
--- PresentT [[4,8,3,9],[8,3,9],[3,9],[9],[]]
---
--- >>> pl @Tails []
--- Present [[]]
--- PresentT [[]]
---
-data Tails
-
-instance Show a => P Tails [a] where
-  type PP Tails [a] = [[a]]
-  eval _ opts as =
-    let msg0 = "Tails"
-        xs = tails as
-    in pure $ mkNode opts (PresentT xs) [show01 opts msg0 xs as] []
-
--- | split a list into single values
---
--- >>> pl @(Ones Id) [4,8,3,9]
--- Present [[4],[8],[3],[9]]
--- PresentT [[4],[8],[3],[9]]
---
--- >>> pl @(Ones Id) []
--- Present []
--- PresentT []
---
-data Ones p
-
-instance ( PP p x ~ [a]
-         , P p x
-         , Show a
-         ) => P (Ones p) x where
-  type PP (Ones p) x = [PP p x]
-  eval _ opts x = do
-    let msg0 = "Ones"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = map (:[]) p
-        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
-
--- | similar to 'show'
---
--- >>> pl @(ShowP Id) [4,8,3,9]
--- Present "[4,8,3,9]"
--- PresentT "[4,8,3,9]"
---
--- >>> pl @(ShowP Id) 'x'
--- Present "'x'"
--- PresentT "'x'"
---
--- >>> pl @(ShowP (42 %- 10)) 'x'
--- Present "(-21) % 5"
--- PresentT "(-21) % 5"
---
-data ShowP p
-
-instance (Show (PP p x), P p x) => P (ShowP p) x where
-  type PP (ShowP p) x = String
-  eval _ opts x = do
-    let msg0 = "ShowP"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = show p
-        in mkNode opts (PresentT d) [msg0 <> showLit0 opts " " d <> show1 opts " | " p] [hh pp]
-
--- | type level expression representing a formatted time
--- similar to 'Data.Time.formatTime' using a type level 'Symbol' to get the formatting string
---
--- >>> pl @(FormatTimeP "%F %T" Id) (read "2019-05-24 05:19:59" :: LocalTime)
--- Present "2019-05-24 05:19:59"
--- PresentT "2019-05-24 05:19:59"
---
--- >>> pl @(FormatTimeP (Fst Id) (Snd Id)) ("the date is %d/%m/%Y", read "2019-05-24" :: Day)
--- Present "the date is 24/05/2019"
--- PresentT "the date is 24/05/2019"
---
-data FormatTimeP p q
-
-instance (PP p x ~ String
-        , FormatTime (PP q x)
-        , P p x
-        , Show (PP q x)
-        , P q x
-        ) => P (FormatTimeP p q) x where
-  type PP (FormatTimeP p q) x = String
-  eval _ opts x = do
-    let msg0 = "FormatTimeP"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let msg1 = msg0 <> " (" <> p <> ")"
-            b = formatTime defaultTimeLocale p q
-        in mkNode opts (PresentT b) [msg1 <> showLit0 opts " " b <> show1 opts " | " q] [hh pp, hh qq]
-
--- | similar to 'Data.Time.parseTimeM' where \'t\' is the 'Data.Time.ParseTime' type, \'p\' is the datetime format and \'q\' points to the content to parse
---
--- >>> pl @(ParseTimeP LocalTime "%F %T" Id) "2019-05-24 05:19:59"
--- Present 2019-05-24 05:19:59
--- PresentT 2019-05-24 05:19:59
---
--- >>> pl @(ParseTimeP LocalTime "%F %T" "2019-05-24 05:19:59") (Right "never used")
--- Present 2019-05-24 05:19:59
--- PresentT 2019-05-24 05:19:59
---
--- keeping \'q\' as we might want to extract from a tuple
-data ParseTimeP' t p q
-type ParseTimeP (t :: Type) p q = ParseTimeP' (Hole t) p q
-
-instance (ParseTime (PP t a)
-        , Typeable (PP t a)
-        , Show (PP t a)
-        , P p a
-        , P q a
-        , PP p a ~ String
-        , PP q a ~ String
-        ) => P (ParseTimeP' t p q) a where
-  type PP (ParseTimeP' t p q) a = PP t a
-  eval _ opts a = do
-    let msg0 = "ParseTimeP " <> t
-        t = showT @(PP t a)
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let msg1 = msg0 <> " (" <> p <> ")"
-            hhs = [hh pp, hh qq]
-        in case parseTimeM @Maybe @(PP t a) True defaultTimeLocale p q of
-             Just b -> mkNode opts (PresentT b) [lit01' opts msg1 b "fmt=" p <> show1 opts " | " q] hhs
-             Nothing -> mkNode opts (FailT (msg1 <> " failed to parse")) [msg1 <> " failed"] hhs
-
--- | A convenience method to match against many different datetime formats to find a match
---
--- >>> pl @(ParseTimes LocalTime '["%Y-%m-%d %H:%M:%S", "%m/%d/%y %H:%M:%S", "%B %d %Y %H:%M:%S", "%Y-%m-%dT%H:%M:%S"] "03/11/19 01:22:33") ()
--- Present 2019-03-11 01:22:33
--- PresentT 2019-03-11 01:22:33
---
--- >>> pl @(ParseTimes LocalTime (Fst Id) (Snd Id)) (["%Y-%m-%d %H:%M:%S", "%m/%d/%y %H:%M:%S", "%B %d %Y %H:%M:%S", "%Y-%m-%dT%H:%M:%S"], "03/11/19 01:22:33")
--- Present 2019-03-11 01:22:33
--- PresentT 2019-03-11 01:22:33
---
-data ParseTimes' t p q
-type ParseTimes (t :: Type) p q = ParseTimes' (Hole t) p q
-
-instance (ParseTime (PP t a)
-        , Typeable (PP t a)
-        , Show (PP t a)
-        , P p a
-        , P q a
-        , PP p a ~ [String]
-        , PP q a ~ String
-        ) => P (ParseTimes' t p q) a where
-  type PP (ParseTimes' t p q) a = PP t a
-  eval _ opts a = do
-    let msg0 = "ParseTimes " <> t
-        t = showT @(PP t a)
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let msg1 = msg0
-            hhs = [hh pp, hh qq]
-            zs = map (\d -> (d,) <$> parseTimeM @Maybe @(PP t a) True defaultTimeLocale d q) p
-        in case catMaybes zs of
-             [] -> mkNode opts (FailT ("no match on [" ++ q ++ "]")) [msg1 <> " no match"] hhs
-             (d,b):_ -> mkNode opts (PresentT b) [lit01' opts msg1 b "fmt=" d <> show1 opts " | " q] hhs
-
--- | create a 'Day' from three int values passed in as year month and day
---
--- >>> pl @MkDay (2019,12,30)
--- Present Just (2019-12-30,1,1)
--- PresentT (Just (2019-12-30,1,1))
---
--- >>> pl @(MkDay' (Fst Id) (Snd Id) (Thd Id)) (2019,99,99999)
--- Present Nothing
--- PresentT Nothing
---
--- >>> pl @MkDay (1999,3,13)
--- Present Just (1999-03-13,10,6)
--- PresentT (Just (1999-03-13,10,6))
---
-data MkDay' p q r
-type MkDay = MkDay' (Fst Id) (Snd Id) (Thd Id)
-
-instance (P p x
-        , P q x
-        , P r x
-        , PP p x ~ Int
-        , PP q x ~ Int
-        , PP r x ~ Int
-        ) => P (MkDay' p q r) x where
-  type PP (MkDay' p q r) x = Maybe (Day, Int, Int)
-  eval _ opts x = do
-    let msg0 = "MkDay"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    case lr of
-      Left e -> pure e
-      Right (p,q,pp,qq) -> do
-        let hhs = [hh pp, hh qq]
-        rr <- eval (Proxy @r) opts x
-        pure $ case getValueLR opts msg0 rr hhs of
-          Left e -> e
-          Right r ->
-            let mday = fromGregorianValid (fromIntegral p) q r
-                b = mday <&> \day ->
-                      let (_, week, dow) = toWeekDate day
-                      in (day, week, dow)
-            in mkNode opts (PresentT b) [show01' opts msg0 b "(y,m,d)=" (p,q,r)] (hhs <> [hh rr])
-
--- | uncreate a 'Day' returning year month and day
---
--- >>> pl @(UnMkDay Id) (read "2019-12-30")
--- Present (2019,12,30)
--- PresentT (2019,12,30)
---
-data UnMkDay p
-
-instance (PP p x ~ Day, P p x) => P (UnMkDay p) x where
-  type PP (UnMkDay p) x = (Int, Int, Int)
-  eval _ opts x = do
-    let msg0 = "UnMkDay"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let (fromIntegral -> y, m, d) = toGregorian p
-            b = (y, m, d)
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] []
-
--- | uses the 'Read' of the given type \'t\' and \'p\' which points to the content to read
---
--- >>> pl @(ReadP Rational) "4 % 5"
--- Present 4 % 5
--- PresentT (4 % 5)
---
--- >>> pl @(ReadP' Day Id >> Between (ReadP' Day "2017-04-11") (ReadP' Day "2018-12-30")) "2018-10-12"
--- True
--- TrueT
---
--- >>> pl @(ReadP' Day Id >> Between (ReadP' Day "2017-04-11") (ReadP' Day "2018-12-30")) "2016-10-12"
--- False
--- FalseT
---
-data ReadP'' t p
-type ReadP (t :: Type) = ReadP'' (Hole t) Id
-type ReadP' (t :: Type) p = ReadP'' (Hole t) p
-
-instance (P p x
-        , PP p x ~ String
-        , Typeable (PP t x)
-        , Show (PP t x)
-        , Read (PP t x)
-        ) => P (ReadP'' t p) x where
-  type PP (ReadP'' t p) x = PP t x
-  eval _ opts x = do
-    let msg0 = "ReadP " <> t
-        t = showT @(PP t x)
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right s ->
-        let msg1 = msg0 <> " (" <> s <> ")"
-        in case reads @(PP t x) s of
-           [(b,"")] -> mkNode opts (PresentT b) [lit01 opts msg1 b s] [hh pp]
-           _ -> mkNode opts (FailT (msg1 <> " failed")) [msg1 <> " failed"] [hh pp]
-
--- | similar to 'sum'
---
--- >>> pl @Sum [10,4,5,12,3,4]
--- Present 38
--- PresentT 38
---
--- >>> pl @Sum []
--- Present 0
--- PresentT 0
---
-data Sum
-
-instance (Num a, Show a) => P Sum [a] where
-  type PP Sum [a] = a
-  eval _ opts as =
-    let msg0 = "Sum"
-        v = sum as
-    in pure $ mkNode opts (PresentT v) [show01 opts msg0 v as] []
-
--- | similar to 'minimum'
---
--- >>> pl @Min [10,4,5,12,3,4]
--- Present 3
--- PresentT 3
---
--- >>> pl @Min []
--- Error empty list
--- FailT "empty list"
---
-data Min
-
-instance (Ord a, Show a) => P Min [a] where
-  type PP Min [a] = a
-  eval _ opts as' = do
-    let msg0 = "Min"
-    pure $ case as' of
-     [] -> mkNode opts (FailT "empty list") [msg0 <> "(empty list)"] []
-     as@(_:_) ->
-       let v = minimum as
-       in mkNode opts (PresentT v) [show01 opts msg0 v as] []
-
--- | similar to 'maximum'
---
--- >>> pl @Max [10,4,5,12,3,4]
--- Present 12
--- PresentT 12
---
--- >>> pl @Max []
--- Error empty list
--- FailT "empty list"
---
-
-data Max
---type Max' t = FoldMap (SG.Max t) Id
-
-instance (Ord a, Show a) => P Max [a] where
-  type PP Max [a] = a
-  eval _ opts as' = do
-    let msg0 = "Max"
-    pure $ case as' of
-      [] -> mkNode opts (FailT "empty list") [msg0 <> "(empty list)"] []
-      as@(_:_) ->
-        let v = maximum as
-        in mkNode opts (PresentT v) [show01 opts msg0 v as] []
-
--- | sort a list
---
--- >>> pl @(SortOn (Fst Id) Id) [(10,"abc"), (3,"def"), (4,"gg"), (10,"xyz"), (1,"z")]
--- Present [(1,"z"),(3,"def"),(4,"gg"),(10,"abc"),(10,"xyz")]
--- PresentT [(1,"z"),(3,"def"),(4,"gg"),(10,"abc"),(10,"xyz")]
---
--- >>> pl @(SortBy (OrdP (Snd Id) (Fst Id)) Id) [(10,"ab"),(4,"x"),(20,"bbb")]
--- Present [(20,"bbb"),(10,"ab"),(4,"x")]
--- PresentT [(20,"bbb"),(10,"ab"),(4,"x")]
---
--- >>> pl @(SortBy 'LT Id) [1,5,2,4,7,0]
--- Present [1,5,2,4,7,0]
--- PresentT [1,5,2,4,7,0]
---
--- >>> pl @(SortBy 'GT Id) [1,5,2,4,7,0]
--- Present [0,7,4,2,5,1]
--- PresentT [0,7,4,2,5,1]
---
--- >>> pl @(SortBy ((Fst (Fst Id) ==! Fst (Snd Id)) <> (Snd (Fst Id) ==! Snd (Snd Id))) Id) [(10,"ab"),(4,"x"),(20,"bbb"),(4,"a"),(4,"y")]
--- Present [(4,"a"),(4,"x"),(4,"y"),(10,"ab"),(20,"bbb")]
--- PresentT [(4,"a"),(4,"x"),(4,"y"),(10,"ab"),(20,"bbb")]
---
--- >>> pl @(SortBy ((Fst (Fst Id) ==! Fst (Snd Id)) <> (Snd (Snd Id) ==! Snd (Fst Id))) Id) [(10,"ab"),(4,"x"),(20,"bbb"),(4,"a"),(4,"y")]
--- Present [(4,"y"),(4,"x"),(4,"a"),(10,"ab"),(20,"bbb")]
--- PresentT [(4,"y"),(4,"x"),(4,"a"),(10,"ab"),(20,"bbb")]
---
-data SortBy p q
-type SortOn p q = SortBy (OrdA p) q
-type SortOnDesc p q = SortBy (Swap >> OrdA p) q
-
-type SortByHelper p = Partition (p == 'GT) Id
-
-instance (P p (a,a)
-        , P q x
-        , Show a
-        , PP q x ~ [a]
-        , PP p (a,a) ~ Ordering
-        ) => P (SortBy p q) x where
-  type PP (SortBy p q) x = PP q x
-  eval _ opts x = do
-    let msg0 = "SortBy"
-    qq <- eval (Proxy @q) opts x
-    case getValueLR opts (msg0 <> " q failed") qq [] of
-      Left e -> pure e
-      Right as -> do
-        let ff :: MonadEval m => [a] -> m (TT [a])
-            ff = \case
-                [] -> pure $ mkNode opts (PresentT mempty) [msg0 <> " empty"] []
-                [w] -> pure $ mkNode opts (PresentT [w]) [msg0 <> " one element " <> show w] []
-                w:ys@(_:_) -> do
-                  pp <- (if oDebug opts >= 3 then
-                              eval (Proxy @(SortByHelper p))
-                         else eval (Proxy @(Hide (SortByHelper p)))) opts (map (w,) ys)
---                  pp <- eval (Proxy @(Hide (Partition (p >> Id == 'GT) Id))) opts (map (w,) ys)
--- too much output: dont need (Map (Snd Id) *** Map (Snd Id)) -- just do map snd in code
---                  pp <- eval (Proxy @(Partition (p >> (Id == 'GT)) Id >> (Map (Snd Id) *** Map (Snd Id)))) opts (map (w,) ys)
-                  case getValueLR opts msg0 pp [] of
-                    Left e -> pure e
-                    Right (ll', rr') -> do
-                      lhs <- ff (map snd ll')
-                      case getValueLR opts msg0 lhs [] of
-                        Left _ -> pure lhs -- dont rewrap
-                        Right ll -> do
-                          rhs <- ff (map snd rr')
-                          case getValueLR opts msg0 rhs [] of
-                            Left _ -> pure rhs
-                            Right rr -> do
-                              pure $  mkNode opts (PresentT (ll ++ w : rr))
-                                     [msg0 <> show0 opts " lhs=" ll <> " pivot " <> show w <> show0 opts " rhs=" rr]
-                                     (hh pp : [hh lhs | length ll > 1] ++ [hh rhs | length rr > 1])
-        ret <- ff as
-        pure $ case getValueLR opts msg0 ret [hh qq] of
-          Left _e -> ret -- dont rewrap the error
-          Right xs -> mkNode opts (_tBool ret) [msg0 <> show0 opts " " xs] [hh qq, hh ret]
-
--- | similar to 'length'
---
--- >>> pl @Len [10,4,5,12,3,4]
--- Present 6
--- PresentT 6
---
--- >>> pl @Len []
--- Present 0
--- PresentT 0
---
-data Len
-instance (Show a, as ~ [a]) => P Len as where
-  type PP Len as = Int
-  eval _ opts as =
-    let msg0 = "Len"
-        n = length as
-    in pure $ mkNode opts (PresentT n) [show01 opts msg0 n as] []
-
--- | similar to 'length' for 'Foldable' instances
---
--- >>> pl @(Length Id) (Left "aa")
--- Present 0
--- PresentT 0
---
--- >>> pl @(Length Id) (Right "aa")
--- Present 1
--- PresentT 1
---
--- >>> pl @(Length (Right' Id)) (Right "abcd")
--- Present 4
--- PresentT 4
---
--- >>> pl @(Length (Thd (Snd Id))) (True,(23,'x',[10,9,1,3,4,2]))
--- Present 6
--- PresentT 6
---
-data Length p
-
-instance (PP p x ~ t a
-        , P p x
-        , Show (t a)
-        , Foldable t) => P (Length p) x where
-  type PP (Length p) x = Int
-  eval _ opts x = do
-    let msg0 = "Length"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right as ->
-        let n = length as
-        in mkNode opts (PresentT n) [show01 opts msg0 n as] []
-
--- | similar to 'fst'
---
--- >>> pl @(Fst Id) (10,"Abc")
--- Present 10
--- PresentT 10
---
--- >>> pl @(Fst Id) (10,"Abc",'x')
--- Present 10
--- PresentT 10
---
--- >>> pl @(Fst Id) (10,"Abc",'x',False)
--- Present 10
--- PresentT 10
---
-data Fst p
-type L1 p = Fst p
-
-instance (Show (ExtractL1T (PP p x))
-        , ExtractL1C (PP p x)
-        , P p x
-        , Show (PP p x)
-        ) => P (Fst p) x where
-  type PP (Fst p) x = ExtractL1T (PP p x)
-  eval _ opts x = do
-    let msg0 = "Fst"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = extractL1C p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
-class ExtractL1C tp where
-  type ExtractL1T tp
-  extractL1C :: tp -> ExtractL1T tp
-instance ExtractL1C (a,b) where
-  type ExtractL1T (a,b) = a
-  extractL1C (a,_) = a
-instance ExtractL1C (a,b,c) where
-  type ExtractL1T (a,b,c) = a
-  extractL1C (a,_,_) = a
-instance ExtractL1C (a,b,c,d) where
-  type ExtractL1T (a,b,c,d) = a
-  extractL1C (a,_,_,_) = a
-instance ExtractL1C (a,b,c,d,e) where
-  type ExtractL1T (a,b,c,d,e) = a
-  extractL1C (a,_,_,_,_) = a
-instance ExtractL1C (a,b,c,d,e,f) where
-  type ExtractL1T (a,b,c,d,e,f) = a
-  extractL1C (a,_,_,_,_,_) = a
-
--- | similar to 'snd'
---
--- >>> pl @(Snd Id) (10,"Abc")
--- Present "Abc"
--- PresentT "Abc"
---
--- >>> pl @(Snd Id) (10,"Abc",True)
--- Present "Abc"
--- PresentT "Abc"
---
-data Snd p
-type L2 p = Snd p
-
-instance (Show (ExtractL2T (PP p x))
-        , ExtractL2C (PP p x)
-        , P p x
-        , Show (PP p x)
-        ) => P (Snd p) x where
-  type PP (Snd p) x = ExtractL2T (PP p x)
-  eval _ opts x = do
-    let msg0 = "Snd"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = extractL2C p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
-class ExtractL2C tp where
-  type ExtractL2T tp
-  extractL2C :: tp -> ExtractL2T tp
-instance ExtractL2C (a,b) where
-  type ExtractL2T (a,b) = b
-  extractL2C (_,b) = b
-instance ExtractL2C (a,b,c) where
-  type ExtractL2T (a,b,c) = b
-  extractL2C (_,b,_) = b
-instance ExtractL2C (a,b,c,d) where
-  type ExtractL2T (a,b,c,d) = b
-  extractL2C (_,b,_,_) = b
-instance ExtractL2C (a,b,c,d,e) where
-  type ExtractL2T (a,b,c,d,e) = b
-  extractL2C (_,b,_,_,_) = b
-instance ExtractL2C (a,b,c,d,e,f) where
-  type ExtractL2T (a,b,c,d,e,f) = b
-  extractL2C (_,b,_,_,_,_) = b
-
--- | similar to 3rd element in a n-tuple
---
--- >>> pl @(Thd Id) (10,"Abc",133)
--- Present 133
--- PresentT 133
---
--- >>> pl @(Thd Id) (10,"Abc",133,True)
--- Present 133
--- PresentT 133
---
-data Thd p
-type L3 p = Thd p
-
-instance (Show (ExtractL3T (PP p x))
-        , ExtractL3C (PP p x)
-        , P p x
-        , Show (PP p x)
-        ) => P (Thd p) x where
-  type PP (Thd p) x = ExtractL3T (PP p x)
-  eval _ opts x = do
-    let msg0 = "Thd"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = extractL3C p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
-class ExtractL3C tp where
-  type ExtractL3T tp
-  extractL3C :: tp -> ExtractL3T tp
-instance ExtractL3C (a,b) where
-  type ExtractL3T (a,b) = GL.TypeError ('GL.Text "Thd doesn't work for 2-tuples")
-  extractL3C _ = error "Thd doesn't work for 2-tuples"
-instance ExtractL3C (a,b,c) where
-  type ExtractL3T (a,b,c) = c
-  extractL3C (_,_,c) = c
-instance ExtractL3C (a,b,c,d) where
-  type ExtractL3T (a,b,c,d) = c
-  extractL3C (_,_,c,_) = c
-instance ExtractL3C (a,b,c,d,e) where
-  type ExtractL3T (a,b,c,d,e) = c
-  extractL3C (_,_,c,_,_) = c
-instance ExtractL3C (a,b,c,d,e,f) where
-  type ExtractL3T (a,b,c,d,e,f) = c
-  extractL3C (_,_,c,_,_,_) = c
-
--- | similar to 4th element in a n-tuple
---
--- >>> pl @(L4 Id) (10,"Abc",'x',True)
--- Present True
--- PresentT True
---
--- >>> pl @(L4 (Fst (Snd Id))) ('x',((10,"Abc",'x',999),"aa",1),9)
--- Present 999
--- PresentT 999
---
-data L4 p
-
-instance (Show (ExtractL4T (PP p x))
-        , ExtractL4C (PP p x)
-        , P p x
-        , Show (PP p x)
-        ) => P (L4 p) x where
-  type PP (L4 p) x = ExtractL4T (PP p x)
-  eval _ opts x = do
-    let msg0 = "L4"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = extractL4C p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
-class ExtractL4C tp where
-  type ExtractL4T tp
-  extractL4C :: tp -> ExtractL4T tp
-instance ExtractL4C (a,b) where
-  type ExtractL4T (a,b) = GL.TypeError ('GL.Text "L4 doesn't work for 2-tuples")
-  extractL4C _ = error "L4 doesn't work for 2-tuples"
-instance ExtractL4C (a,b,c) where
-  type ExtractL4T (a,b,c) = GL.TypeError ('GL.Text "L4 doesn't work for 3-tuples")
-  extractL4C _ = error "L4 doesn't work for 3-tuples"
-instance ExtractL4C (a,b,c,d) where
-  type ExtractL4T (a,b,c,d) = d
-  extractL4C (_,_,_,d) = d
-instance ExtractL4C (a,b,c,d,e) where
-  type ExtractL4T (a,b,c,d,e) = d
-  extractL4C (_,_,_,d,_) = d
-instance ExtractL4C (a,b,c,d,e,f) where
-  type ExtractL4T (a,b,c,d,e,f) = d
-  extractL4C (_,_,_,d,_,_) = d
-
--- | similar to 5th element in a n-tuple
---
--- >>> pl @(L5 Id) (10,"Abc",'x',True,1)
--- Present 1
--- PresentT 1
---
-data L5 p
-
-instance (Show (ExtractL5T (PP p x))
-        , ExtractL5C (PP p x)
-        , P p x
-        , Show (PP p x)
-        ) => P (L5 p) x where
-  type PP (L5 p) x = ExtractL5T (PP p x)
-  eval _ opts x = do
-    let msg0 = "L5"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = extractL5C p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
-class ExtractL5C tp where
-  type ExtractL5T tp
-  extractL5C :: tp -> ExtractL5T tp
-instance ExtractL5C (a,b) where
-  type ExtractL5T (a,b) = GL.TypeError ('GL.Text "L5 doesn't work for 2-tuples")
-  extractL5C _ = error "L5 doesn't work for 2-tuples"
-instance ExtractL5C (a,b,c) where
-  type ExtractL5T (a,b,c) = GL.TypeError ('GL.Text "L5 doesn't work for 3-tuples")
-  extractL5C _ = error "L5 doesn't work for 3-tuples"
-instance ExtractL5C (a,b,c,d) where
-  type ExtractL5T (a,b,c,d) = GL.TypeError ('GL.Text "L5 doesn't work for 4-tuples")
-  extractL5C _ = error "L5 doesn't work for 4-tuples"
-instance ExtractL5C (a,b,c,d,e) where
-  type ExtractL5T (a,b,c,d,e) = e
-  extractL5C (_,_,_,_,e) = e
-instance ExtractL5C (a,b,c,d,e,f) where
-  type ExtractL5T (a,b,c,d,e,f) = e
-  extractL5C (_,_,_,_,e,_) = e
-
-
--- | similar to 6th element in a n-tuple
---
--- >>> pl @(L6 Id) (10,"Abc",'x',True,1,99)
--- Present 99
--- PresentT 99
---
-data L6 p
-
-instance (Show (ExtractL6T (PP p x))
-        , ExtractL6C (PP p x)
-        , P p x
-        , Show (PP p x)
-        ) => P (L6 p) x where
-  type PP (L6 p) x = ExtractL6T (PP p x)
-  eval _ opts x = do
-    let msg0 = "L6"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = extractL6C p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
-class ExtractL6C tp where
-  type ExtractL6T tp
-  extractL6C :: tp -> ExtractL6T tp
-instance ExtractL6C (a,b) where
-  type ExtractL6T (a,b) = GL.TypeError ('GL.Text "L6 doesn't work for 2-tuples")
-  extractL6C _ = error "L6 doesn't work for 2-tuples"
-instance ExtractL6C (a,b,c) where
-  type ExtractL6T (a,b,c) = GL.TypeError ('GL.Text "L6 doesn't work for 3-tuples")
-  extractL6C _ = error "L6 doesn't work for 3-tuples"
-instance ExtractL6C (a,b,c,d) where
-  type ExtractL6T (a,b,c,d) = GL.TypeError ('GL.Text "L6 doesn't work for 4-tuples")
-  extractL6C _ = error "L6 doesn't work for 4-tuples"
-instance ExtractL6C (a,b,c,d,e) where
-  type ExtractL6T (a,b,c,d,e) = GL.TypeError ('GL.Text "L6 doesn't work for 5-tuples")
-  extractL6C _ = error "L6 doesn't work for 5-tuples"
-instance ExtractL6C (a,b,c,d,e,f) where
-  type ExtractL6T (a,b,c,d,e,f) = f
-  extractL6C (_,_,_,_,_,f) = f
-
-
--- | 'fromString' function where you need to provide the type \'t\' of the result
---
--- >>> pl @(FromStringP (Identity _) Id) "abc"
--- Present Identity "abc"
--- PresentT (Identity "abc")
---
--- >>> pl @(FromStringP (Seq.Seq _) Id) "abc"
--- Present fromList "abc"
--- PresentT (fromList "abc")
-data FromStringP' t s
-type FromStringP (t :: Type) p = FromStringP' (Hole t) p
-
-instance (P s a
-        , PP s a ~ String
-        , Show (PP t a)
-        , IsString (PP t a)
-        ) => P (FromStringP' t s) a where
-  type PP (FromStringP' t s) a = PP t a
-  eval _ opts a = do
-    let msg0 = "FromStringP"
-    ss <- eval (Proxy @s) opts a
-    pure $ case getValueLR opts msg0 ss [] of
-      Left e -> e
-      Right s ->
-        let b = fromString @(PP t a) s
-        in mkNode opts (PresentT b) [msg0 <> show0 opts " " b] [hh ss]
-
-
--- | 'fromInteger' function where you need to provide the type \'t\' of the result
---
--- >>> pl @(FromInteger (SG.Sum _) Id) 23
--- Present Sum {getSum = 23}
--- PresentT (Sum {getSum = 23})
---
--- >>> pl @(FromInteger Rational 44) 12
--- Present 44 % 1
--- PresentT (44 % 1)
---
--- >>> pl @(FromInteger Rational Id) 12
--- Present 12 % 1
--- PresentT (12 % 1)
---
-data FromInteger' t n
-type FromInteger (t :: Type) p = FromInteger' (Hole t) p
---type FromIntegerP n = FromInteger' Unproxy n
-
-instance (Num (PP t a)
-        , Integral (PP n a)
-        , P n a
-        , Show (PP t a)
-        ) => P (FromInteger' t n) a where
-  type PP (FromInteger' t n) a = PP t a
-  eval _ opts a = do
-    let msg0 = "FromInteger"
-    nn <- eval (Proxy @n) opts a
-    pure $ case getValueLR opts msg0 nn [] of
-      Left e -> e
-      Right n ->
-        let b = fromInteger (fromIntegral n)
-        in mkNode opts (PresentT b) [msg0 <> show0 opts " " b] [hh nn]
-
--- | 'fromIntegral' function where you need to provide the type \'t\' of the result
---
--- >>> pl @(FromIntegral (SG.Sum _) Id) 23
--- Present Sum {getSum = 23}
--- PresentT (Sum {getSum = 23})
-data FromIntegral' t n
-type FromIntegral (t :: Type) p = FromIntegral' (Hole t) p
-
-instance (Num (PP t a)
-        , Integral (PP n a)
-        , P n a
-        , Show (PP t a)
-        , Show (PP n a)
-        ) => P (FromIntegral' t n) a where
-  type PP (FromIntegral' t n) a = PP t a
-  eval _ opts a = do
-    let msg0 = "FromIntegral"
-    nn <- eval (Proxy @n) opts a
-    pure $ case getValueLR opts msg0 nn [] of
-      Left e -> e
-      Right n ->
-        let b = fromIntegral n
-        in mkNode opts (PresentT b) [show01 opts msg0 b n] [hh nn]
-
--- | 'toRational' function
---
--- >>> pl @(ToRational Id) 23.5
--- Present 47 % 2
--- PresentT (47 % 2)
-
-data ToRational p
-
-instance (a ~ PP p x
-         , Show a
-         , Real a
-         , P p x)
-   => P (ToRational p) x where
-  type PP (ToRational p) x = Rational
-  eval _ opts x = do
-    let msg0 = "ToRational"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right a ->
-        let r = (toRational a)
-        in mkNode opts (PresentT r) [show01 opts msg0 r a] [hh pp]
-
--- | 'fromRational' function where you need to provide the type \'t\' of the result
---
--- >>> pl @(FromRational Rational Id) 23.5
--- Present 47 % 2
--- PresentT (47 % 2)
-data FromRational' t r
-type FromRational (t :: Type) p = FromRational' (Hole t) p
-
-instance (P r a
-        , PP r a ~ Rational
-        , Show (PP t a)
-        , Fractional (PP t a)
-        ) => P (FromRational' t r) a where
-  type PP (FromRational' t r) a = PP t a
-  eval _ opts a = do
-    let msg0 = "FromRational"
-    rr <- eval (Proxy @r) opts a
-    pure $ case getValueLR opts msg0 rr [] of
-      Left e -> e
-      Right r ->
-        let b = fromRational @(PP t a) r
-        in mkNode opts (PresentT b) [show01 opts msg0 b r] [hh rr]
-
--- | 'truncate' function where you need to provide the type \'t\' of the result
---
--- >>> pl @(Truncate Int Id) (23 % 5)
--- Present 4
--- PresentT 4
-data Truncate' t p
-type Truncate (t :: Type) p = Truncate' (Hole t) p
-
-instance (Show (PP p x)
-        , P p x
-        , Show (PP t x)
-        , RealFrac (PP p x)
-        , Integral (PP t x)
-        ) => P (Truncate' t p) x where
-  type PP (Truncate' t p) x = PP t x
-  eval _ opts x = do
-    let msg0 = "Truncate"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = truncate p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
--- | 'ceiling' function where you need to provide the type \'t\' of the result
---
--- >>> pl @(Ceiling Int Id) (23 % 5)
--- Present 5
--- PresentT 5
-data Ceiling' t p
-type Ceiling (t :: Type) p = Ceiling' (Hole t) p
-
-instance (Show (PP p x)
-        , P p x
-        , Show (PP t x)
-        , RealFrac (PP p x)
-        , Integral (PP t x)
-        ) => P (Ceiling' t p) x where
-  type PP (Ceiling' t p) x = PP t x
-  eval _ opts x = do
-    let msg0 = "Ceiling"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = ceiling p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
--- | 'floor' function where you need to provide the type \'t\' of the result
---
--- >>> pl @(Floor Int Id) (23 % 5)
--- Present 4
--- PresentT 4
-data Floor' t p
-type Floor (t :: Type) p = Floor' (Hole t) p
-
-instance (Show (PP p x)
-        , P p x
-        , Show (PP t x)
-        , RealFrac (PP p x)
-        , Integral (PP t x)
-        ) => P (Floor' t p) x where
-  type PP (Floor' t p) x = PP t x
-  eval _ opts x = do
-    let msg0 = "Floor"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = floor p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
--- | converts a value to a 'Proxy': the same as '\'Proxy'
---
--- >>> pl @MkProxy 'x'
--- Present Proxy
--- PresentT Proxy
---
-data MkProxy
-
-instance Show a => P MkProxy a where
-  type PP MkProxy a = Proxy a
-  eval _ opts a =
-    let msg0 = "MkProxy"
-        b = Proxy @a
-    in pure $ mkNode opts (PresentT b) [msg0 <> show1 opts " | " a] []
-
-type family DoExpandT (ps :: [k]) :: Type where
-  DoExpandT '[] = GL.TypeError ('GL.Text "'[] invalid: requires at least one predicate in the list")
-  DoExpandT '[p] = Id >> p -- need this else fails cos 1 is nat and would mean that the result is nat not Type!
-  -- if p >> Id then turns TrueT to PresentT True
-  DoExpandT (p ': p1 ': ps) = p >> DoExpandT (p1 ': ps)
-
--- | processes a type level list predicates running each in sequence: see 'Predicate.>>'
---
--- >>> pl @(Do [Pred Id, ShowP Id, Id &&& Len]) 9876543
--- Present ("9876542",7)
--- PresentT ("9876542",7)
---
--- >>> pl @(Do '[W 123, W "xyz", Len &&& Id, Pred Id *** Id<>Id]) ()
--- Present (2,"xyzxyz")
--- PresentT (2,"xyzxyz")
---
-data Do (ps :: [k])
-instance (P (DoExpandT ps) a) => P (Do ps) a where
-  type PP (Do ps) a = PP (DoExpandT ps) a
-  eval _ = eval (Proxy @(DoExpandT ps))
-
--- | Convenient method to convert a value \'p\' to a 'Maybe' based on a predicate '\b\'
--- if '\b\' then Just \'p'\ else Nothing
---
--- >>> pl @(MaybeBool (Id > 4) Id) 24
--- Present Just 24
--- PresentT (Just 24)
---
--- >>> pl @(MaybeBool (Id > 4) Id) (-5)
--- Present Nothing
--- PresentT Nothing
---
-data MaybeBool b p
-
-instance (Show (PP p a)
-        , P b a
-        , P p a
-        , PP b a ~ Bool
-        ) => P (MaybeBool b p) a where
-  type PP (MaybeBool b p) a = Maybe (PP p a)
-  eval _ opts z = do
-    let msg0 = "MaybeBool"
-    bb <- evalBool (Proxy @b) opts z
-    case getValueLR opts (msg0 <> " b failed") bb [] of
-      Left e -> pure e
-      Right True -> do
-        pp <- eval (Proxy @p) opts z
-        pure $ case getValueLR opts (msg0 <> " p failed") pp [hh bb] of
-          Left e -> e
-          Right p -> mkNode opts (PresentT (Just p)) [msg0 <> "(False)" <> show0 opts " Just " p] [hh bb, hh pp]
-      Right False -> pure $ mkNode opts (PresentT Nothing) [msg0 <> "(True)"] [hh bb]
-
--- | Convenient method to convert a \'p\' or '\q'\ to a 'Either' based on a predicate '\b\'
--- if \'b\' then Right \'p\' else Left '\q\'
---
--- >>> pl @(EitherBool (Fst Id > 4) (Snd Id >> Fst Id) (Snd Id >> Snd Id)) (24,(-1,999))
--- Present Right 999
--- PresentT (Right 999)
---
--- >>> pl @(EitherBool (Fst Id > 4) (Fst (Snd Id)) (Snd (Snd Id))) (1,(-1,999))
--- Present Left (-1)
--- PresentT (Left (-1))
---
-data EitherBool b p q
-
-instance (Show (PP p a)
-        , P p a
-        , Show (PP q a)
-        , P q a
-        , P b a
-        , PP b a ~ Bool
-        ) => P (EitherBool b p q) a where
-  type PP (EitherBool b p q) a = Either (PP p a) (PP q a)
-  eval _ opts z = do
-    let msg0 = "EitherBool"
-    bb <- evalBool (Proxy @b) opts z
-    case getValueLR opts (msg0 <> " b failed") bb [] of
-      Left e -> pure e
-      Right False -> do
-        pp <- eval (Proxy @p) opts z
-        pure $ case getValueLR opts (msg0 <> " p failed") pp [hh bb] of
-          Left e -> e
-          Right p -> mkNode opts (PresentT (Left p)) [msg0 <> "(False)" <> show0 opts " Left " p] [hh bb, hh pp]
-      Right True -> do
-        qq <- eval (Proxy @q) opts z
-        pure $ case getValueLR opts (msg0 <> " q failed") qq [hh bb] of
-          Left e -> e
-          Right q -> mkNode opts (PresentT (Right q)) [msg0 <> "(True)" <> show0 opts " Right " q] [hh bb, hh qq]
-
--- | create inductive tuples from a type level list of predicates
---
--- >>> pl @(TupleI '[Id,ShowP Id,Pred Id,W "str", W 999]) 666
--- Present (666,("666",(665,("str",(999,())))))
--- PresentT (666,("666",(665,("str",(999,())))))
---
--- >>> pl @(TupleI '[W 999,W "somestring",W 'True, Id, ShowP (Pred Id)]) 23
--- Present (999,("somestring",(True,(23,("22",())))))
--- PresentT (999,("somestring",(True,(23,("22",())))))
---
-data TupleI (ps :: [k]) -- make it an inductive tuple
-
-instance P (TupleI ('[] :: [k])) a where
-  type PP (TupleI ('[] :: [k])) a = ()
-  eval _ opts _ = pure $ mkNode opts (PresentT ()) ["TupleI(done)"] []
-
-instance (P p a
-        , P (TupleI ps) a
-        , Show a
-        ) => P (TupleI (p ': ps)) a where
-  type PP (TupleI (p ': ps)) a = (PP p a, PP (TupleI ps) a)
-  eval _ opts a = do
-    pp <- eval (Proxy @p) opts a
-    let msg0 = "TupleI" -- "'[](" <> show len <> ")"
-    case getValueLR opts msg0 pp [] of
-         Left e -> pure e
-         Right w -> do
-           qq <- eval (Proxy @(TupleI ps)) opts a
-           pure $ case getValueLR opts msg0 qq [hh pp] of
-                Left e -> e
-                -- only PresentP makes sense here (ie not TrueP/FalseP: ok in base case tho
-                Right ws -> mkNode opts (PresentT (w,ws)) [msg0 <> show0 opts " " a] [hh pp, hh qq]
-
---type Msg' prt p = Msg (Printf "[%s] " prt) p -- msg0 is in square brackets
-
--- | pad \'q\' with '\n'\ values from '\p'\
---
--- >>> pl @(PadL 5 999 Id) [12,13]
--- Present [999,999,999,12,13]
--- PresentT [999,999,999,12,13]
---
--- >>> pl @(PadR 5 (Fst Id) '[12,13]) (999,'x')
--- Present [12,13,999,999,999]
--- PresentT [12,13,999,999,999]
---
--- >>> pl @(PadR 2 (Fst Id) '[12,13,14]) (999,'x')
--- Present [12,13,14]
--- PresentT [12,13,14]
---
-data Pad (left :: Bool) n p q
-type PadL n p q = Pad 'True n p q
-type PadR n p q = Pad 'False n p q
-
-instance (P n a
-        , GetBool left
-        , Integral (PP n a)
-        , [PP p a] ~ PP q a
-        , P p a
-        , P q a
-        , Show (PP p a)
-        ) => P (Pad left n p q) a where
-  type PP (Pad left n p q) a = PP q a
-  eval _ opts a = do
-    let msg0 = "Pad" <> (if lft then "L" else "R")
-        lft = getBool @left
-    lr <- runPQ msg0 (Proxy @n) (Proxy @p) opts a
-    case lr of
-      Left e -> pure e
-      Right (fromIntegral -> n,p,nn,pp) -> do
-        let msg1 = msg0 <> show0 opts " " n <> " pad=" <> show p
-            hhs = [hh nn, hh pp]
-        qq <- eval (Proxy @q) opts a
-        pure $ case getValueLR opts (msg1 <> " q failed") qq hhs of
-          Left e -> e
-          Right q ->
-            let l = length q
-                diff = if n<=l then 0 else n-l
-                bs = if lft
-                     then (replicate diff p) <> q
-                     else q <> (replicate diff p)
-            in mkNode opts (PresentT bs) [show01 opts msg1 bs q] (hhs <> [hh qq])
-
--- | split a list \'p\' into parts using the lengths in the type level list \'ns\'
---
--- >>> pl @(SplitAts '[2,3,1,1] Id) "hello world"
--- Present ["he","llo"," ","w","orld"]
--- PresentT ["he","llo"," ","w","orld"]
---
--- >>> pl @(SplitAts '[2] Id) "hello world"
--- Present ["he","llo world"]
--- PresentT ["he","llo world"]
---
--- >>> pl @(SplitAts '[10,1,1,5] Id) "hello world"
--- Present ["hello worl","d","",""]
--- PresentT ["hello worl","d","",""]
---
-data SplitAts ns p
-instance (P ns x
-        , P p x
-        , PP p x ~ [a]
-        , Show n
-        , Show a
-        , PP ns x ~ [n]
-        , Integral n
-        ) => P (SplitAts ns p) x where
-  type PP (SplitAts ns p) x = [PP p x]
-  eval _ opts x = do
-    let msg0 = "SplitAts"
-    lr <- runPQ msg0 (Proxy @ns) (Proxy @p) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (ns,p,nn,pp) ->
-        let zs = foldr (\n k s -> let (a,b) = splitAt (fromIntegral n) s
-                              in a:k b
-                   ) (\as -> if null as then [] else [as]) ns p
-        in mkNode opts (PresentT zs) [show01' opts msg0 zs "ns=" ns <> show1 opts " | " p] [hh nn, hh pp]
-
--- | similar to 'splitAt'
---
--- >>> pl @(SplitAt 4 Id) "hello world"
--- Present ("hell","o world")
--- PresentT ("hell","o world")
---
--- >>> pl @(SplitAt 20 Id) "hello world"
--- Present ("hello world","")
--- PresentT ("hello world","")
---
--- >>> pl @(SplitAt 0 Id) "hello world"
--- Present ("","hello world")
--- PresentT ("","hello world")
---
--- >>> pl @(SplitAt (Snd Id) (Fst Id)) ("hello world",4)
--- Present ("hell","o world")
--- PresentT ("hell","o world")
---
-data SplitAt n p
-type Take n p = Fst (SplitAt n p)
-type Drop n p = Snd (SplitAt n p)
-
-instance (PP p a ~ [b]
-        , P n a
-        , P p a
-        , Show b
-        , Integral (PP n a)
-        ) => P (SplitAt n p) a where
-  type PP (SplitAt n p) a = (PP p a, PP p a)
-  eval _ opts a = do
-    let msg0 = "SplitAt"
-    lr <- runPQ msg0 (Proxy @n) (Proxy @p) opts a
-    pure $ case lr of
-      Left e -> e -- (Left e, tt')
-      Right (fromIntegral -> n,p,pp,qq) ->
-        let msg1 = msg0 <> show0 opts " " n <> show0 opts " " p
-            (x,y) = splitAt n p
-            ret = (x,y)
-       in mkNode opts (PresentT ret) [show01' opts msg1 ret "n=" n <> show1 opts " | " p] [hh pp, hh qq]
-
-type Tail = Uncons >> 'Just (Snd Id)
-type Head = Uncons >> 'Just (Fst Id)
-type Init = Unsnoc >> 'Just (Fst Id)
-type Last = Unsnoc >> 'Just (Snd Id)
-
--- | similar to 'Control.Arrow.&&&'
-type p &&& q = W '(p, q)
-infixr 3 &&&
-
--- | similar to 'Control.Arrow.***'
---
--- >>> pl @(Pred Id *** ShowP Id) (13, True)
--- Present (12,"True")
--- PresentT (12,"True")
---
-data (p :: k) *** (q :: k1)
-infixr 3 ***
-type First p = p *** I
-type Second q = I *** q
-
-instance (Show (PP p a)
-        , Show (PP q b)
-        , P p a
-        , P q b
-        , Show a
-        , Show b
-        ) => P (p *** q) (a,b) where
-  type PP (p *** q) (a,b) = (PP p a, PP q b)
-  eval _ opts (a,b) = do
-    let msg0 = "(***)"
-    pp <- eval (Proxy @p) opts a
-    case getValueLR opts msg0 pp [] of
-      Left e -> pure e
-      Right a1 -> do
-        qq <- eval (Proxy @q) opts b
-        pure $ case getValueLR opts msg0 qq [hh pp] of
-          Left e -> e
-          Right b1 -> mkNode opts (PresentT (a1,b1)) [msg0 <> show0 opts " " (a1,b1) <> show1 opts " | " (a,b)] [hh pp, hh qq]
-
--- | similar 'Control.Arrow.|||'
---
--- >>> pl @(Pred Id ||| Id) (Left 13)
--- Present 12
--- PresentT 12
---
--- >>> pl @(ShowP Id ||| Id) (Right "hello")
--- Present "hello"
--- PresentT "hello"
---
-data (|||) (p :: k) (q :: k1)
-infixr 2 |||
-type EitherIn p q = p ||| q
-type IsLeft = 'True ||| 'False
-type IsRight = 'False ||| 'True
-
-instance (Show (PP p a)
-        , P p a
-        , P q b
-        , PP p a ~ PP q b
-        , Show a
-        , Show b
-        ) => P (p ||| q) (Either a b) where
-  type PP (p ||| q) (Either a b) = PP p a
-  eval _ opts lr = do
-    let msg0 = "|||"
-    case lr of
-      Left a -> do
-        pp <- eval (Proxy @p) opts a
-        pure $ case getValueLR opts msg0 pp [] of
-          Left e -> e
-          Right a1 -> let msg1 = msg0 ++ " Left"
-                      in mkNode opts (_tBool pp) [show01 opts msg1 a1 a] [hh pp]
-      Right a -> do
-        qq <- eval (Proxy @q) opts a
-        pure $ case getValueLR opts msg0 qq [] of
-          Left e -> e
-          Right a1 ->
-            let msg1 = msg0 ++ " Right"
-            in mkNode opts (_tBool qq) [show01 opts msg1 a1 a] [hh qq]
-
--- | similar 'Control.Arrow.+++'
---
--- >>> pl @(Pred Id +++ Id) (Left 13)
--- Present Left 12
--- PresentT (Left 12)
---
--- >>> pl @(ShowP Id +++ Reverse) (Right "hello")
--- Present Right "olleh"
--- PresentT (Right "olleh")
---
-data (+++) (p :: k) (q :: k1)
-infixr 2 +++
-
-instance (Show (PP p a)
-        , Show (PP q b)
-        , P p a
-        , P q b
-        , Show a
-        , Show b
-        ) => P (p +++ q) (Either a b) where
-  type PP (p +++ q) (Either a b) = Either (PP p a) (PP q b)
-  eval _ opts lr = do
-    let msg0 = "+++"
-    case lr of
-      Left a -> do
-        pp <- eval (Proxy @p) opts a
-        pure $ case getValueLR opts msg0 pp [] of
-          Left e -> e
-          Right a1 ->
-            let msg1 = msg0 ++ " Left"
-            in mkNode opts (PresentT (Left a1)) [msg1 <> show0 opts " Left " a1 <> show1 opts " | " a] [hh pp]
-      Right a -> do
-        qq <- eval (Proxy @q) opts a
-        pure $ case getValueLR opts msg0 qq [] of
-          Left e -> e
-          Right a1 ->
-            let msg1 = msg0 ++ " Right"
-            in mkNode opts (PresentT (Right a1)) [msg1 <> show0 opts " Right" a1 <> show1 opts " | " a] [hh qq]
-
-type Dup = '(Id, Id)
-
-data BinOp = BMult | BSub | BAdd deriving (Show,Eq)
-
-type Mult p q = Bin 'BMult p q
-type Add p q = Bin 'BAdd p q
-type Sub p q = Bin 'BSub p q
-
-type p + q = Add p q
-infixl 6 +
-type p - q = Sub p q
-infixl 6 -
-type p * q = Mult p q
-infixl 7 *
-
-type p > q = Cmp 'Cgt p q
-infix 4 >
-type p >= q = Cmp 'Cge p q
-infix 4 >=
-type p == q = Cmp 'Ceq p q
-infix 4 ==
-type p /= q = Cmp 'Cne p q
-infix 4 /=
-type p <= q = Cmp 'Cle p q
-infix 4 <=
-type p < q = Cmp 'Clt p q
-infix 4 <
-
-type Gt n = Cmp 'Cgt I n
-type Ge n = Cmp 'Cge I n
-type Same n = Cmp 'Ceq I n
-type Le n = Cmp 'Cle I n
-type Lt n = Cmp 'Clt I n
-type Ne n = Cmp 'Cne I n
-
-type p >~ q = CmpI 'Cgt p q
-infix 4 >~
-type p >=~ q = CmpI 'Cge p q
-infix 4 >=~
-type p ==~ q = CmpI 'Ceq p q
-infix 4 ==~
-type p /=~ q = CmpI 'Cne p q
-infix 4 /=~
-type p <=~ q = CmpI 'Cle p q
-infix 4 <=~
-type p <~ q = CmpI 'Clt p q
-infix 4 <~
-
-class GetBinOp (k :: BinOp) where
-  getBinOp :: (Num a, a ~ b) => (String, a -> b -> a)
-
-instance GetBinOp 'BMult where
-  getBinOp = ("*",(*))
-instance GetBinOp 'BSub where
-  getBinOp = ("-",(-))
-instance GetBinOp 'BAdd where
-  getBinOp = ("+",(+))
-
--- | addition, multiplication and subtraction
---
--- >>> pl @(Fst Id * Snd Id) (13,5)
--- Present 65
--- PresentT 65
---
--- >>> pl @(Fst Id + 4 * Length (Snd Id) - 4) (3,"hello")
--- Present 19
--- PresentT 19
---
-data Bin (op :: BinOp) p q
-
-instance (GetBinOp op
-        , PP p a ~ PP q a
-        , P p a
-        , P q a
-        , Show (PP p a)
-        , Num (PP p a)
-        ) => P (Bin op p q) a where
-  type PP (Bin op p q) a = PP p a
-  eval _ opts a = do
-    let (s,f) = getBinOp @op
-    lr <- runPQ s (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = p `f` q
-        in mkNode opts (PresentT d) [show p <> " " <> s <> " " <> show q <> " = " <> show d] [hh pp, hh qq]
-
--- | fractional division
---
--- >>> pl @(Fst Id / Snd Id) (13,2)
--- Present 6.5
--- PresentT 6.5
---
--- >>> pl @(ToRational 13 / Id) 0
--- Error (/) zero denominator
--- FailT "(/) zero denominator"
---
--- >>> pl @(12 % 7 / 14 % 5 + Id) 12.4
--- Present 3188 % 245
--- PresentT (3188 % 245)
---
-data p / q
-infixl 7 /
-
-instance (PP p a ~ PP q a
-        , Eq (PP q a)
-        , P p a
-        , P q a
-        , Show (PP p a)
-        , Fractional (PP p a)
-        ) => P (p / q) a where
-  type PP (p / q) a = PP p a
-  eval _ opts a = do
-    let msg0 = "(/)"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq)
-         | q == 0 -> let msg1 = msg0 <> " zero denominator"
-                     in mkNode opts (FailT msg1) [msg1] [hh pp, hh qq]
-         | otherwise ->
-            let d = p / q
-            in mkNode opts (PresentT d) [show p <> " / " <> show q <> " = " <> show d] [hh pp, hh qq]
-
--- | creates a 'Rational' value
---
--- >>> pl @(Id < 21 % 5) (-3.1)
--- True
--- TrueT
---
--- >>> pl @(Id < 21 % 5) 4.5
--- False
--- FalseT
---
--- >>> pl @(Fst Id % Snd Id) (13,2)
--- Present 13 % 2
--- PresentT (13 % 2)
---
--- >>> pl @(13 % Id) 0
--- Error MkRatio zero denominator
--- FailT "MkRatio zero denominator"
---
--- >>> pl @(4 % 3 + 5 % 7) "asfd"
--- Present 43 % 21
--- PresentT (43 % 21)
---
--- >>> pl @(4 %- 7 * 5 %- 3) "asfd"
--- Present 20 % 21
--- PresentT (20 % 21)
---
--- >>> pl @(Negate (14 % 3)) ()
--- Present (-14) % 3
--- PresentT ((-14) % 3)
---
--- >>> pl @(14 % 3) ()
--- Present 14 % 3
--- PresentT (14 % 3)
---
--- >>> pl @(Negate (14 % 3) ==! FromIntegral _ (Negate 5)) ()
--- Present GT
--- PresentT GT
---
--- >>> pl @(14 -% 3 ==! 5 %- 1) "aa"
--- Present GT
--- PresentT GT
---
--- >>> pl @(Negate (14 % 3) ==! Negate 5 % 2) ()
--- Present LT
--- PresentT LT
---
--- >>> pl @(14 -% 3 * 5 -% 1) ()
--- Present 70 % 3
--- PresentT (70 % 3)
---
--- >>> pl @(14 % 3 ==! 5 % 1) ()
--- Present LT
--- PresentT LT
---
--- >>> pl @(15 % 3 / 4 % 2) ()
--- Present 5 % 2
--- PresentT (5 % 2)
---
-data p % q
-infixl 8 %
-
-type p %- q = Negate (p % q)
-infixl 8 %-
-type p -% q = Negate (p % q)
-infixl 8 -%
-
-instance (Integral (PP p x)
-        , Integral (PP q x)
-        , Eq (PP q x)
-        , P p x
-        , P q x
-        , Show (PP p x)
-        , Show (PP q x)
-        ) => P (p % q) x where
-  type PP (p % q) x = Rational
-  eval _ opts x = do
-    let msg0 = "MkRatio"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq)
-         | q == 0 -> let msg1 = msg0 <> " zero denominator"
-                     in mkNode opts (FailT msg1) [msg1] [hh pp, hh qq]
-         | otherwise ->
-            let d = fromIntegral p % fromIntegral q
-            in mkNode opts (PresentT d) [show p <> " % " <> show q <> " = " <> show d] [hh pp, hh qq]
-
-
--- | similar to 'negate'
---
--- >>> pl @(Negate Id) 14
--- Present -14
--- PresentT (-14)
---
--- >>> pl @(Negate (Fst Id * Snd Id)) (14,3)
--- Present -42
--- PresentT (-42)
---
--- >>> pl @(Negate (15 %- 4)) "abc"
--- Present 15 % 4
--- PresentT (15 % 4)
---
--- >>> pl @(Negate (15 % 3)) ()
--- Present (-5) % 1
--- PresentT ((-5) % 1)
---
--- >>> pl @(Negate (Fst Id % Snd Id)) (14,3)
--- Present (-14) % 3
--- PresentT ((-14) % 3)
---
-data Negate p
-
-instance (Show (PP p x), Num (PP p x), P p x) => P (Negate p) x where
-  type PP (Negate p) x = PP p x
-  eval _ opts x = do
-    let msg0 = "Negate"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = negate p
-        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
-
-
--- | similar to 'abs'
---
--- >>> pl @(Abs Id) (-14)
--- Present 14
--- PresentT 14
---
--- >>> pl @(Abs (Snd Id)) ("xx",14)
--- Present 14
--- PresentT 14
---
--- >>> pl @(Abs Id) 0
--- Present 0
--- PresentT 0
---
--- >>> pl @(Abs (Negate 44)) "aaa"
--- Present 44
--- PresentT 44
---
-data Abs p
-
-instance (Show (PP p x), Num (PP p x), P p x) => P (Abs p) x where
-  type PP (Abs p) x = PP p x
-  eval _ opts x = do
-    let msg0 = "Abs"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = abs p
-        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
-
-
-
--- | similar to 'signum'
---
--- >>> pl @(Signum Id) (-14)
--- Present -1
--- PresentT (-1)
---
--- >>> pl @(Signum Id) 14
--- Present 1
--- PresentT 1
---
--- >>> pl @(Signum Id) 0
--- Present 0
--- PresentT 0
---
-data Signum p
-
-instance (Show (PP p x), Num (PP p x), P p x) => P (Signum p) x where
-  type PP (Signum p) x = PP p x
-  eval _ opts x = do
-    let msg0 = "Signum"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = signum p
-        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
-
--- | unwraps a value (see 'Control.Lens.Unwrapped')
---
--- >>> pl @(Unwrap Id) (SG.Sum (-13))
--- Present -13
--- PresentT (-13)
---
-data Unwrap p
-
-instance (PP p x ~ s
-        , P p x
-        , Show s
-        , Show (Unwrapped s)
-        , Wrapped s
-        ) => P (Unwrap p) x where
-  type PP (Unwrap p) x = Unwrapped (PP p x)
-  eval _ opts x = do
-    let msg0 = "Unwrap"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = p ^. _Wrapped'
-        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
-
--- | wraps a value (see 'Control.Lens.Wrapped' and 'Control.Lens.Unwrapped')
---
--- >>> :m + Data.List.NonEmpty
--- >>> pl @(Wrap (SG.Sum _) Id) (-13)
--- Present Sum {getSum = -13}
--- PresentT (Sum {getSum = -13})
---
--- >>> pl @(Wrap SG.Any (Ge 4)) 13
--- Present Any {getAny = True}
--- PresentT (Any {getAny = True})
---
--- >>> pl @(Wrap (NonEmpty _) (Uncons >> 'Just Id)) "abcd"
--- Present 'a' :| "bcd"
--- PresentT ('a' :| "bcd")
---
-data Wrap' t p
-type Wrap (t :: Type) p = Wrap' (Hole t) p
-
-instance (Show (PP p x)
-        , P p x
-        , Unwrapped (PP s x) ~ PP p x
-        , Wrapped (PP s x)
-        , Show (PP s x)
-        ) => P (Wrap' s p) x where
-  type PP (Wrap' s p) x = PP s x
-  eval _ opts x = do
-    let msg0 = "Wrap"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = p ^. _Unwrapped'
-        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
-
--- | similar to 'coerce'
---
--- >>> pl @(Coerce (SG.Sum Integer)) (Identity (-13))
--- Present Sum {getSum = -13}
--- PresentT (Sum {getSum = -13})
---
-data Coerce (t :: k)
-
-instance (Show a
-        , Show t
-        , Coercible t a
-        ) => P (Coerce t) a where
-  type PP (Coerce t) a = t
-  eval _ opts a =
-    let msg0 = "Coerce"
-        d = a ^. coerced
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d a] []
-
--- can coerce over a functor: but need to provide type of 'a' and 't' explicitly
-
--- | see 'Coerce': coerce over a functor
---
--- >>> pl @(Coerce2 (SG.Sum Integer)) [Identity (-13), Identity 4, Identity 99]
--- Present [Sum {getSum = -13},Sum {getSum = 4},Sum {getSum = 99}]
--- PresentT [Sum {getSum = -13},Sum {getSum = 4},Sum {getSum = 99}]
---
--- >>> pl @(Coerce2 (SG.Sum Integer)) (Just (Identity (-13)))
--- Present Just (Sum {getSum = -13})
--- PresentT (Just (Sum {getSum = -13}))
---
--- >>> pl @(Coerce2 (SG.Sum Int)) (Nothing @(Identity Int))
--- Present Nothing
--- PresentT Nothing
---
-data Coerce2 (t :: k)
-instance (Show (f a)
-        , Show (f t)
-        , Coercible t a
-        , Functor f
-        ) => P (Coerce2 t) (f a) where
-  type PP (Coerce2 t) (f a) = f t
-  eval _ opts fa =
-    let msg0 = "Coerce2"
-        d = view coerced <$> fa
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d fa] []
-
--- | lift mempty over a Functor
---
--- >>> pl @(MEmptyT2 (SG.Product Int)) [Identity (-13), Identity 4, Identity 99]
--- Present [Product {getProduct = 1},Product {getProduct = 1},Product {getProduct = 1}]
--- PresentT [Product {getProduct = 1},Product {getProduct = 1},Product {getProduct = 1}]
---
-data MEmptyT2' t
-type MEmptyT2 t = MEmptyT2' (Hole t)
-
-instance (Show (f a)
-        , Show (f (PP t (f a)))
-        , Functor f
-        , Monoid (PP t (f a))
-        ) => P (MEmptyT2' t) (f a) where
-  type PP (MEmptyT2' t) (f a) = f (PP t (f a))
-  eval _ opts fa =
-    let msg0 = "MEmptyT2"
-        b = mempty <$> fa
-    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b fa] []
-
--- | lift pure over a Functor
---
--- >>> pl @(Pure2 (Either String)) [1,2,4]
--- Present [Right 1,Right 2,Right 4]
--- PresentT [Right 1,Right 2,Right 4]
---
-data Pure2 (t :: Type -> Type)
-type MkRightAlt t p = Pure (Either t) p
-type MkLeftAlt t p = MkRightAlt t p >> Swap
-
-instance (Show (f (t a))
-        , Show (f a)
-        , Applicative t
-        , Functor f
-        ) => P (Pure2 t) (f a) where
-  type PP (Pure2 t) (f a) = f (t a)
-  eval _ opts fa =
-    let msg0 = "Pure2"
-        b = fmap pure fa
-    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b fa] []
-
--- | similar to 'reverse'
---
--- >>> pl @Reverse [1,2,4]
--- Present [4,2,1]
--- PresentT [4,2,1]
---
--- >>> pl @Reverse "AbcDeF"
--- Present "FeDcbA"
--- PresentT "FeDcbA"
---
-data Reverse
-
-instance (Show a, as ~ [a]) => P Reverse as where
-  type PP Reverse as = as
-  eval _ opts as =
-    let msg0 = "Reverse"
-        d = reverse as
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d as] []
-
--- | reverses using 'reversing'
---
--- >>> pl @ReverseL (T.pack "AbcDeF")
--- Present "FeDcbA"
--- PresentT "FeDcbA"
---
--- >>> pl @ReverseL ("AbcDeF" :: String)
--- Present "FeDcbA"
--- PresentT "FeDcbA"
---
-data ReverseL
-
-instance (Show t, Reversing t) => P ReverseL t where
-  type PP ReverseL t = t
-  eval _ opts as =
-    let msg0 = "ReverseL"
-        d = as ^. reversed
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d as] []
-
--- | swaps using 'SW.swap'
---
--- >>> pl @Swap (Left 123)
--- Present Right 123
--- PresentT (Right 123)
---
--- >>> pl @Swap (Right 123)
--- Present Left 123
--- PresentT (Left 123)
---
--- >>> pl @Swap (These 'x' 123)
--- Present These 123 'x'
--- PresentT (These 123 'x')
---
--- >>> pl @Swap (This 'x')
--- Present That 'x'
--- PresentT (That 'x')
---
--- >>> pl @Swap (That 123)
--- Present This 123
--- PresentT (This 123)
---
--- >>> pl @Swap (123,'x')
--- Present ('x',123)
--- PresentT ('x',123)
---
--- >>> pl @Swap (Left "abc")
--- Present Right "abc"
--- PresentT (Right "abc")
---
--- >>> pl @Swap (Right 123)
--- Present Left 123
--- PresentT (Left 123)
---
-data Swap
-
-instance (Show (p a b)
-        , SW.Swap p
-        , Show (p b a)
-        ) => P Swap (p a b) where
-  type PP Swap (p a b) = p b a
-  eval _ opts pab =
-    let msg0 = "Swap"
-        d = SW.swap pab
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d pab] []
-
--- | assoc using 'AS.assoc'
---
--- >>> pl @Assoc (This (These 123 'x'))
--- Present These 123 (This 'x')
--- PresentT (These 123 (This 'x'))
---
--- >>> pl @Assoc ((99,'a'),True)
--- Present (99,('a',True))
--- PresentT (99,('a',True))
---
--- >>> pl @Assoc ((99,'a'),True)
--- Present (99,('a',True))
--- PresentT (99,('a',True))
---
--- >>> pl @Assoc (Right "Abc" :: Either (Either () ()) String)
--- Present Right (Right "Abc")
--- PresentT (Right (Right "Abc"))
---
--- >>> pl @Assoc (Left (Left 'x'))
--- Present Left 'x'
--- PresentT (Left 'x')
---
-data Assoc
-
-instance (Show (p (p a b) c)
-        , Show (p a (p b c))
-        , AS.Assoc p
-        ) => P Assoc (p (p a b) c) where
-  type PP Assoc (p (p a b) c) = p a (p b c)
-  eval _ opts pabc =
-    let msg0 = "Assoc"
-        d = AS.assoc pabc
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d pabc] []
-
--- | unassoc using 'AS.unassoc'
---
--- >>> pl @Unassoc (These 123 (This 'x'))
--- Present This (These 123 'x')
--- PresentT (This (These 123 'x'))
---
--- >>> pl @Unassoc (99,('a',True))
--- Present ((99,'a'),True)
--- PresentT ((99,'a'),True)
---
--- >>> pl @Unassoc (This 10 :: These Int (These Bool ()))
--- Present This (This 10)
--- PresentT (This (This 10))
---
--- >>> pl @Unassoc (Right (Right 123))
--- Present Right 123
--- PresentT (Right 123)
---
--- >>> pl @Unassoc (Left 'x' :: Either Char (Either Bool Double))
--- Present Left (Left 'x')
--- PresentT (Left (Left 'x'))
---
-data Unassoc
-
-instance (Show (p (p a b) c)
-        , Show (p a (p b c))
-        , AS.Assoc p
-        ) => P Unassoc (p a (p b c)) where
-  type PP Unassoc (p a (p b c)) = p (p a b) c
-  eval _ opts pabc =
-    let msg0 = "Unassoc"
-        d = AS.unassoc pabc
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d pabc] []
-
--- | bounded 'succ' function
---
--- >>> pl @(SuccB' Id) (13 :: Int)
--- Present 14
--- PresentT 14
---
--- >>> pl @(SuccB' Id) LT
--- Present EQ
--- PresentT EQ
---
--- >>> pl @(SuccB 'LT Id) GT
--- Present LT
--- PresentT LT
---
--- >>> pl @(SuccB' Id) GT
--- Error Succ bounded failed
--- FailT "Succ bounded failed"
---
-data SuccB p q
-type SuccB' q = SuccB (Failp "Succ bounded failed") q
-
-instance (PP q x ~ a
-        , P q x
-        , P p (Proxy a)
-        , PP p (Proxy a) ~ a
-        , Show a
-        , Eq a
-        , Bounded a
-        , Enum a
-        ) => P (SuccB p q) x where
-  type PP (SuccB p q) x = PP q x
-  eval _ opts x = do
-    let msg0 = "SuccB"
-    qq <- eval (Proxy @q) opts x
-    case getValueLR opts msg0 qq [] of
-      Left e -> pure e
-      Right q -> do
-        case succMay q of
-          Nothing -> do
-             let msg1 = msg0 <> " out of range"
-             pp <- eval (Proxy @p) opts (Proxy @a)
-             pure $ case getValueLR opts msg1 pp [hh qq] of
-               Left e -> e
-               Right _ -> mkNode opts (_tBool pp) [msg1] [hh qq, hh pp]
-          Just n -> pure $ mkNode opts (PresentT n) [show01 opts msg0 n q] [hh qq]
-
--- | bounded 'pred' function
---
--- >>> pl @(PredB' Id) (13 :: Int)
--- Present 12
--- PresentT 12
---
--- >>> pl @(PredB' Id) LT
--- Error Pred bounded failed
--- FailT "Pred bounded failed"
---
-data PredB p q
-type PredB' q = PredB (Failp "Pred bounded failed") q
-
-instance (PP q x ~ a
-        , P q x
-        , P p (Proxy a)
-        , PP p (Proxy a) ~ a
-        , Show a
-        , Eq a
-        , Bounded a
-        , Enum a
-        ) => P (PredB p q) x where
-  type PP (PredB p q) x = PP q x
-  eval _ opts x = do
-    let msg0 = "PredB"
-    qq <- eval (Proxy @q) opts x
-    case getValueLR opts msg0 qq [] of
-      Left e -> pure e
-      Right q -> do
-        case predMay q of
-          Nothing -> do
-             let msg1 = msg0 <> " out of range"
-             pp <- eval (Proxy @p) opts (Proxy @a)
-             pure $ case getValueLR opts msg1 pp [hh qq] of
-               Left e -> e
-               Right _ -> mkNode opts (_tBool pp) [msg1] [hh qq, hh pp]
-          Just n -> pure $ mkNode opts (PresentT n) [show01 opts msg0 n q] [hh qq]
-
-
--- | unbounded 'succ' function
---
--- >>> pl @(Succ Id) 13
--- Present 14
--- PresentT 14
---
--- >>> pl @(Succ Id) LT
--- Present EQ
--- PresentT EQ
---
--- >>> pl @(Succ Id) GT
--- Error Succ IO e=Prelude.Enum.Ordering.succ: bad argument
--- FailT "Succ IO e=Prelude.Enum.Ordering.succ: bad argument"
---
-data Succ p
-
-instance (Show a
-        , Enum a
-        , PP p x ~ a
-        , P p x
-        ) => P (Succ p) x where
-  type PP (Succ p) x = PP p x
-  eval _ opts x = do
-    let msg0 = "Succ"
-    pp <- eval (Proxy @p) opts x
-    case getValueLR opts msg0 pp [] of
-      Left e -> pure e
-      Right p -> do
-        lr <- catchit @_ @E.SomeException (succ p)
-        pure $ case lr of
-          Left e -> mkNode opts (FailT (msg0 <> " " <> e)) [msg0 <> show0 opts " " p] [hh pp]
-          Right n -> mkNode opts (PresentT n) [show01 opts msg0 n p] [hh pp]
-
-
--- | unbounded 'pred' function
---
--- >>> pl @(Pred Id) 13
--- Present 12
--- PresentT 12
---
--- >>> pl @(Pred Id) LT
--- Error Pred IO e=Prelude.Enum.Ordering.pred: bad argument
--- FailT "Pred IO e=Prelude.Enum.Ordering.pred: bad argument"
---
-
-data Pred p
-
-instance (Show a
-        , Enum a
-        , PP p x ~ a
-        , P p x
-        ) => P (Pred p) x where
-  type PP (Pred p) x = PP p x
-  eval _ opts x = do
-    let msg0 = "Pred"
-    pp <- eval (Proxy @p) opts x
-    case getValueLR opts msg0 pp [] of
-      Left e -> pure e
-      Right p -> do
-        lr <- catchit @_ @E.SomeException (pred p)
-        pure $ case lr of
-          Left e -> mkNode opts (FailT (msg0 <> " " <> e)) [msg0 <> show0 opts " " p] [hh pp]
-          Right n -> mkNode opts (PresentT n) [show01 opts msg0 n p] [hh pp]
-
-
--- | 'fromEnum' function
---
--- >>> pl @(FromEnum Id) 'x'
--- Present 120
--- PresentT 120
-
-
-data FromEnum p
-
-instance (Show a
-        , Enum a
-        , PP p x ~ a
-        , P p x
-        ) => P (FromEnum p) x where
-  type PP (FromEnum p) x = Int
-  eval _ opts x = do
-    let msg0 = "FromEnum"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let n = fromEnum p
-        in mkNode opts (PresentT n) [show01 opts msg0 n p] [hh pp]
-
--- | unsafe 'toEnum' function
---
--- >>> pl @(ToEnum Char Id) 120
--- Present 'x'
--- PresentT 'x'
-data ToEnum' t p
-type ToEnum (t :: Type) p = ToEnum' (Hole t) p
-
-instance (PP p x ~ a
-        , P p x
-        , Show a
-        , Enum (PP t x)
-        , Show (PP t x)
-        , Integral a
-        ) => P (ToEnum' t p) x where
-  type PP (ToEnum' t p) x = PP t x
-  eval _ opts x = do
-    let msg0 = "ToEnum"
-    pp <- eval (Proxy @p) opts x
-    case getValueLR opts msg0 pp [] of
-      Left e -> pure e
-      Right p -> do
-        lr <- catchit @_ @E.SomeException (toEnum $! fromIntegral p)
-        pure $ case lr of
-          Left e -> mkNode opts (FailT (msg0 <> " " <> e)) [msg0 <> show0 opts " " p] [hh pp]
-          Right n -> mkNode opts (PresentT n) [show01 opts msg0 n p] [hh pp]
-
--- | bounded 'toEnum' function
---
--- >>> pl @(ToEnumB Ordering LT) 2
--- Present GT
--- PresentT GT
---
--- >>> pl @(ToEnumB Ordering LT) 6
--- Present LT
--- PresentT LT
---
--- >>> pl @(ToEnumBF Ordering) 6
--- Error ToEnum bounded failed
--- FailT "ToEnum bounded failed"
---
-data ToEnumB' t def
-type ToEnumB (t :: Type) def = ToEnumB' (Hole t) def
-type ToEnumBF (t :: Type) = ToEnumB' (Hole t) (Failp "ToEnum bounded failed")
-
-instance (P def (Proxy (PP t a))
-        , PP def (Proxy (PP t a)) ~ (PP t a)
-        , Show a
-        , Show (PP t a)
-        , Bounded (PP t a)
-        , Enum (PP t a)
-        , Integral a
-        ) => P (ToEnumB' t def) a where
-  type PP (ToEnumB' t def) a = PP t a
-  eval _ opts a = do
-    let msg0 = "ToEnumB"
-    case toEnumMay $ fromIntegral a of
-      Nothing -> do
-         let msg1 = msg0 <> " out of range"
-         pp <- eval (Proxy @def) opts (Proxy @(PP t a))
-         pure $ case getValueLR opts msg1 pp [] of
-           Left e -> e
-           Right _ -> mkNode opts (_tBool pp) [msg1] [hh pp]
-      Just n -> pure $ mkNode opts (PresentT n) [show01 opts msg0 n a] []
-
--- | a predicate on prime numbers
---
--- >>> pl @(Prime Id) 2
--- True
--- TrueT
---
--- >>> pl @(Map '(Id,Prime Id) Id) [0..12]
--- Present [(0,False),(1,False),(2,True),(3,True),(4,False),(5,True),(6,False),(7,True),(8,False),(9,False),(10,False),(11,True),(12,False)]
--- PresentT [(0,False),(1,False),(2,True),(3,True),(4,False),(5,True),(6,False),(7,True),(8,False),(9,False),(10,False),(11,True),(12,False)]
---
-data Prime p
-
-instance (PP p x ~ a
-        , P p x
-        , Show a
-        , Integral a
-        ) => P (Prime p) x where
-  type PP (Prime p) x = Bool
-  eval _ opts x = do
-    let msg0 = "Prime"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = isPrime $ fromIntegral p
-        in mkNodeB opts b [msg0 <> show1 opts " | " p] []
-
-isPrime :: Integer -> Bool
-isPrime n = n==2 || n>2 && all ((> 0).rem n) (2:[3,5 .. floor . sqrt @Double . fromIntegral $ n+1])
-
--- empty lists at the type level wont work here
-
--- | filters a list \'q\' keeping or removing those elements in \'p\'
---
--- >>> pl @(Keep '[5] '[1,5,5,2,5,2]) ()
--- Present [5,5,5]
--- PresentT [5,5,5]
---
--- >>> pl @(Keep '[0,1,1,5] '[1,5,5,2,5,2]) ()
--- Present [1,5,5,5]
--- PresentT [1,5,5,5]
---
--- >>> pl @(Remove '[5] '[1,5,5,2,5,2]) ()
--- Present [1,2,2]
--- PresentT [1,2,2]
---
--- >>> pl @(Remove '[0,1,1,5] '[1,5,5,2,5,2]) ()
--- Present [2,2]
--- PresentT [2,2]
---
--- >>> pl @(Remove '[99] '[1,5,5,2,5,2]) ()
--- Present [1,5,5,2,5,2]
--- PresentT [1,5,5,2,5,2]
---
--- >>> pl @(Remove '[99,91] '[1,5,5,2,5,2]) ()
--- Present [1,5,5,2,5,2]
--- PresentT [1,5,5,2,5,2]
---
--- >>> pl @(Remove Id '[1,5,5,2,5,2]) []
--- Present [1,5,5,2,5,2]
--- PresentT [1,5,5,2,5,2]
---
--- >>> pl @(Remove '[] '[1,5,5,2,5,2]) 44 -- works if you make this a number!
--- Present [1,5,5,2,5,2]
--- PresentT [1,5,5,2,5,2]
---
-data KeepImpl (keep :: Bool) p q
-type Remove p q = KeepImpl 'False p q
-type Keep p q = KeepImpl 'True p q
-
-instance (GetBool keep
-        , Eq a
-        , Show a
-        , P p x
-        , P q x
-        , PP p x ~ PP q x
-        , PP q x ~ [a]
-        ) => 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"
-        keep = getBool @keep
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let ret = filter (bool not id keep . (`elem` p)) q
-        in mkNode opts (PresentT ret) [show01' opts msg0 ret "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
-
--- | 'elem' function
---
--- >>> pl @(Elem (Fst Id) (Snd Id)) ('x',"abcdxy")
--- True
--- TrueT
---
--- >>> pl @(Elem (Fst Id) (Snd Id)) ('z',"abcdxy")
--- False
--- FalseT
---
-data Elem p q
-
-instance ([PP p a] ~ PP q a
-         , P p a
-         , P q a
-         , Show (PP p a)
-         , Eq (PP p a)
-         ) => P (Elem p q) a where
-  type PP (Elem p q) a = Bool
-  eval _ opts a = do
-    let msg0 = "Elem"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let b = p `elem` q
-        in mkNodeB opts b [show p <> " `elem` " <> show q] [hh pp, hh qq]
-
-type Head' p = HeadFail "Head(empty)" p
-type Tail' p = TailFail "Tail(empty)" p
-type Last' p = LastFail "Last(empty)" p
-type Init' p = InitFail "Init(empty)" p
-
--- | similar to fmap fst
---
--- >>> pl @Fmap_1 (Just (13,"Asf"))
--- Present Just 13
--- PresentT (Just 13)
---
--- to make this work we grab the fst or snd out of the Maybe so it is a head or not/ is a tail or not etc!
--- we still have access to the whole original list so we dont lose anything!
-data Fmap_1
-instance Functor f => P Fmap_1 (f (a,x)) where
-  type PP Fmap_1 (f (a,x)) = f a
-  eval _ opts mb = pure $ mkNode opts (PresentT (fst <$> mb)) ["Fmap_1"] []
-
--- | similar to fmap snd
---
--- >>> pl @Fmap_2 (Just ("asf",13))
--- Present Just 13
--- PresentT (Just 13)
---
-data Fmap_2
-instance Functor f => P Fmap_2 (f (x,a)) where
-  type PP Fmap_2 (f (x,a)) = f a
-  eval _ opts mb = pure $ mkNode opts (PresentT (snd <$> mb)) ["Fmap_2"] []
-
--- | takes the head or default of a list-like object
---
--- see 'ConsT' for other supported types eg 'Seq.Seq'
---
--- >>> pl @(HeadDef 444 Id) []
--- Present 444
--- PresentT 444
---
--- >>> pl @(HeadDef 444 Id) [1..5]
--- Present 1
--- PresentT 1
---
--- >>> pl @(HeadDef 444 Id) [1..5]
--- Present 1
--- PresentT 1
---
--- >>> pl @(HeadDef (Char1 "w") Id) (Seq.fromList "abcdef")
--- Present 'a'
--- PresentT 'a'
---
--- >>> pl @(HeadDef (Char1 "w") Id) Seq.empty
--- Present 'w'
--- PresentT 'w'
---
-type HeadDef p q   = GDef (Uncons >> Fmap_1) p q
-
-
--- | takes the head of a list or defaults to the monoid instance
---
--- see 'ConsT' for other supported types eg 'Seq.Seq'
---
--- >>> pl @(HeadP '[ "abc","def","asdfadf" ]) ()
--- Present "abc"
--- PresentT "abc"
---
--- >>> pl @(HeadP (Snd Id)) (123,[ "abc","def","asdfadf" ])
--- Present "abc"
--- PresentT "abc"
---
--- >>> pl @(HeadP (Snd Id)) (123,[])
--- Present ()
--- PresentT ()
---
-type HeadP q       = GProxy (Uncons >> Fmap_1) q
--- | takes the head of a list or fail
---
--- see 'ConsT' for other supported types eg 'Seq.Seq'
---
--- >>> pl @(HeadFail "dude" Id) [ "abc","def","asdfadf" ]
--- Present "abc"
--- PresentT "abc"
---
--- >>> pl @(HeadFail "empty list" Id) []
--- Error empty list
--- FailT "empty list"
---
-
-type HeadFail msg q = GFail (Uncons >> Fmap_1) msg q
-
-type TailDef p q   = GDef (Uncons >> Fmap_2) p q
-type TailP q       = GProxy (Uncons >> Fmap_2) q
-type TailFail msg q = GFail (Uncons >> Fmap_2) msg q
-
-type LastDef p q   = GDef (Unsnoc >> Fmap_2) p q
-type LastP q       = GProxy (Unsnoc >> Fmap_2) q
-type LastFail msg q = GFail (Unsnoc >> Fmap_2) msg q
-
-type InitDef p q   = GDef (Unsnoc >> Fmap_1) p q
-type InitP q       = GProxy (Unsnoc >> Fmap_1) q
-type InitFail msg q = GFail (Unsnoc >> Fmap_1) msg q
-
--- 'x' and 'a' for Just condition
--- 'x' for Nothing condition
--- (Snd Id) at the end says we only want to process the Maybe which is the rhs of &&& ie (Snd Id)
-type GDef' z p q r = '(I, r >> z) >> MaybeXP (X >> p) q (Snd Id)
-type JustDef' p q r = GDef' I p q r
-
--- access everything ie 'x' and Proxy a for Nothing condition
--- 'x' and 'a' for Just condition
-type GDef'' z p q r = '(I, r >> z) >> MaybeXP p q (Snd Id)
-type JustDef'' p q r = GDef'' I p q r
-
-type PA = Snd I -- 'Proxy a' -- to distinguish from A
-type A = Snd I -- 'a'
-type X = Fst (Fst I) -- 'x' ie the whole original environment
-
--- Nothing has access to 'x' only
--- Just has access to (x,a)
-type GDef_X z p q r = '(I, r >> z) >> MaybeXP (X >> p) ('(X,A) >> q) A
-type JustDef''' p q r = GDef_X I p q r
-
--- Nothing case sees ((I,qz), Proxy a) -- hence the Fst Id >> Fst Id
--- Just case sees (I,qz), a) -- hence the (Snd Id) to get the 'a' only -- if you want the 'x' then Fst Id >> Fst Id
--- we have lost 'x' on the rhs: use GDef_X to access 'x' and 'a' for the Just condition
-type GDef z p q     = '(I, q >> z) >> MaybeXP (X >> p) A A  -- Hide % immediately before MaybeXP
-type GProxy z q     = '(I, q >> z) >> MaybeXP (PA >> MEmptyP) A A
-type GFail z msg q  = '(I, q >> z) >> MaybeXP (Fail (PA >> Unproxy) (X >> msg)) A A
-
--- use these!
-type LookupDef' x y p q    = GDef (Lookup x y) p q
-type LookupP' x y q        = GProxy (Lookup x y) q
-type LookupFail' msg x y q = GFail (Lookup x y) msg q
-
-type LookupDef x y p    = LookupDef' x y p I
-type LookupP x y        = LookupP' x y I
-type LookupFail msg x y = LookupFail' msg x y I
-
-type Just' p    = JustFail  "expected Just" p
-type Left' p    = LeftFail  "expected Left"  p
-type Right' p   = RightFail "expected Right" p
-type This' p    = ThisFail  "expected This"  p
-type That'  p   = ThatFail  "expected That"  p
-type TheseIn' p = TheseFail "expected These" p
-
-type JustDef p q    = GDef I p q
-type JustP q        = GProxy I q
-type JustFail msg q = GFail I msg q
-
-type LeftDef p q    = GDef LeftToMaybe p q
-type LeftP q        = GProxy LeftToMaybe q
-type LeftFail msg q = GFail LeftToMaybe msg q
-
-type RightDef p q    = GDef RightToMaybe p q
-type RightP q        = GProxy RightToMaybe q
-type RightFail msg q = GFail RightToMaybe msg q
-
-type ThisDef p q    = GDef ThisToMaybe p q
-type ThisP q       = GProxy ThisToMaybe q
-type ThisFail msg q = GFail ThisToMaybe msg q
-
-type ThatDef p q    = GDef ThatToMaybe p q
-type ThatP q       = GProxy ThatToMaybe q
-type ThatFail msg q = GFail ThatToMaybe msg q
-
-type TheseDef p q    = GDef TheseToMaybe p q
-type TheseP q       = GProxy TheseToMaybe q
-type TheseFail msg q = GFail TheseToMaybe msg q
-
--- tacks on a Proxy to Nothing side! but a Proxy a not Proxy of the final result
--- this is for default use cases for either/these/head/tail/last/init etc
-
--- | MaybeXP combinator
---
--- >>> pl @((Id &&& Snd Id) >> MaybeXP (Fst (Fst (Fst Id))) (Fst (Fst (Fst Id)) <> Snd Id) (Snd Id)) ("xx",Just "ya")
--- Present "xxya"
--- PresentT "xxya"
---
--- >>> pl @((Id &&& Fst Id) >> MaybeXP (Snd (Fst (Fst Id))) (Snd (Fst (Fst Id)) <> Snd Id) (Snd Id)) (Just "ya","xx")
--- Present "xxya"
--- PresentT "xxya"
---
--- >>> pl @((Id &&& Snd Id) >> MaybeXP (Fst (Fst (Fst Id))) (Fst (Fst (Fst Id)) <> Snd Id) (Snd Id)) ("xx",Nothing)
--- Present "xx"
--- PresentT "xx"
---
-
-data MaybeXP p q r
-
--- | MaybeX combinator
---
--- >>> pl @(MaybeX (Fst Id) (Fst (Fst Id) +: Snd Id) (Snd Id)) ([1..5],Just 99)
--- Present [1,2,3,4,5,99]
--- PresentT [1,2,3,4,5,99]
---
--- >>> pl @(MaybeX (Fst Id) (Fst (Fst Id) +: Snd Id) (Snd Id)) ([1..5],Nothing)
--- Present [1,2,3,4,5]
--- PresentT [1,2,3,4,5]
-
-type MaybeX p q r = MaybeXP (Fst Id >> p) q r
-
-instance (P r x
-        , P p (x, Proxy a)
-        , P q (x,a)
-        , PP r x ~ Maybe a
-        , PP p (x, Proxy a) ~ b
-        , PP q (x,a) ~ b
-        ) => P (MaybeXP p q r) x where
-  type PP (MaybeXP p q r) x = MaybeXPT (PP r x) x q
-  eval _ opts x = do
-    let msg0 = "MaybeXP"
-    rr <- eval (Proxy @r) opts x
-    case getValueLR opts msg0 rr [] of
-      Left e -> pure e
-      Right Nothing -> do
-        let msg1 = msg0 <> "(Nothing)"
-        pp <- eval (Proxy @p) opts (x, Proxy @a)
-        pure $ case getValueLR opts msg1 pp [hh rr] of
-          Left e -> e
-          Right _ -> mkNode opts (_tBool pp) [msg1] [hh rr, hh pp]
-      Right (Just a) -> do
-        let msg1 = msg0 <> "(Just)"
-        qq <- eval (Proxy @q) opts (x,a)
-        pure $ case getValueLR opts msg1 qq [hh rr] of
-          Left e -> e
-          Right _ -> mkNode opts (_tBool qq) [msg1] [hh rr, hh qq]
-
-type family MaybeXPT lr x q where
-  MaybeXPT (Maybe a) x q = PP q (x,a)
-
-
--- | similar to either Just (const Nothing)
---
--- >>> pl @LeftToMaybe (Left 13)
--- Present Just 13
--- PresentT (Just 13)
---
--- >>> pl @LeftToMaybe (Right 13)
--- Present Nothing
--- PresentT Nothing
---
-data LeftToMaybe
-instance P LeftToMaybe (Either a x) where
-  type PP LeftToMaybe (Either a x) = Maybe a
-  eval _ opts lr = pure $ mkNode opts (PresentT (either Just (const Nothing) lr)) ["LeftToMaybe"] []
-
-
--- | similar to either (const Nothing) Just
---
--- >>> pl @RightToMaybe (Right 13)
--- Present Just 13
--- PresentT (Just 13)
---
--- >>> pl @RightToMaybe (Left 13)
--- Present Nothing
--- PresentT Nothing
---
-data RightToMaybe
-instance P RightToMaybe (Either x a) where
-  type PP RightToMaybe (Either x a) = Maybe a
-  eval _ opts lr = pure $ mkNode opts (PresentT (either (const Nothing) Just lr)) ["RightToMaybe"] []
-
-data ThisToMaybe
-
-instance P ThisToMaybe (These a x) where
-  type PP ThisToMaybe (These a x) = Maybe a
-  eval _ opts th = pure $ mkNode opts (PresentT (these Just (const Nothing) (const . const Nothing) th)) ["ThisToMaybe"] []
-
-data ThatToMaybe
-
-instance P ThatToMaybe (These x a) where
-  type PP ThatToMaybe (These x a) = Maybe a
-  eval _ opts th = pure $ mkNode opts (PresentT (these (const Nothing) Just (const . const Nothing) th)) ["ThatToMaybe"] []
-
-data TheseToMaybe
-
-instance P TheseToMaybe (These a b) where
-  type PP TheseToMaybe (These a b) = Maybe (a,b)
-  eval _ opts th = pure $ mkNode opts (PresentT (these (const Nothing) (const Nothing) ((Just .) . (,)) th)) ["TheseToMaybe"] []
-
--- | similar to 'Control.Arrow.|||' but additionally gives \'p\' and \'q\' the original input
---
--- >>> pl @(EitherX (ShowP (Fst (Fst Id) + Snd Id)) (ShowP Id) (Snd Id)) (9,Left 123)
--- Present "132"
--- PresentT "132"
---
--- >>> pl @(EitherX (ShowP (Fst (Fst Id) + Snd Id)) (ShowP Id) (Snd Id)) (9,Right 'x')
--- Present "((9,Right 'x'),'x')"
--- PresentT "((9,Right 'x'),'x')"
---
--- >>> pl @(EitherX (ShowP Id) (ShowP (Second (Succ Id))) (Snd Id)) (9,Right 'x')
--- Present "((9,Right 'x'),'y')"
--- PresentT "((9,Right 'x'),'y')"
---
-data EitherX p q r
-instance (P r x
-        , P p (x,a)
-        , P q (x,b)
-        , PP r x ~ Either a b
-        , PP p (x,a) ~ c
-        , PP q (x,b) ~ c
-        ) => P (EitherX p q r) x where
-  type PP (EitherX p q r) x = EitherXT (PP r x) x p
-  eval _ opts x = do
-    let msg0 = "EitherX"
-    rr <- eval (Proxy @r) opts x
-    case getValueLR opts msg0 rr [] of
-      Left e -> pure e
-      Right (Left a) -> do
-        let msg1 = msg0 <> "(Left)"
-        pp <- eval (Proxy @p) opts (x,a)
-        pure $ case getValueLR opts msg1 pp [hh rr] of
-          Left e -> e
-          Right _ -> mkNode opts (_tBool pp) [msg1] [hh rr, hh pp]
-      Right (Right b) -> do
-        let msg1 = msg0 <> "(Right)"
-        qq <- eval (Proxy @q) opts (x,b)
-        pure $ case getValueLR opts msg1 qq [hh rr] of
-          Left e -> e
-          Right _ -> mkNode opts (_tBool qq) [msg1] [hh rr, hh qq]
-
-type family EitherXT lr x p where
-  EitherXT (Either a b) x p = PP p (x,a)
-
--- | similar to 'Data.These.mergeTheseWith' but additionally provides \'p\', '\q'\ and \'r\' the original input as the first element in the tuple
---
--- >>> pl @(TheseX ((Fst (Fst Id) + Snd Id) >> ShowP Id) (ShowP Id) (Snd (Snd Id)) (Snd Id)) (9,This 123)
--- Present "132"
--- PresentT "132"
---
--- >>> pl @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (This 123)
--- Present (123,"fromthis")
--- PresentT (123,"fromthis")
---
--- >>> pl @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (That "fromthat")
--- Present (-99,"fromthat")
--- PresentT (-99,"fromthat")
---
--- >>> pl @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (These 123 "fromthese")
--- Present (123,"fromthese")
--- PresentT (123,"fromthese")
---
-data TheseX p q r s
-
-instance (P s x
-        , P p (x,a)
-        , P q (x,b)
-        , P r (x,(a,b))
-        , PP s x ~ These a b
-        , PP p (x,a) ~ c
-        , PP q (x,b) ~ c
-        , PP r (x,(a,b)) ~ c
-        ) => P (TheseX p q r s) x where
-  type PP (TheseX p q r s) x = TheseXT (PP s x) x p
-  eval _ opts x = do
-    let msg0 = "TheseX"
-    ss <- eval (Proxy @s) opts x
-    case getValueLR opts msg0 ss [] of
-      Left e -> pure e
-      Right (This a) -> do
-        let msg1 = msg0 <> "(This)"
-        pp <- eval (Proxy @p) opts (x,a)
-        pure $ case getValueLR opts msg1 pp [hh ss] of
-          Left e -> e
-          Right _ -> mkNode opts (_tBool pp) [msg1] [hh ss, hh pp]
-      Right (That b) -> do
-        let msg1 = msg0 <> "(That)"
-        qq <- eval (Proxy @q) opts (x,b)
-        pure $ case getValueLR opts msg1 qq [hh ss] of
-          Left e -> e
-          Right _ -> mkNode opts (_tBool qq) [msg1] [hh ss, hh qq]
-      Right (These a b) -> do
-        let msg1 = msg0 <> "(These)"
-        rr <- eval (Proxy @r) opts (x,(a,b))
-        pure $ case getValueLR opts msg1 rr [hh ss] of
-          Left e -> e
-          Right _ -> mkNode opts (_tBool rr) [msg1] [hh ss, hh rr]
-
-type family TheseXT lr x p where
-  TheseXT (These a b) x p = PP p (x,a)
-
--- | similar to 'maybe'
---
--- similar to 'MaybeX' but provides a Proxy to the result of \'q\' and does not provide the surrounding context
---
--- >>> pl @(MaybeIn "foundnothing" (ShowP (Pred Id))) (Just 20)
--- Present "19"
--- PresentT "19"
---
--- >>> pl @(MaybeIn "found nothing" (ShowP (Pred Id))) Nothing
--- Present "found nothing"
--- PresentT "found nothing"
---
-data MaybeIn p q
-type IsNothing = MaybeIn 'True 'False
-type IsJust = MaybeIn 'False 'True
-
--- tricky: the nothing case is the proxy of PP q a: ie proxy of the final result!!
--- this is different from MaybeXP which gives you a proxy of 'a' [you need both!]
-instance (P q a
-        , Show a
-        , Show (PP q a)
-        , PP p (Proxy (PP q a)) ~ PP q a
-        , P p (Proxy (PP q a))
-        ) => P (MaybeIn p q) (Maybe a) where
-  type PP (MaybeIn p q) (Maybe a) = PP q a
-  eval _ opts ma = do
-    let msg0 = "MaybeIn"
-    case ma of
-      Nothing -> do
-        let msg1 = msg0 <> "(Nothing)"
-        pp <- eval (Proxy @p) opts (Proxy @(PP q a))
-        pure $ case getValueLR opts msg1 pp [] of
-          Left e -> e
-          Right b -> mkNode opts (_tBool pp) [msg1 <> show0 opts " " b <> " | Proxy"] [hh pp]
-      Just a -> do
-        let msg1 = msg0 <> "(Nothing)"
-        qq <- eval (Proxy @q) opts a
-        pure $ case getValueLR opts msg1 qq [] of
-          Left e -> e
-          Right b -> mkNode opts (_tBool qq) [show01 opts msg1 b a] [hh qq]
-
-
--- | similar to 'SG.stimes'
---
--- >>> pl @(STimes 4 Id) (SG.Sum 3)
--- Present Sum {getSum = 12}
--- PresentT (Sum {getSum = 12})
---
--- >>> pl @(STimes 4 Id) "ab"
--- Present "abababab"
--- PresentT "abababab"
---
-data STimes n p
-instance (P n a
-        , Integral (PP n a)
-        , Semigroup (PP p a)
-        , P p a
-        , Show (PP p a)
-        ) => P (STimes n p) a where
-  type PP (STimes n p) a = PP p a
-  eval _ opts a = do
-    let msg0 = "STimes"
-    lr <- runPQ msg0 (Proxy @n) (Proxy @p) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (fromIntegral -> (n::Int),p,pp,qq) ->
-        let msg1 = msg0 <> show0 opts " " n <> " p=" <> show p
-            b = SG.stimes n p
-            in mkNode opts (PresentT b) [show01' opts msg1 b "n=" n <> show1 opts " | " p] [hh pp, hh qq]
-
-
--- | similar to 'pure'
---
--- >>> pl @(Pure Maybe Id) 4
--- Present Just 4
--- PresentT (Just 4)
---
--- >>> pl @(Pure [] Id) 4
--- Present [4]
--- PresentT [4]
---
--- >>> pl @(Pure (Either String) (Fst Id)) (13,True)
--- Present Right 13
--- PresentT (Right 13)
---
-data Pure (t :: Type -> Type) p
-instance (P p x
-        , Show (PP p x)
-        , Show (t (PP p x))
-        , Applicative t
-        ) => P (Pure t p) x where
-  type PP (Pure t p) x = t (PP p x)
-  eval _ opts x = do
-    let msg0 = "Pure"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right a ->
-        let b = pure a
-        in mkNode opts (PresentT b) [show01 opts msg0 b a] [hh pp]
-
--- type PMEmpty = MEmptyT' 'Proxy  -- lifts 'a' to 'Proxy a' then we can use it with MEmptyP
-
--- | similar to 'mempty'
---
--- >>> pl @(MEmptyT (SG.Sum Int)) ()
--- Present Sum {getSum = 0}
--- PresentT (Sum {getSum = 0})
---
--- no Monoid for Maybe a unless a is also a monoid but can use empty!
-data MEmptyT' t
-type MEmptyT (t :: Type) = MEmptyT' (Hole t)
-type MEmptyP = MEmptyT' Unproxy -- expects a proxy: so only some things work with this: eg Pad MaybeIn etc
-
-instance (Show (PP t a), Monoid (PP t a)) => P (MEmptyT' t) a where
-  type PP (MEmptyT' t) a = PP t a
-  eval _ opts _ =
-    let msg0 = "MEmptyT"
-        b = mempty @(PP t a)
-    in pure $ mkNode opts (PresentT b) [msg0 <> show0 opts " " b] []
-{-
-data MEmptyProxy
-instance Monoid a => P MEmptyProxy (Proxy (a :: Type)) where
-  type PP MEmptyProxy (Proxy a) = a
-  eval _ opts _pa =
-    let msg0 = "MEmptyProxy"
-        b = mempty @a
-    in pure $ mkNode opts (PresentT b) [msg0] []
--}
--- | similar to 'empty'
---
--- >>> pl @(EmptyT Maybe Id) ()
--- Present Nothing
--- PresentT Nothing
---
--- >>> pl @(EmptyT [] Id) ()
--- Present []
--- PresentT []
---
--- >>> pl @(EmptyT [] (Char1 "x")) (13,True)
--- Present ""
--- PresentT ""
---
--- >>> pl @(EmptyT (Either String) (Fst Id)) (13,True)
--- Present Left ""
--- PresentT (Left "")
---
-
-data EmptyT (t :: Type -> Type) p
-
-instance (P p x
-        , PP p x ~ a
-        , Show (t a)
-        , Show a
-        , Alternative t
-        ) => P (EmptyT t p) x where
-  type PP (EmptyT t p) x = t (PP p x)
-  eval _ opts x = do
-    let msg0 = "EmptyT"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = empty @t
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
-data MkNothing' t -- works always! MaybeBool is a good alternative and then dont need the extra 't'
-type MkNothing (t :: Type) = MkNothing' (Hole t)
-
--- for this to be useful has to have 't' else we end up with tons of problems
-instance P (MkNothing' t) a where
-  type PP (MkNothing' t) a = Maybe (PP t a)
-  eval _ opts _ =
-    let msg0 = "MkNothing"
-    in pure $ mkNode opts (PresentT Nothing) [msg0] []
-
--- | 'Just' constructor
---
--- >>> pl @(MkJust Id) 44
--- Present Just 44
--- PresentT (Just 44)
---
-data MkJust p
-instance (PP p x ~ a, P p x, Show a) => P (MkJust p) x where
-  type PP (MkJust p) x = Maybe (PP p x)
-  eval _ opts x = do
-    let msg0 = "MkJust"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = Just p
-        in mkNode opts (PresentT d) [msg0 <> show0 opts " Just " p] [hh pp]
-
--- | 'Data.Either.Left' constructor
---
--- >>> pl @(MkLeft _ Id) 44
--- Present Left 44
--- PresentT (Left 44)
---
-data MkLeft' t p
-type MkLeft (t :: Type) p = MkLeft' (Hole t) p
-
-instance (Show (PP p x), P p x) => P (MkLeft' t p) x where
-  type PP (MkLeft' t p) x = Either (PP p x) (PP t x)
-  eval _ opts x = do
-    let msg0 = "MkLeft"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = Left p
-        in mkNode opts (PresentT d) [msg0 <> show0 opts " Left " p] [hh pp]
-
--- | 'Data.Either.Right' constructor
---
--- >>> pl @(MkRight _ Id) 44
--- Present Right 44
--- PresentT (Right 44)
---
-data MkRight' t p
-type MkRight (t :: Type) p = MkRight' (Hole t) p
-
-instance (Show (PP p x), P p x) => P (MkRight' t p) x where
-  type PP (MkRight' t p) x = Either (PP t x) (PP p x)
-  eval _ opts x = do
-    let msg0 = "MkRight"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = Right p
-        in mkNode opts (PresentT d) [msg0 <> show0 opts " Right " p] [hh pp]
-
--- | 'Data.These.This' constructor
---
--- >>> pl @(MkThis _ Id) 44
--- Present This 44
--- PresentT (This 44)
---
-data MkThis' t p
-type MkThis (t :: Type) p = MkThis' (Hole t) p
-
-instance (Show (PP p x), P p x) => P (MkThis' t p) x where
-  type PP (MkThis' t p) x = These (PP p x) (PP t x)
-  eval _ opts x = do
-    let msg0 = "MkThis"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = This p
-        in mkNode opts (PresentT d) [msg0 <> show0 opts " This " p] [hh pp]
-
--- | 'Data.These.That' constructor
---
--- >>> pl @(MkThat _ Id) 44
--- Present That 44
--- PresentT (That 44)
---
-data MkThat' t p
-type MkThat (t :: Type) p = MkThat' (Hole t) p
-
-instance (Show (PP p x), P p x) => P (MkThat' t p) x where
-  type PP (MkThat' t p) x = These (PP t x) (PP p x)
-  eval _ opts x = do
-    let msg0 = "MkThat"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = That p
-        in mkNode opts (PresentT d) [msg0 <> show0 opts " That " p] [hh pp]
-
---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
---
--- >>> pl @(MkThese (Fst Id) (Snd Id)) (44,'x')
--- Present These 44 'x'
--- PresentT (These 44 'x')
---
-data MkThese p q
-instance (P p a
-        , P q a
-        , Show (PP p a)
-        , Show (PP q a)
-        ) => P (MkThese p q) a where
-  type PP (MkThese p q) a = These (PP p a) (PP q a)
-  eval _ opts a = do
-    let msg0 = "MkThese"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = These p q
-        in mkNode opts (PresentT d) [msg0 <> show0 opts " " d] [hh pp, hh qq]
-
--- | similar to 'mconcat'
---
--- >>> pl @(MConcat Id) [SG.Sum 44, SG.Sum 12, SG.Sum 3]
--- Present Sum {getSum = 59}
--- PresentT (Sum {getSum = 59})
---
-data MConcat p
-
-
--- | similar to a limited form of 'foldMap'
---
--- >>> pl @(FoldMap (SG.Sum _) Id) [44, 12, 3]
--- Present 59
--- PresentT 59
---
--- >>> pl @(FoldMap (SG.Product _) Id) [44, 12, 3]
--- Present 1584
--- PresentT 1584
---
-
-type FoldMap (t :: Type) p = Map (Wrap t Id) p >> Unwrap (MConcat Id)
-
-type Sum' (t :: Type) = FoldMap (SG.Sum t) Id
-type Min' (t :: Type) = FoldMap (SG.Min t) Id -- requires t be Bounded for monoid instance
-type Max' (t :: Type) = FoldMap (SG.Max t) Id -- requires t be Bounded for monoid instance
-
-instance (PP p x ~ [a]
-        , P p x
-        , Show a
-        , Monoid a
-        ) => P (MConcat p) x where
-  type PP (MConcat p) x = ExtractAFromTA (PP p x)
-  eval _ opts x = do
-    let msg0 = "MConcat"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = mconcat p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
--- | similar to 'concat'
---
--- >>> pl @(Concat Id) ["abc","D","eF","","G"]
--- Present "abcDeFG"
--- PresentT "abcDeFG"
---
--- >>> pl @(Concat (Snd Id)) ('x',["abc","D","eF","","G"])
--- Present "abcDeFG"
--- PresentT "abcDeFG"
---
-data Concat p
-
-instance (Show a
-        , Show (t [a])
-        , PP p x ~ (t [a])
-        , P p x
-        , Foldable t
-        ) => P (Concat p) x where
-  type PP (Concat p) x = ExtractAFromTA (PP p x)
-  eval _ opts x = do
-    let msg0 = "Concat"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = concat p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
-data ProxyT' t
-type ProxyT (t :: Type) = ProxyT' (Hole t)
-
-instance Typeable t => P (ProxyT' (t :: Type)) a where
-  type PP (ProxyT' t) a = Proxy (PP t a)
-  eval _ opts _ =
-    let t = showT @t
-    in pure $ mkNode opts (PresentT Proxy) ["ProxyT(" <> show t ++ ")"] []
-
--- | similar to 'Data.List.!!'
---
--- >>> pl @(Ix 4 "not found") ["abc","D","eF","","G"]
--- Present "G"
--- PresentT "G"
---
--- >>> pl @(Ix 40 "not found") ["abc","D","eF","","G"]
--- Present "not found"
--- PresentT "not found"
---
-data Ix (n :: Nat) def
-type Ix' (n :: Nat) = Ix n (Failp "Ix index not found")
-
-instance (P def (Proxy a)
-        , PP def (Proxy a) ~ a
-        , KnownNat n
-        , Show a
-        ) => P (Ix n def) [a] where
-  type PP (Ix n def) [a] = a
-  eval _ opts as = do
-    let n = nat @n
-        msg0 = "Ix " <> show n
-    case as ^? ix n of
-         Nothing -> do
-           let msg1 = msg0 <> " not found"
-           pp <- eval (Proxy @def) opts (Proxy @a)
-           pure $ case getValueLR opts msg1 pp [] of
-             Left e -> e
-             Right _ -> mkNode opts (_tBool pp) [msg1] [hh pp]
-         Just a -> pure $ mkNode opts (PresentT a) [msg0 <> show0 opts " " a] []
-
--- | similar to 'Data.List.!!' leveraging 'Ixed'
---
--- >>> import qualified Data.Map.Strict as M
--- >>> pl @(Id !! 2) ["abc","D","eF","","G"]
--- Present "eF"
--- PresentT "eF"
---
--- >>> pl @(Id !! 20) ["abc","D","eF","","G"]
--- Error (!!) index not found
--- FailT "(!!) index not found"
---
--- >>> pl @(Id !! "eF") (M.fromList (flip zip [0..] ["abc","D","eF","","G"]))
--- Present 2
--- PresentT 2
---
-data IxL p q def -- p is the big value and q is the index and def is the default
-type p !! q = IxL p q (Failp "(!!) index not found")
-instance (P q a
-        , P p a
-        , Show (PP p a)
-        , Ixed (PP p a)
-        , PP q a ~ Index (PP p a)
-        , Show (Index (PP p a))
-        , Show (IxValue (PP p a))
-        , P r (Proxy (IxValue (PP p a)))
-        , PP r (Proxy (IxValue (PP p a))) ~ IxValue (PP p a)
-        )
-   => P (IxL p q r) a where
-  type PP (IxL p q r) a = IxValue (PP p a)
-  eval _ opts a = do
-    let msg0 = "IxL"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    case lr of
-      Left e -> pure e
-      Right (p,q,pp,qq) ->
-        let msg1 = msg0 <> "(" <> show q <> ")"
-        in case p ^? ix q of
-             Nothing -> do
-                rr <- eval (Proxy @r) opts (Proxy @(IxValue (PP p a)))
-                pure $ case getValueLR opts msg1 rr [hh pp, hh qq] of
-                  Left e -> e
-                  Right _ -> mkNode opts (_tBool rr) [msg1 <> " index not found"] [hh pp, hh qq]
-             Just ret -> pure $ mkNode opts (PresentT ret) [show01' opts msg1 ret "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
-
--- | 'lookup' leveraging 'Ixed'
---
--- >>> pl @(Id !!! 2) ["abc","D","eF","","G"]
--- Present "eF"
--- PresentT "eF"
---
--- >>> pl @(Id !!! 20) ["abc","D","eF","","G"]
--- Error index not found
--- FailT "index not found"
---
--- >>> pl @(Id !!! "eF") (M.fromList (flip zip [0..] ["abc","D","eF","","G"]))
--- Present 2
--- PresentT 2
---
--- >>> pl @(Lookup Id 2) ["abc","D","eF","","G"]
--- Present Just "eF"
--- PresentT (Just "eF")
---
--- >>> pl @(Lookup Id 20) ["abc","D","eF","","G"]
--- Present Nothing
--- PresentT Nothing
---
-data Lookup p q
-type p !!! q = Lookup p q >> MaybeIn (Failp "index not found") Id -- use !!
--- Lookup' is interesting but just use Lookup or !!
-type Lookup' (t :: Type) p q = q &&& Lookup p q >> If (Snd Id >> IsNothing) (ShowP (Fst Id) >> Fail (Hole t) (Printf "index(%s) not found" Id)) (Snd Id >> 'Just Id)
-
-instance (P q a
-        , P p a
-        , Show (PP p a)
-        , Ixed (PP p a)
-        , PP q a ~ Index (PP p a)
-        , Show (Index (PP p a))
-        , Show (IxValue (PP p a))
-        )
-   => P (Lookup p q) a where
-  type PP (Lookup p q) a = Maybe (IxValue (PP p a))
-  eval _ opts a = do
-    let msg0 = "Lookup"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let msg1 = msg0 <> "(" <> show q <> ")"
-            hhs = [hh pp, hh qq]
-        in case p ^? ix q of
-             Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " not found"] hhs
-             Just ret -> mkNode opts (PresentT (Just ret)) [show01' opts msg1 ret "p=" p <> show1 opts " | q=" q] hhs
-
--- | 'Data.List.ands'
---
--- >>> pl @(Ands Id) [True,True,True]
--- True
--- TrueT
---
--- >>> pl @(Ands Id) [True,True,True,False]
--- False
--- FalseT
---
--- >>> pl @(Ands Id) []
--- True
--- TrueT
---
-data Ands p
-type Ands' p = FoldMap SG.All p
-
-instance (PP p x ~ t a
-        , P p x
-        , Show (t a)
-        , Foldable t
-        , a ~ Bool
-        ) => P (Ands p) x where
-  type PP (Ands p) x = Bool
-  eval _ opts x = do
-    let msg0 = "Ands"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = and p
-        in mkNodeB opts b [msg0 <> show1 opts " | " p] [hh pp]
-
--- | 'Data.List.ors'
---
--- >>> pl @(Ors Id) [False,False,False]
--- False
--- FalseT
---
--- >>> pl @(Ors Id) [True,True,True,False]
--- True
--- TrueT
---
--- >>> pl @(Ors Id) []
--- False
--- FalseT
---
-data Ors p
-type Ors' p = FoldMap SG.Any p
-
-instance (PP p x ~ t a
-        , P p x
-        , Show (t a)
-        , Foldable t
-        , a ~ Bool
-        ) => P (Ors p) x where
-  type PP (Ors p) x = Bool
-  eval _ opts x = do
-    let msg0 = "Ors"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = or p
-        in mkNodeB opts b [msg0 <> show1 opts " | " p] [hh pp]
-
--- cant directly create a singleton type using '[] since the type of '[] is unknown. instead use 'Singleton' or 'EmptyT'
-
--- | similar to cons
---
--- >>> pl @(Fst Id :+ Snd Id) (99,[1,2,3,4])
--- Present [99,1,2,3,4]
--- PresentT [99,1,2,3,4]
---
--- >>> pl @(Snd Id :+ Fst Id) ([],5)
--- Present [5]
--- PresentT [5]
---
--- >>> pl @(123 :+ EmptyList _) "somestuff"
--- Present [123]
--- PresentT [123]
---
-data p :+ q
-infixr 5 :+
-instance (P p x
-        , P q x
-        , Show (PP p x)
-        , Show (PP q x)
-        , Cons (PP q x) (PP q x) (PP p x) (PP p x)
-        ) => P (p :+ q) x where
-  type PP (p :+ q) x = PP q x
-  eval _ opts z = do
-    let msg0 = "(:+)"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts z
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let b = p `cons` q
-        in mkNode opts (PresentT b) [show01' opts msg0 b "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
-
--- | similar to snoc
---
--- >>> pl @(Snd Id +: Fst Id) (99,[1,2,3,4])
--- Present [1,2,3,4,99]
--- PresentT [1,2,3,4,99]
---
--- >>> pl @(Fst Id +: Snd Id) ([],5)
--- Present [5]
--- PresentT [5]
---
--- >>> pl @(EmptyT [] Id +: 5) 5
--- Present [5]
--- PresentT [5]
---
-data p +: q
-infixl 5 +:
-
-instance (P p x
-        , P q x
-        , Show (PP q x)
-        , Show (PP p x)
-        , Snoc (PP p x) (PP p x) (PP q x) (PP q x)
-        ) => P (p +: q) x where
-  type PP (p +: q) x = PP p x
-  eval _ opts z = do
-    let msg0 = "(+:)"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts z
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let b = p `snoc` q
-        in mkNode opts (PresentT b) [show01' opts msg0 b "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
-
--- | 'Control.Lens.uncons'
---
--- >>> pl @Uncons [1,2,3,4]
--- Present Just (1,[2,3,4])
--- PresentT (Just (1,[2,3,4]))
---
--- >>> pl @Uncons []
--- Present Nothing
--- PresentT Nothing
---
--- >>> pl @Uncons (Seq.fromList "abc")
--- Present Just ('a',fromList "bc")
--- PresentT (Just ('a',fromList "bc"))
---
--- >>> pl @Uncons ("xyz" :: T.Text)
--- Present Just ('x',"yz")
--- PresentT (Just ('x',"yz"))
---
-data Uncons
-
-instance (Show (ConsT s)
-        , Show s
-        , Cons s s (ConsT s) (ConsT s)
-        ) => P Uncons s where
-  type PP Uncons s = Maybe (ConsT s,s)
-  eval _ opts as =
-    let msg0 = "Uncons"
-        b = as ^? _Cons
-    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b as] []
-
--- | 'Control.Lens.unsnoc'
---
--- >>> pl @Unsnoc [1,2,3,4]
--- Present Just ([1,2,3],4)
--- PresentT (Just ([1,2,3],4))
---
--- >>> pl @Unsnoc []
--- Present Nothing
--- PresentT Nothing
---
--- >>> pl @Unsnoc ("xyz" :: T.Text)
--- Present Just ("xy",'z')
--- PresentT (Just ("xy",'z'))
---
-data Unsnoc
-
-instance (Show (ConsT s)
-        , Show s
-        , Snoc s s (ConsT s) (ConsT s)
-        ) => P Unsnoc s where
-  type PP Unsnoc s = Maybe (s,ConsT s)
-  eval _ opts as =
-    let msg0 = "Unsnoc"
-        b = as ^? _Snoc
-    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b as] []
-
--- | similar to 'null' using 'AsEmpty'
---
--- >>> pl @IsEmpty [1,2,3,4]
--- False
--- FalseT
---
--- >>> pl @IsEmpty []
--- True
--- TrueT
---
--- >>> pl @IsEmpty LT
--- False
--- FalseT
---
--- >>> pl @IsEmpty EQ
--- True
--- TrueT
---
-data IsEmpty
-
-instance (Show as, AsEmpty as) => P IsEmpty as where
-  type PP IsEmpty as = Bool
-  eval _ opts as =
-    let b = has _Empty as
-    in pure $ mkNodeB opts b ["IsEmpty" <> show1 opts " | " as] []
-
--- | similar to 'null' using 'Foldable'
---
--- >>> pl @Null [1,2,3,4]
--- False
--- FalseT
---
--- >>> pl @Null []
--- True
--- TrueT
---
--- >>> pl @Null Nothing
--- True
--- TrueT
---
-data Null
-
-instance (Show (t a)
-        , Foldable t
-        , t a ~ as
-        ) => P Null as where
-  type PP Null as = Bool
-  eval _ opts as =
-    let b = null as
-    in pure $ mkNodeB opts b ["Null" <> show1 opts " | " as] []
-
--- | similar to 'enumFromTo'
---
--- >>> pl @(EnumFromTo 2 5) ()
--- Present [2,3,4,5]
--- PresentT [2,3,4,5]
---
--- >>> pl @(EnumFromTo 'LT 'GT) ()
--- Present [LT,EQ,GT]
--- PresentT [LT,EQ,GT]
---
--- >>> pl @(EnumFromTo 'GT 'LT) ()
--- Present []
--- PresentT []
---
--- >>> pl @(EnumFromTo (Pred Id) (Succ Id)) (SG.Max 10)
--- Present [Max {getMax = 9},Max {getMax = 10},Max {getMax = 11}]
--- PresentT [Max {getMax = 9},Max {getMax = 10},Max {getMax = 11}]
---
-
-data EnumFromTo p q
-instance (P p x
-        , P q x
-        , PP p x ~ a
-        , Show a
-        , PP q x ~ a
-        , Enum a
-        ) => P (EnumFromTo p q) x where
-  type PP (EnumFromTo p q) x = [PP p x]
-  eval _ opts z = do
-    let msg0 = "EnumFromTo"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts z
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) -> mkNode opts (PresentT (enumFromTo p q)) [msg0 <> " [" <> show p <> " .. " <> show q <> "]"] [hh pp, hh qq]
-
-type MapMaybe p q = ConcatMap (p >> MaybeIn MEmptyP '[Id]) q
-type CatMaybes q = MapMaybe Id q
-
--- | similar to 'partitionEithers'
---
--- >>> pl @PartitionEithers [Left 'a',Right 2,Left 'c',Right 4,Right 99]
--- Present ("ac",[2,4,99])
--- PresentT ("ac",[2,4,99])
---
--- >>> pl @PartitionEithers [Right 2,Right 4,Right 99]
--- Present ([],[2,4,99])
--- PresentT ([],[2,4,99])
---
--- >>> pl @PartitionEithers [Left 'a',Left 'c']
--- Present ("ac",[])
--- PresentT ("ac",[])
---
--- >>> pl @PartitionEithers ([] @(Either _ _))
--- Present ([],[])
--- PresentT ([],[])
---
-data PartitionEithers
-
-instance (Show a, Show b) => P PartitionEithers [Either a b] where
-  type PP PartitionEithers [Either a b] = ([a], [b])
-  eval _ opts as =
-    let msg0 = "PartitionEithers"
-        b = partitionEithers as
-    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b as] []
-
--- | similar to 'partitionThese'. returns a 3-tuple with the results so use 'Fst' 'Snd' 'Thd' to extract
---
--- >>> pl @PartitionThese [This 'a', That 2, This 'c', These 'z' 1, That 4, These 'a' 2, That 99]
--- Present ("ac",[2,4,99],[('z',1),('a',2)])
--- PresentT ("ac",[2,4,99],[('z',1),('a',2)])
---
-data PartitionThese
-instance (Show a, Show b) => P PartitionThese [These a b] where
-  type PP PartitionThese [These a b] = ([a], [b], [(a, b)])
-  eval _ opts as =
-    let msg0 = "PartitionThese"
-        b = partitionThese as
-    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b as] []
-
-type Thiss = Fst PartitionThese
-type Thats = Snd PartitionThese
-type Theses = Thd PartitionThese
-
--- want to pass Proxy b to q but then we have no way to calculate 'b'
-
--- | similar to 'scanl'
---
--- >>> pl @(Scanl (Snd Id :+ Fst Id) (Fst Id) (Snd Id)) ([99],[1..5])
--- Present [[99],[1,99],[2,1,99],[3,2,1,99],[4,3,2,1,99],[5,4,3,2,1,99]]
--- PresentT [[99],[1,99],[2,1,99],[3,2,1,99],[4,3,2,1,99],[5,4,3,2,1,99]]
---
--- >>> pl @(ScanN 4 Id (Succ Id)) 'c'
--- Present "cdefg"
--- PresentT "cdefg"
---
--- >>> pl @(FoldN 4 Id (Succ Id)) 'c'
--- Present 'g'
--- PresentT 'g'
---
-
-data Scanl p q r
--- scanr :: (a -> b -> b) -> b -> [a] -> [b]
--- result is scanl but signature is flipped ((a,b) -> b) -> b -> [a] -> [b]
-
-type ScanN n p q = Scanl (Fst Id >> q) p (EnumFromTo 1 n) -- n times using q then run p
-type ScanNA q = ScanN (Fst Id) (Snd Id) q
-
-type FoldN n p q = Last' (ScanN n p q)
-type Foldl p q r = Last' (Scanl p q r)
-
-instance (PP p (b,a) ~ b
-        , PP q x ~ b
-        , PP r x ~ [a]
-        , P p (b,a)
-        , P q x
-        , P r x
-        , Show b
-        , Show a
-        )
-     => P (Scanl p q r) x where
-  type PP (Scanl p q r) x = [PP q x]
-  eval _ opts z = do
-    let msg0 = "Scanl"
-    lr <- runPQ msg0 (Proxy @q) (Proxy @r) opts z
-    case lr of
-      Left e -> pure e
-      Right (q,r,qq,rr) -> do
-        let msg1 = msg0  -- <> show0 opts " " q <> show0 opts " " r
-            ff i b as' rs
-               | i >= _MX = pure (rs, Left $ mkNode opts (FailT (msg1 <> ":failed at i=" <> show i)) [msg1 <> " i=" <> show i <> " (b,as')=" <> show (b,as')] [])
-               | otherwise =
-                   case as' of
-                     [] -> pure (rs, Right ()) -- ++ [((i,q), mkNode opts (PresentT q) [msg1 <> "(done)"] [])], Right ())
-                     a:as -> do
-                        pp :: TT b <- eval (Proxy @p) opts (b,a)
-                        case getValueLR opts (msg1 <> " i=" <> show i <> " a=" <> show a) pp [] of
-                           Left e  -> pure (rs,Left e)
-                           Right b' -> ff (i+1) b' as (rs ++ [((i,b), pp)])
-        (ts,lrx) :: ([((Int, b), TT b)], Either (TT [b]) ()) <- ff 1 q r []
-        pure $ case splitAndAlign opts [msg1] (((0,q), mkNode opts (PresentT q) [msg1 <> "(initial)"] []) : ts) of
-             Left _e -> error "cant happen!"
-             Right (vals,itts) ->
-               case lrx of
-                 Left e -> mkNode opts (_tBool e) [msg1] (hh qq : hh rr : map (hh . fixit) itts ++ [hh e])
-                 Right () -> mkNode opts (PresentT vals) [show01' opts msg1 vals "b=" q <> show1 opts " | as=" r] (hh qq : hh rr : map (hh . fixit) itts)
-
-type family UnfoldT mbs where
-  UnfoldT (Maybe (b,s)) = b
-
--- | similar to 'unfoldr'
---
--- >>> pl @(Unfoldr (MaybeBool (Not Null) (SplitAt 2 Id)) Id) [1..5]
--- Present [[1,2],[3,4],[5]]
--- PresentT [[1,2],[3,4],[5]]
---
--- >>> pl @(IterateN 4 (Succ Id)) 4
--- Present [4,5,6,7]
--- 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)
-type IterateN n f = Unfoldr (MaybeBool (Fst Id > 0) '(Snd Id, Pred Id *** f)) '(n, Id)
-type IterateUntil p f = IterateWhile (Not p) f
-type IterateWhile p f = Unfoldr (MaybeBool p '(Id, f)) Id
-type IterateNWhile n p f = '(n, Id) >> IterateWhile (Fst Id > 0 && (Snd Id >> p)) (Pred Id *** f) >> Map (Snd Id) Id
-type IterateNUntil n p f = IterateNWhile n (Not p) f
-
-instance (PP q a ~ s
-        , PP p s ~ Maybe (b,s)
-        , P q a
-        , P p s
-        , Show s
-        , Show b
-          )
-     => P (Unfoldr p q) a where
-  type PP (Unfoldr p q) a = [UnfoldT (PP p (PP q a))]
-  eval _ opts z = do
-    let msg0 = "Unfoldr"
-    qq <- eval (Proxy @q) opts z
-    case getValueLR opts msg0 qq [] of
-      Left e -> pure e
-      Right q -> do
-        let msg1 = msg0 <> show0 opts " " q
-            ff i s rs | i >= _MX = pure (rs, Left $ mkNode opts (FailT (msg1 <> ":failed at i=" <> show i)) [msg1 <> " i=" <> show i <> " s=" <> show s] [])
-                      | otherwise = do
-                              pp :: TT (PP p s) <- eval (Proxy @p) opts s
-                              case getValueLR opts (msg1 <> " i=" <> show i <> " s=" <> show s) pp [] of
-                                   Left e  -> pure (rs, Left e)
-                                   Right Nothing -> pure (rs, Right ())
-                                   Right w@(Just (_b,s')) -> ff (i+1) s' (rs ++ [((i,w), pp)])
-        (ts,lr) :: ([((Int, PP p s), TT (PP p s))], Either (TT [b]) ()) <- ff 1 q []
-        pure $ case splitAndAlign opts [msg1] ts of
-             Left _e -> error "cant happen"
-             Right (vals, itts) ->
-               case lr of
-                 Left e -> mkNode opts (_tBool e) [msg1] (hh qq : map (hh . fixit) itts ++ [hh e])
-                 Right () ->
-                   let ret = fst <$> catMaybes vals
-                   in mkNode opts (PresentT ret) [show01' opts msg1 ret "s=" q ] (hh qq : map (hh . fixit) itts)
-
--- | similar to 'map'
---
--- >>> pl @(Map (Pred Id) Id) [1..5]
--- Present [0,1,2,3,4]
--- PresentT [0,1,2,3,4]
---
-data Map p q
-type ConcatMap p q = Concat (Map p q)
-
-instance (Show (PP p a)
-        , P p a
-        , PP q x ~ f a
-        , P q x
-        , Show a
-        , Show (f a)
-        , Foldable f
-        ) => P (Map p q) x where
-  type PP (Map p q) x = [PP p (ExtractAFromTA (PP q x))]
-  eval _ opts x = do
-    let msg0 = "Map"
-    qq <- eval (Proxy @q) opts x
-    case getValueLR opts msg0 qq [] of
-      Left e -> pure e
-      Right as -> do
-        ts <- zipWithM (\i a -> ((i, a),) <$> eval (Proxy @p) opts a) [0::Int ..] (toList as)
-        pure $ case splitAndAlign opts [msg0] ts of
-             Left e -> e
-             Right (vals, _) -> mkNode opts (PresentT vals) [show01 opts msg0 vals as] (hh qq : map (hh . fixit) ts)
-
--- | if p then run q else run r
---
--- >>> pl @(If (Gt 4) "greater than 4" "less than or equal to 4" ) 10
--- Present "greater than 4"
--- PresentT "greater than 4"
---
--- >>> pl @(If (Gt 4) "greater than 4" "less than or equal to 4") 0
--- Present "less than or equal to 4"
--- PresentT "less than or equal to 4"
-data If p q r
-
-instance (Show (PP r a)
-        , P p a
-        , PP p a ~ Bool
-        , P q a
-        , P r a
-        , PP q a ~ PP r a
-        ) => P (If p q r) a where
-  type PP (If p q r) a = PP q a
-  eval _ opts a = do
-    let msg0 = "If"
-    pp <- evalBool (Proxy @p) opts a
-    case getValueLR opts (msg0 <> " condition failed") pp [] of
-      Left e -> pure e
-      Right b -> do
-        qqrr <- if b
-              then eval (Proxy @q) opts a
-              else eval (Proxy @r) opts a
-        pure $ case getValueLR opts (msg0 <> " [" <> show b <> "]") qqrr [hh pp, hh qqrr] of
-          Left e -> e
-          Right ret -> mkNode opts (_tBool qqrr) [msg0 <> " " <> if b then "(true cond)" else "(false cond)" <> show0 opts " " ret] [hh pp, hh qqrr]
-
--- | creates a list of overlapping pairs of elements. requires two or more elements
---
--- >>> pl @Pairs [1,2,3,4]
--- Present [(1,2),(2,3),(3,4)]
--- PresentT [(1,2),(2,3),(3,4)]
---
--- >>> pl @Pairs []
--- Error Pairs no data found
--- FailT "Pairs no data found"
---
--- >>> pl @Pairs [1]
--- Error Pairs only one element found
--- FailT "Pairs only one element found"
---
-data Pairs
-instance Show a => P Pairs [a] where
-  type PP Pairs [a] = [(a,a)]
-  eval _ opts as =
-    let msg0 = "Pairs"
-        lr = case as of
-               [] -> Left (msg0 <> " no data found")
-               [_] -> Left (msg0 <> " only one element found")
-               _:bs@(_:_) -> Right (zip as bs)
-    in pure $ case lr of
-         Left e -> mkNode opts (FailT e) [e] []
-         Right zs -> mkNode opts (PresentT zs) [show01 opts msg0 zs as ] []
-
-
--- | similar to 'partition'
---
--- >>> pl @(Partition (Ge 3) Id) [10,4,1,7,3,1,3,5]
--- Present ([10,4,7,3,3,5],[1,1])
--- PresentT ([10,4,7,3,3,5],[1,1])
---
--- >>> pl @(Partition (Prime Id) Id) [10,4,1,7,3,1,3,5]
--- Present ([7,3,3,5],[10,4,1,1])
--- PresentT ([7,3,3,5],[10,4,1,1])
---
--- >>> pl @(Partition (Ge 300) Id) [10,4,1,7,3,1,3,5]
--- Present ([],[10,4,1,7,3,1,3,5])
--- PresentT ([],[10,4,1,7,3,1,3,5])
---
--- >>> pl @(Partition (Id < 300) Id) [10,4,1,7,3,1,3,5]
--- Present ([10,4,1,7,3,1,3,5],[])
--- PresentT ([10,4,1,7,3,1,3,5],[])
---
-data Partition p q
-
-type FilterBy p q = Partition p q >> Fst Id
-
-instance (P p x
-        , Show x
-        , PP q a ~ [x]
-        , PP p x ~ Bool
-        , P q a
-        ) => P (Partition p q) a where
-  type PP (Partition p q) a = (PP q a, PP q a)
-  eval _ opts a' = do
-    let msg0 = "Partition"
-    qq <- eval (Proxy @q) opts a'
-    case getValueLR opts msg0 qq [] of
-      Left e -> pure e
-      Right as -> do
-             ts <- zipWithM (\i a -> ((i, a),) <$> evalBool (Proxy @p) opts a) [0::Int ..] as
-             pure $ case splitAndAlign opts [msg0] ts of
-               Left e -> e
-               Right (vals, tfs) ->
-                 let w0 = partition fst $ zip vals tfs
-                     zz1 = (map (snd . fst . snd) *** map (snd . fst . snd)) w0
-                 in mkNode opts (PresentT zz1) [show01' opts msg0 zz1 "s=" as] (hh qq : map (hh . fixit) tfs)
-
-
--- | similar to 'break'
---
--- >>> pl @(Break (Ge 3) Id) [10,4,1,7,3,1,3,5]
--- Present ([],[10,4,1,7,3,1,3,5])
--- PresentT ([],[10,4,1,7,3,1,3,5])
---
--- >>> pl @(Break (Lt 3) Id) [10,4,1,7,3,1,3,5]
--- Present ([10,4],[1,7,3,1,3,5])
--- PresentT ([10,4],[1,7,3,1,3,5])
---
-data Break p q
-type Span p q = Break (Not p) q
--- only process up to the pivot! only process while Right False
--- a predicate can return PresentP not just TrueP
-instance (P p x
-        , PP q a ~ [x]
-        , PP p x ~ Bool
-        , P q a
-        ) => P (Break p q) a where
-  type PP (Break p q) a = (PP q a, PP q a)
-  eval _ opts a' = do
-    let msg0 = "Break"
-    qq <- eval (Proxy @q) opts a'
-    case getValueLR opts msg0 qq [] of
-      Left e -> pure e
-      Right as -> do
-        let ff [] zs = pure (zs, [], Nothing) -- [(ia,qq)] extras | the rest of the data | optional last pivot or error
-            ff ((i,a):ias) zs = do
-               pp <- evalBool (Proxy @p) opts a
-               let v = ((i,a), pp)
-               case getValueLR opts msg0 pp [hh qq] of
-                 Right False -> ff ias (zs Seq.|> v)
-                 Right True -> pure (zs,map snd ias,Just v)
-                 Left _ -> pure (zs,map snd ias,Just v)
-        (ialls,rhs,mpivot) <- ff (zip [0::Int ..] as) Seq.empty
-        pure $ case mpivot of
-             Nothing ->
-               mkNode opts (PresentT (map (snd . fst) (toList ialls), rhs))
-                       ([msg0] <> ["cnt=" <> show (length ialls, length rhs)])
-                       (map (hh . fixit) (toList ialls))
-             Just iall@(ia, tt) ->
-               case getValueLR opts (msg0 <> " predicate failed") tt (hh qq : map (hh . fixit) (toList (ialls Seq.|> iall))) of
-                 Right True ->
-                   mkNode opts (PresentT (map (snd . fst) (toList ialls), snd ia : rhs))
-                           ([msg0] <> ["cnt=" <> show (length ialls, 1+length rhs)])
-                           (hh qq : hh tt : map (hh . fixit) (toList (ialls Seq.|> iall)))
-
-                 Right False -> error "shouldnt happen"
-                 Left e -> e
-
--- | Fails the computation with a message
---
--- >>> pl @(Failt Int (Printf "value=%03d" Id)) 99
--- Error value=099
--- FailT "value=099"
---
--- >>> pl @(FailS (Printf2 "value=%03d string=%s")) (99,"somedata")
--- Error value=099 string=somedata
--- FailT "value=099 string=somedata"
---
-data Fail t prt -- t=output type prt=msg
-type Failp s = Fail Unproxy s
-type Failt (t :: Type) prt = Fail (Hole t) prt
-type FailS s = Fail I s
-type FailPrt (t :: Type) prt = Fail (Hole t)(Printf prt)
-type FailPrt2 (t :: Type) prt = Fail (Hole t)(Printf2 prt)
-
-instance (P prt a
-        , PP prt a ~ String
-        ) => P (Fail t prt) a where
-  type PP (Fail t prt) a = PP t a
-  eval _ opts a = do
-    let msg0 = "Fail"
-    pp <- eval (Proxy @prt) opts a
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right s -> mkNode opts (FailT s) [msg0 <> " " <> s] [hh pp]
-
-data Hole (t :: Type)
-
--- | Acts as a proxy in this dsl where you can explicitly set the Type.
---
---  It is passed around as an argument to help the type checker when needed.
---  see 'ReadP', 'ParseTimeP', 'ShowP'
---
-instance Typeable t => P (Hole t) a where
-  type PP (Hole t) a = t -- can only be Type not Type -> Type (can use Proxy but then we go down the rabbithole)
-  eval _ opts _a =
-    let msg0 = "Hole(" <> showT @t <> ")"
-    in pure $ mkNode opts (FailT msg0) [msg0 <> " you probably meant to get access to the type of PP only and not evaluate"] []
-
-data Unproxy
-
-instance Typeable a => P Unproxy (Proxy (a :: Type)) where
-  type PP Unproxy (Proxy a) = a
-  eval _ opts _a =
-    let msg0 = "Unproxy(" <> showT @a <> ")"
-    in pure $ mkNode opts (FailT msg0) [msg0 <> " you probably meant to get access to the type of PP only and not evaluate"] []
-
--- | catch a failure
---
--- >>> pl @(Catch (Succ Id) (Fst Id >> Second (ShowP Id) >> Printf2 "%s %s" >> 'LT)) GT
--- Present LT
--- PresentT LT
---
--- >>> pl @(Catch' (Succ Id) (Second (ShowP Id) >> Printf2 "%s %s")) GT
--- Error Succ IO e=Prelude.Enum.Ordering.succ: bad argument GT
--- FailT "Succ IO e=Prelude.Enum.Ordering.succ: bad argument GT"
---
--- >>> pl @(Catch' (Succ Id) (Second (ShowP Id) >> Printf2 "%s %s")) LT
--- Present EQ
--- PresentT EQ
---
--- 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
-data Catch p q -- catch p and if fails runs q only on failt
-type Catch' p s = Catch p (FailCatch s) -- eg set eg s=Printf "%d" Id or Printf "%s" (ShowP Id)
-type FailCatch s = Fail (Snd Id >> Unproxy) (Fst Id >> s)
-
-instance (P p x
-        , P q ((String, x)
-        , Proxy (PP p x))
-        , PP p x ~ PP q ((String, x), Proxy (PP p x))
-        ) => P (Catch p q) x where
-  type PP (Catch p q) x = PP p x
-  eval _ opts x = do
-    let msg0 = "Catch"
-    pp <- eval (Proxy @p) opts x
-    case getValueLR opts msg0 pp [] of
-      Left e -> do
-         let emsg = e ^?! tBool . _FailT -- extract the failt string a push back into the fail case
-         qq <- eval (Proxy @q) opts ((emsg, x), Proxy @(PP p x))
-         pure $ case getValueLR opts (msg0 <> " default condition failed") qq [hh pp] of
-            Left e1 -> e1
-            Right _ -> mkNode opts (_tBool qq) [msg0 <> " caught exception[" <> emsg <> "]"] [hh pp, hh qq]
-      Right _ -> pure $ mkNode opts (_tBool pp) [msg0 <> " did not fire"] [hh pp]
-
--- | similar to 'even'
---
--- >>> pl @(Map Even Id) [9,-4,12,1,2,3]
--- Present [False,True,True,False,True,False]
--- PresentT [False,True,True,False,True,False]
---
--- >>> pl @(Map '(Even,Odd) Id) [9,-4,12,1,2,3]
--- Present [(False,True),(True,False),(True,False),(False,True),(True,False),(False,True)]
--- PresentT [(False,True),(True,False),(True,False),(False,True),(True,False),(False,True)]
---
-type Even = Mod I 2 == 0
-type Odd = Mod I 2  == 1
---type Div' p q = Fst (DivMod p q)
---type Mod' p q = Snd (DivMod p q)
-
--- | similar to 'div'
---
--- >>> pl @(Div (Fst Id) (Snd Id)) (10,4)
--- Present 2
--- PresentT 2
---
--- >>> pl @(Div (Fst Id) (Snd Id)) (10,0)
--- Error Div zero denominator
--- FailT "Div zero denominator"
---
-data Div p q
-instance (PP p a ~ PP q a
-        , P p a
-        , P q a
-        , Show (PP p a)
-        , Integral (PP p a)
-        ) => P (Div p q) a where
-  type PP (Div p q) a = PP p a
-  eval _ opts a = do
-    let msg0 = "Div"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-         let hhs = [hh pp, hh qq]
-         in case q of
-              0 -> mkNode opts (FailT (msg0 <> " zero denominator")) [msg0 <> " zero denominator"] hhs
-              _ -> let d = p `div` q
-                   in mkNode opts (PresentT d) [show p <> " `div` " <> show q <> " = " <> show d] hhs
-
-
--- | similar to 'mod'
---
--- >>> pl @(Mod (Fst Id) (Snd Id)) (10,3)
--- Present 1
--- PresentT 1
---
--- >>> pl @(Mod (Fst Id) (Snd Id)) (10,0)
--- Error Mod zero denominator
--- FailT "Mod zero denominator"
---
-data Mod p q
-instance (PP p a ~ PP q a
-        , P p a
-        , P q a
-        , Show (PP p a)
-        , Integral (PP p a)
-        ) => P (Mod p q) a where
-  type PP (Mod p q) a = PP p a
-  eval _ opts a = do
-    let msg0 = "Mod"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-         let hhs = [hh pp, hh qq]
-         in case q of
-              0 -> mkNode opts (FailT (msg0 <> " zero denominator")) [msg0 <> " zero denominator"] hhs
-              _ -> let d = p `mod` q
-                   in mkNode opts (PresentT d) [show p <> " `mod` " <> show q <> " = " <> show d] hhs
-
--- | similar to 'divMod'
---
--- >>> pl @(DivMod (Fst Id) (Snd Id)) (10,3)
--- Present (3,1)
--- PresentT (3,1)
---
--- >>> pl @(DivMod (Fst Id) (Snd Id)) (10,-3)
--- Present (-4,-2)
--- PresentT (-4,-2)
---
--- >>> pl @(DivMod (Fst Id) (Snd Id)) (-10,3)
--- Present (-4,2)
--- PresentT (-4,2)
---
--- >>> pl @(DivMod (Fst Id) (Snd Id)) (-10,-3)
--- Present (3,-1)
--- PresentT (3,-1)
---
--- >>> pl @(DivMod (Fst Id) (Snd Id)) (10,0)
--- Error DivMod zero denominator
--- FailT "DivMod zero denominator"
---
-data DivMod p q
-
-instance (PP p a ~ PP q a
-        , P p a
-        , P q a
-        , Show (PP p a)
-        , Integral (PP p a)
-        ) => P (DivMod p q) a where
-  type PP (DivMod p q) a = (PP p a, PP p a)
-  eval _ opts a = do
-    let msg0 = "DivMod"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let hhs = [hh pp, hh qq]
-        in case q of
-             0 -> mkNode opts (FailT (msg0 <> " zero denominator")) [msg0 <> " zero denominator"] hhs
-             _ -> let d = p `divMod` q
-                  in mkNode opts (PresentT d) [show p <> " `divMod` " <> show q <> " = " <> show d] hhs
-
--- | similar to 'quotRem'
---
--- >>> pl @(QuotRem (Fst Id) (Snd Id)) (10,3)
--- Present (3,1)
--- PresentT (3,1)
---
--- >>> pl @(QuotRem (Fst Id) (Snd Id)) (10,-3)
--- Present (-3,1)
--- PresentT (-3,1)
---
--- >>> pl @(QuotRem (Fst Id) (Snd Id)) (-10,-3)
--- Present (3,-1)
--- PresentT (3,-1)
---
--- >>> pl @(QuotRem (Fst Id) (Snd Id)) (-10,3)
--- Present (-3,-1)
--- PresentT (-3,-1)
---
--- >>> pl @(QuotRem (Fst Id) (Snd Id)) (10,0)
--- Error QuotRem zero denominator
--- FailT "QuotRem zero denominator"
---
-data QuotRem p q
-
-instance (PP p a ~ PP q a
-        , P p a
-        , P q a
-        , Show (PP p a)
-        , Integral (PP p a)
-        ) => P (QuotRem p q) a where
-  type PP (QuotRem p q) a = (PP p a, PP p a)
-  eval _ opts a = do
-    let msg0 = "QuotRem"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let hhs = [hh pp, hh qq]
-        in case q of
-             0 -> mkNode opts (FailT (msg0 <> " zero denominator")) [msg0 <> " zero denominator"] hhs
-             _ -> let d = p `quotRem` q
-                  in mkNode opts (PresentT d) [show p <> " `quotRem` " <> show q <> " = " <> show d] hhs
-
-type Quot p q = Fst (QuotRem p q)
-type Rem p q = Snd (QuotRem p q)
-
---type OneP = Guard "expected list of length 1" (Len >> Same 1) >> Head'
-type OneP = Guard (Printf "expected list of length 1 but found length=%d" Len) (Len == 1) >> Head
-
-strictmsg :: forall strict . GetBool strict => String
-strictmsg = if getBool @strict then "" else "Lax"
-
--- k or prt has access to (Int,a) where Int is the current guard position: hence need to use Printf2
--- todo: better explanation of how this works
--- passthru but adds the length of ps (replaces LenT in the type synonym to avoid type synonyms being expanded out)
-
--- | Guards contain a type level list of tuples the action to run on failure of the predicate and the predicate itself
--- Each tuple validating against the corresponding value in a value list
---
--- >>> pl @(Guards '[ '("arg1 failed",Gt 4), '("arg2 failed", Same 4)]) [17,4]
--- Present [17,4]
--- PresentT [17,4]
---
--- >>> pl @(Guards '[ '("arg1 failed",Gt 4), '("arg2 failed", Same 5)]) [17,4]
--- Error arg2 failed
--- FailT "arg2 failed"
---
--- >>> pl @(Guards '[ '("arg1 failed",Gt 99), '("arg2 failed", Same 4)]) [17,4]
--- Error arg1 failed
--- FailT "arg1 failed"
---
--- >>> pl @(Guards '[ '(Printf2 "arg %d failed with value %d",Gt 4), '(Printf2 "%d %d", Same 4)]) [17,3]
--- Error 2 3
--- FailT "2 3"
---
--- >>> pl @(GuardsQuick (Printf2 "arg %d failed with value %d") '[Gt 4, Ge 3, Same 4]) [17,3,5]
--- Error arg 3 failed with value 5
--- FailT "arg 3 failed with value 5"
---
--- >>> pl @(GuardsQuick (Printf2 "arg %d failed with value %d") '[Gt 4, Ge 3, Same 4]) [17,3,5,99]
--- Error Guards: data elements(4) /= predicates(3)
--- FailT "Guards: data elements(4) /= predicates(3)"
---
-data GuardsImpl (n :: Nat) (strict :: Bool) (os :: [(k,k1)])
-type Guards (os :: [(k,k1)]) = GuardsImplW 'True os
-type GuardsLax (os :: [(k,k1)]) = GuardsImplW 'False os
-type GuardsQuick (prt :: k) (os :: [k1]) = Guards (ToGuardsT prt os)
-type GuardsQuickLax (prt :: k) (os :: [k1]) = GuardsLax (ToGuardsT prt os)
-
-data GuardsImplW (strict :: Bool) (ps :: [(k,k1)])
-instance (GetBool strict, GetLen ps, P (GuardsImpl (LenT ps) strict ps) [a]) => P (GuardsImplW strict ps) [a] where
-  type PP (GuardsImplW strict ps) [a] = PP (GuardsImpl (LenT ps) strict ps) [a]
-  eval _ opts as = do
-    let strict = getBool @strict
-        msgbase0 = "Guards" <> strictmsg @strict
-        n = getLen @ps
-    if strict && n /= length as then
-       let xx = msgbase0 <> ": data elements(" <> show (length as) <> ") /= predicates(" <> show n <> ")"
-       in pure $ mkNode opts (FailT xx) [xx] []
-    else eval (Proxy @(GuardsImpl (LenT ps) strict ps)) opts as
-
-instance (KnownNat n
-        , GetBool strict
-        , Show a
-        ) => P (GuardsImpl n strict ('[] :: [(k,k1)])) [a] where
-  type PP (GuardsImpl n strict ('[] :: [(k,k1)])) [a] = [a]
-  eval _ opts as =
-    let msg0 = "Guards" <> strictmsg @strict <> "(" <> show n <> ")"
-        n :: Int = nat @n
-    in pure $ mkNode opts (PresentT as) [msg0 <> " done!" <> if null as then "" else show1 opts " | leftovers=" as] []
-
-instance (PP prt (Int, a) ~ String
-        , P prt (Int, a)
-        , KnownNat n
-        , GetBool strict
-        , GetLen ps
-        , P p a
-        , PP p a ~ Bool
-        , P (GuardsImpl n strict ps) [a]
-        , PP (GuardsImpl n strict ps) [a] ~ [a]
-        , Show a
-        ) => P (GuardsImpl n strict ('(prt,p) ': ps)) [a] where
-  type PP (GuardsImpl n strict ('(prt,p) ': ps)) [a] = [a]
-  eval _ opts as' = do
-     let msgbase0 = "Guards" <> strictmsg @strict <> "(" <> show (n-pos) <> ":" <> show n <> ")"
-         msgbase1 = "Guard" <> strictmsg @strict <> "(" <> show (n-pos) <> ")"
-         msgbase2 = "Guards" <> strictmsg @strict
-         n :: Int = nat @n
-         pos = getLen @ps
-     case as' of
-         [] -> pure $ mkNode opts (PresentT mempty) [msgbase0 <> " (ran out of data!!)"] []
-         a:as -> do
-                    pp <- evalBool (Proxy @p) opts a
-                    case getValueLR opts (msgbase1 <> " p failed") pp [] of
-                         Left e -> pure e
-                         Right False -> do
-                           qq <- eval (Proxy @prt) opts (n-pos,a) -- only run prt when predicate is False
-                           pure $ case getValueLR opts (msgbase2 <> " False predicate and prt failed") qq [hh pp] of
-                              Left e -> e
-                              Right msgx -> mkNode opts (FailT msgx) [msgbase1 <> " failed [" <> msgx <> "]" <> show0 opts " " a] [hh pp, hh qq]
-                         Right True -> do
-                           ss <- eval (Proxy @(GuardsImpl n strict ps)) opts as
-                           pure $ case getValueLRHide opts (msgbase1 <> " ok | rhs failed") ss [hh pp] of
-                             Left e -> e -- shortcut else we get too compounding errors with the pp tree being added each time!
-                             Right zs -> mkNode opts (PresentT (a:zs)) [msgbase1 <> show0 opts " " a] [hh pp, hh ss]
-
-
--- | if a predicate fails then then the corresponding symbol and value will be passed to the print function
---
--- >>> pl @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)]) [13,59,61]
--- Error seconds invalid: found 61
--- FailT "seconds invalid: found 61"
---
--- >>> pl @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)]) [27,59,12]
--- Error hours invalid: found 27
--- FailT "hours invalid: found 27"
---
--- >>> pl @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)]) [23,59,12]
--- Present [23,59,12]
--- PresentT [23,59,12]
---
-data GuardsImplX (n :: Nat) (strict :: Bool) (os :: [(k,k1)])
-
-type GuardsDetail (prt :: Symbol) (os :: [(k0,k1)]) = GuardsImplXX 'True (ToGuardsDetailT prt os)
-
-type family ToGuardsDetailT (prt :: k1) (os :: [(k2,k3)]) :: [(Type,k3)] where
-  ToGuardsDetailT prt '[ '(s,p) ] = '(Printfn prt '(s,'(Id,'())), p) : '[]
-  ToGuardsDetailT prt ( '(s,p) ': ps) = '(Printfn prt '(s,'(Id,'())), p) ': ToGuardsDetailT prt ps
-  ToGuardsDetailT prt '[] = GL.TypeError ('GL.Text "ToGuardsDetailT cannot be empty")
-
-data GuardsImplXX (strict :: Bool) (ps :: [(k,k1)])
-
-instance (GetBool strict, GetLen ps, P (GuardsImplX (LenT ps) strict ps) [a]) => P (GuardsImplXX strict ps) [a] where
-  type PP (GuardsImplXX strict ps) [a] = PP (GuardsImplX (LenT ps) strict ps) [a]
-  eval _ opts as = do
-    let strict = getBool @strict
-        msgbase0 = "Guards" <> strictmsg @strict
-        n = getLen @ps
-    if strict && n /= length as then
-       let xx = msgbase0 <> ": data elements(" <> show (length as) <> ") /= predicates(" <> show n <> ")"
-       in pure $ mkNode opts (FailT xx) [xx] []
-    else eval (Proxy @(GuardsImplX (LenT ps) strict ps)) opts as
-
-instance (KnownNat n
-        , GetBool strict
-        , Show a
-        ) => P (GuardsImplX n strict ('[] :: [(k,k1)])) [a] where
-  type PP (GuardsImplX n strict ('[] :: [(k,k1)])) [a] = [a]
-  eval _ opts as =
-    let msg0 = "Guards" <> strictmsg @strict <> "(" <> show n <> ")"
-        n :: Int = nat @n
-    in pure $ mkNode opts (PresentT as) [msg0 <> " done!" <> if null as then "" else show1 opts " | leftovers=" as] []
-
-instance (PP prt a ~ String
-        , P prt a
-        , KnownNat n
-        , GetBool strict
-        , GetLen ps
-        , P p a
-        , PP p a ~ Bool
-        , P (GuardsImplX n strict ps) [a]
-        , PP (GuardsImplX n strict ps) [a] ~ [a]
-        , Show a
-        ) => P (GuardsImplX n strict ('(prt,p) ': ps)) [a] where
-  type PP (GuardsImplX n strict ('(prt,p) ': ps)) [a] = [a]
-  eval _ opts as' = do
-     let msgbase0 = "Guards" <> strictmsg @strict <> "(" <> show (n-pos) <> ":" <> show n <> ")"
-         msgbase1 = "Guard" <> strictmsg @strict <> "(" <> show (n-pos) <> ")"
-         msgbase2 = "Guards" <> strictmsg @strict
-         n :: Int = nat @n
-         pos = getLen @ps
-     case as' of
-         [] -> pure $ mkNode opts (PresentT mempty) [msgbase0 <> " (ran out of data!!)"] []
-         a:as -> do
-                    pp <- evalBool (Proxy @p) opts a
-                    case getValueLR opts (msgbase1 <> " p failed") pp [] of
-                         Left e -> pure e
-                         Right False -> do
-                           qq <- eval (Proxy @prt) opts a -- only run prt when predicate is False
-                           pure $ case getValueLR opts (msgbase2 <> " False predicate and prt failed") qq [hh pp] of
-                              Left e -> e
-                              Right msgx -> mkNode opts (FailT msgx) [msgbase1 <> " failed [" <> msgx <> "]" <> show0 opts " " a] [hh pp, hh qq]
-                         Right True -> do
-                           ss <- eval (Proxy @(GuardsImplX n strict ps)) opts as
-                           pure $ case getValueLRHide opts (msgbase1 <> " ok | rhs failed") ss [hh pp] of
-                             Left e -> e -- shortcut else we get too compounding errors with the pp tree being added each time!
-                             Right zs -> mkNode opts (PresentT (a:zs)) [msgbase1 <> show0 opts " " a] [hh pp, hh ss]
-
--- | leverages 'GuardsQuick' for repeating predicates (passthrough method)
---
--- >>> pl @(GuardsN (Printf2 "id=%d must be between 0 and 255, found %d") 4 (Between 0 255)) [121,33,7,256]
--- Error id=4 must be between 0 and 255, found 256
--- FailT "id=4 must be between 0 and 255, found 256"
---
--- >>> pl @(GuardsN (Printf2 "id=%d must be between 0 and 255, found %d") 4 (Between 0 255)) [121,33,7,44]
--- Present [121,33,7,44]
--- PresentT [121,33,7,44]
---
-data GuardsNImpl (strict :: Bool) prt (n :: Nat) p
-type GuardsN prt (n :: Nat) p = GuardsNImpl 'True prt n p
-type GuardsNLax prt (n :: Nat) p = GuardsNImpl 'False prt n p
-
-instance ( GetBool strict
-         , GetLen (ToGuardsT prt (RepeatT n p))
-         , P (GuardsImpl
-             (LenT (ToGuardsT prt (RepeatT n p)))
-             strict
-             (ToGuardsT prt (RepeatT n p)))
-             [a]
-         ) => P (GuardsNImpl strict prt n p) [a] where
-  type PP (GuardsNImpl strict prt n p) [a] = PP (GuardsImplW strict (ToGuardsT prt (RepeatT n p))) [a]
-  eval _ opts as =
-    eval (Proxy @(GuardsImplW strict (ToGuardsT prt (RepeatT n p)))) opts as
-
-
--- | \'p\' is the predicate and on failure of the predicate runs \'prt\'
---
--- >>> pl @(Guard "expected > 3" (Gt 3)) 17
--- Present 17
--- PresentT 17
---
--- >>> pl @(Guard "expected > 3" (Gt 3)) 1
--- Error expected > 3
--- FailT "expected > 3"
---
--- >>> pl @(Guard (Printf "%d not > 3" Id) (Gt 3)) (-99)
--- Error -99 not > 3
--- FailT "-99 not > 3"
---
-data Guard prt p
-type Guard' p = Guard "Guard" p
-
-type ExitWhen prt p = Guard prt (Not p)
-type ExitWhen' p = ExitWhen "ExitWhen" p
-
-instance (Show a
-        , P prt a
-        , PP prt a ~ String
-        , P p a
-        , PP p a ~ Bool
-        ) => P (Guard prt p) a where
-  type PP (Guard prt p) a = a
-  eval _ opts a = do
-    let msg0 = "Guard"
-    pp <- evalBool (Proxy @p) opts a
-    case getValueLR opts msg0 pp [] of
-      Left e -> pure e
-      Right False -> do
-        qq <- eval (Proxy @prt) opts a
-        pure $ case getValueLR opts (msg0 <> " Msg") qq [hh pp] of
-          Left e -> e
-          Right msgx -> mkNode opts (FailT msgx) [msg0 <> "(failed) [" <> msgx <> "]" <> show0 opts " | " a] [hh pp, hh qq]
-      Right True -> pure $ mkNode opts (PresentT a) [msg0 <> "(ok)" <> show0 opts " | " a] [hh pp]  -- dont show the guard message if successful
-
-
--- | similar to 'Guard' but uses the root message of the False predicate case as the failure message
---
--- >>> pl @(GuardSimple (Luhn Id)) [1..4]
--- Error Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4]
--- FailT "Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4]"
---
--- >>> pl @(GuardSimple (Luhn Id)) [1,2,3,0]
--- Present [1,2,3,0]
--- PresentT [1,2,3,0]
---
--- >>> pl @(GuardSimple (Len > 30)) [1,2,3,0]
--- Error 4 > 30
--- FailT "4 > 30"
---
-data GuardSimple p
-
-instance (Show a
-        , P p a
-        , PP p a ~ Bool
-        ) => P (GuardSimple p) a where
-  type PP (GuardSimple p) a = a
-  eval _ opts a = do
-    let msg0 = "GuardSimple"
-        b = oLite opts
-    pp <- evalBool (Proxy @p) (if b then o0 else opts) a -- to not lose the message in oLite mode we use non lite and then fix it up after
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right False ->
-        let msgx = fromMaybe msg0 $ pp ^? tStrings . ix 0
-        in mkNode opts (FailT msgx) [msg0 <> "(failed) [" <> msgx <> "]" <> show0 opts " | " a] [hh pp]
-      Right True ->
-        mkNode opts (PresentT a) [msg0 <> "(ok)" <> show0 opts " | " a] [hh pp]
-
-
--- | just run the effect but skip the value
--- for example for use with Stdout so it doesnt interfere with the \'a\' on the rhs unless there is an error
-data Skip p
-type p |> q = Skip p >> q
-infixr 1 |>
-type p >| q = p >> Skip q
-infixr 1 >|
-
-instance (Show (PP p a), P p a) => P (Skip p) a where
-  type PP (Skip p) a = a
-  eval _ opts a = do
-    let msg0 = "Skip"
-    pp <- eval (Proxy @p) opts a
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p -> mkNode opts (PresentT a) [msg0 <> show0 opts " " p] [hh pp]
-
--- advantage of (>>) over 'Do [k] is we can use different kinds for (>>) without having to wrap with 'W'
-
--- | This is composition for predicates
---
--- >>> pl @(Fst Id >> Succ (Id !! 0)) ([11,12],'x')
--- Present 12
--- PresentT 12
---
--- >>> pl @(Len *** Succ Id >> ShowP (First (Pred Id))) ([11,12],'x')
--- Present "(1,'y')"
--- PresentT "(1,'y')"
---
-
-data (p :: k) >> (q :: k1)
-infixr 1 >>
-
-type (<<) p q = q >> p
-infixl 1 <<
-
-instance (Show (PP p a)
-        , Show (PP q (PP p a))
-        , P p a
-        , P q (PP p a)
-        ) => P (p >> q) a where
-  type PP (p >> q) a = PP q (PP p a)
-  eval _ opts a = do
-    let msg0 = ">>"
-    pp <- eval (Proxy @p) opts a
-    case getValueLRHide opts "lhs failed >>" pp [] of
-      Left e -> pure e
-      Right p -> do
-        qq <- eval (Proxy @q) opts p
-        pure $ case getValueLRHide opts (show p <> " >> rhs failed") qq [hh pp] of
-          Left e -> e
-          Right q -> mkNode opts (_tBool qq) [show01 opts msg0 q p] [hh pp, hh qq]
-
--- | similar to 'Prelude.&&'
---
--- >>> pl @(Fst Id && Snd Id) (True, True)
--- True
--- TrueT
---
--- >>> pl @(Id > 15 && Id < 17) 16
--- True
--- TrueT
---
--- >>> pl @(Id > 15 && Id < 17) 30
--- False
--- FalseT
---
--- >>> pl @(Fst Id && (Length (Snd Id) >= 4)) (True,[11,12,13,14])
--- True
--- TrueT
---
--- >>> pl @(Fst Id && (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
--- False
--- FalseT
---
-data (&&) (p :: k) (q :: k1)
-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
-    pp <- evalBool (Proxy @p) opts a
-    qq <- evalBool (Proxy @q) opts a
-    pure $ evalBinStrict opts "&&" (&&) pp qq
-
--- | similar to 'Prelude.||'
---
--- >>> pl @(Fst Id || (Length (Snd Id) >= 4)) (False,[11,12,13,14])
--- True
--- TrueT
---
--- >>> pl @(Not (Fst Id) || (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
--- False
--- FalseT
---
-data (||) (p :: k) (q :: k1)
-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
-    pp <- evalBool (Proxy @p) opts a
-    qq <- evalBool (Proxy @q) opts a
-    pure $ evalBinStrict opts "||" (||) pp qq
-
--- | implication
---
--- >>> pl @(Fst Id ~> (Length (Snd Id) >= 4)) (True,[11,12,13,14])
--- True
--- TrueT
---
--- >>> pl @(Fst Id ~> (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
--- False
--- FalseT
---
--- >>> pl @(Fst Id ~> (Length (Snd Id) == 4)) (False,[12,11,12,13,14])
--- True
--- TrueT
---
--- >>> pl @(Fst Id ~> (Length (Snd Id) >= 4)) (False,[11,12,13,14])
--- True
--- TrueT
---
-data (~>) (p :: k) (q :: k1)
-infixr 1 ~>
-
-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
-    pp <- evalBool (Proxy @p) opts a
-    qq <- evalBool (Proxy @q) opts a
-    pure $ evalBinStrict opts "~>" imply pp qq
-
--- | 'not' function
---
--- >>> pl @(Not Id) False
--- True
--- TrueT
---
--- >>> pl @(Not Id) True
--- False
--- FalseT
---
--- >>> pl @(Not (Fst Id)) (True,22)
--- False
--- FalseT
---
-data Not p
-instance (PP p x ~ Bool, P p x) => P (Not p) x where
-  type PP (Not p) x = Bool
-  eval _ opts x = do
-    let msg0 = "Not"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = not p
-        in mkNodeB opts b [msg0] [hh pp]
-
-data OrdP p q
-type p ==! q = OrdP p q
-infix 4 ==!
-
--- | similar to 'compare'
---
--- >>> pl @(Fst Id ==! Snd Id) (10,9)
--- Present GT
--- PresentT GT
---
--- >>> pl @(14 % 3 ==! Fst Id %- Snd Id) (-10,7)
--- Present GT
--- PresentT GT
---
--- >>> pl @(Fst Id ==! Snd Id) (10,11)
--- Present LT
--- PresentT LT
---
--- >>> pl @(Snd Id ==! (Fst Id >> Snd Id >> Head' Id)) (('x',[10,12,13]),10)
--- Present EQ
--- PresentT EQ
---
--- >>> pl @(Snd Id ==! Head' (Snd (Fst Id))) (('x',[10,12,13]),10)
--- Present EQ
--- PresentT EQ
---
-type OrdA' p q = OrdP (Fst Id >> p) (Snd Id >> q)
-type OrdA p = OrdA' p p
-
-instance (Ord (PP p a)
-        , PP p a ~ PP q a
-        , P p a
-        , Show (PP q a)
-        , P q a
-        ) => P (OrdP p q) a where
-  type PP (OrdP p q) a = Ordering
-  eval _ opts a = do
-    let msg0 = "OrdP"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = compare p q
-        in mkNode opts (PresentT d) [msg0 <> " " <> show p <> " " <> prettyOrd d <> show0 opts " " q] [hh pp, hh qq]
-
--- | compare two strings ignoring case
---
--- >>> pl @(Fst Id ===~ Snd Id) ("abC","aBc")
--- Present EQ
--- PresentT EQ
---
--- >>> pl @(Fst Id ===~ Snd Id) ("abC","DaBc")
--- Present LT
--- PresentT LT
---
-data OrdI p q
-type p ===~ q = OrdI p q
-infix 4 ===~
-
-instance (PP p a ~ String
-        , PP p a ~ PP q a
-        , P p a
-        , P q a
-        ) => P (OrdI p q) a where
-  type PP (OrdI p q) a = Ordering
-  eval _ opts a = do
-    let msg0 = "OrdI"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = on compare (map toLower) p q
-        in mkNode opts (PresentT d) [msg0 <> " " <> p <> " " <> prettyOrd d <> " " <> q] [hh pp, hh qq]
-
--- | compare two values using the given ordering \'o\'
-data Cmp (o :: OrderingP) p q
-
-instance (GetOrd o
-        , Ord (PP p a)
-        , Show (PP p a)
-        , PP p a ~ PP q a
-        , P p a
-        , P q a
-        ) => P (Cmp o p q) a where
-  type PP (Cmp o p q) a = Bool
-  eval _ opts a = do
-    let (sfn, fn) = getOrd @o
-    lr <- runPQ sfn (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let b = fn p q
-        in mkNodeB opts b [show p <> " " <> sfn <> show0 opts " " q] [hh pp, hh qq]
-
--- | compare two strings ignoring case using the given ordering \'o\'
-data CmpI (o :: OrderingP) p q
-
-instance (PP p a ~ String
-        , GetOrd o
-        , PP p a ~ PP q a
-        , P p a
-        , P q a
-        ) => P (CmpI o p q) a where
-  type PP (CmpI o p q) a = Bool
-  eval _ opts a = do
-    let (sfn, fn) = getOrd @o
-    lr <- runPQ sfn (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let b = on fn (map toLower) p q
-        in mkNodeB opts b ["CmpI " <> p <> " " <> sfn <> " " <> q] [hh pp, hh qq]
-
-
--- | similar to 'Control.Lens.itoList'
---
--- >>> pl @(IToList _) ("aBc" :: String)
--- Present [(0,'a'),(1,'B'),(2,'c')]
--- PresentT [(0,'a'),(1,'B'),(2,'c')]
---
-data IToList' t p
-type IToList (t :: Type) = IToList' (Hole t) Id
-
-instance (Show x
-        , P p x
-        , Typeable (PP t (PP p x))
-        , Show (PP t (PP p x))
-        , FoldableWithIndex (PP t (PP p x)) f
-        , PP p x ~ f a
-        , Show a
-        ) => P (IToList' t p) x where
-  type PP (IToList' t p) x = [(PP t (PP p x), ExtractAFromTA (PP p x))]
-  eval _ opts x = do
-    let msg0 = "IToList"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = itoList p
-            t = showT @(PP t (PP p x))
-        in mkNode opts (PresentT b) [msg0 <> "(" <> t <> ")" <> show0 opts " " b <> show1 opts " | " x] [hh pp]
-
--- | similar to 'toList'
---
--- >>> pl @ToList ("aBc" :: String)
--- Present "aBc"
--- PresentT "aBc"
---
--- >>> pl @ToList (Just 14)
--- Present [14]
--- PresentT [14]
---
--- >>> pl @ToList Nothing
--- Present []
--- PresentT []
---
--- >>> pl @ToList (Left "xx")
--- Present []
--- PresentT []
---
--- >>> pl @ToList (These 12 "xx")
--- Present ["xx"]
--- PresentT ["xx"]
---
-data ToList
-instance (Show (t a)
-        , Foldable t
-        , Show a
-        ) => P ToList (t a) where
-  type PP ToList (t a) = [a]
-  eval _ opts as =
-    let msg0 = "ToList"
-        z = toList as
-    in pure $ mkNode opts (PresentT z) [show01 opts msg0 z as] []
-
--- | similar to 'toList'
---
--- >>> pl @(ToList' Id) ("aBc" :: String)
--- Present "aBc"
--- PresentT "aBc"
---
--- >>> pl @(ToList' Id) (Just 14)
--- Present [14]
--- PresentT [14]
---
--- >>> pl @(ToList' Id) Nothing
--- Present []
--- PresentT []
---
--- >>> pl @(ToList' Id) (Left "xx")
--- Present []
--- PresentT []
---
--- >>> pl @(ToList' Id) (These 12 "xx")
--- Present ["xx"]
--- PresentT ["xx"]
---
-data ToList' p
-
-instance (PP p x ~ t a
-        , P p x
-        , Show (t a)
-        , Foldable t
-        , Show a
-        ) => P (ToList' p) x where
-  type PP (ToList' p) x = [ExtractAFromTA (PP p x)] -- extra layer of indirection means pe (ToList' Id) "abc" won't work without setting the type of "abc" unlike ToList
-  eval _ opts x = do
-    let msg0 = "ToList'"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = toList p
-        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
-
--- | invokes 'GE.toList'
---
--- >>> pl @ToListExt (M.fromList [(1,'x'),(4,'y')])
--- Present [(1,'x'),(4,'y')]
--- PresentT [(1,'x'),(4,'y')]
---
--- >>> pl @ToListExt (T.pack "abc")
--- Present "abc"
--- PresentT "abc"
---
-data ToListExt
-
-instance (Show l
-        , GE.IsList l
-        , Show (GE.Item l)
-        ) => P ToListExt l where
-  type PP ToListExt l = [GE.Item l]
-  eval _ opts as =
-    let msg0 = "ToListExt"
-        z = GE.toList as
-    in pure $ mkNode opts (PresentT z) [show01 opts msg0 z as] []
-
-data FromList (t :: Type) -- doesnt work with OverloadedLists unless you cast to [a] explicitly
-
-instance (a ~ GE.Item t
-        , Show t
-        , GE.IsList t
-        ) => P (FromList t) [a] where
-  type PP (FromList t) [a] = t
-  eval _ opts as =
-    let msg0 = "FromList"
-        z = GE.fromList (as :: [GE.Item t]) :: t
-    in pure $ mkNode opts (PresentT z) [msg0 <> show0 opts " " z] []
-
--- | invokes 'GE.fromList'
---
--- requires the OverloadedLists extension
---
--- >>> :set -XOverloadedLists
--- >>> pl @(FromListExt (M.Map _ _)) [(4,"x"),(5,"dd")]
--- Present fromList [(4,"x"),(5,"dd")]
--- PresentT (fromList [(4,"x"),(5,"dd")])
---
-data FromListExt (t :: Type)
--- l ~ l' is key
-instance (Show l
-        , GE.IsList l
-        , l ~ l'
-        ) => P (FromListExt l') l where
-  type PP (FromListExt l') l = l'
-  eval _ opts as =
-    let msg0 = "FromListExt"
-        z = GE.fromList (GE.toList @l as)
-    in pure $ mkNode opts (PresentT z) [msg0 <> show0 opts " " z] []
-
--- | predicate on 'These'
---
--- >>> pl @(IsThis Id) (This "aBc")
--- True
--- TrueT
---
--- >>> pl @(IsThis Id) (These 1 'a')
--- False
--- FalseT
---
--- >>> pl @(IsThese Id) (These 1 'a')
--- True
--- TrueT
---
-data IsTh (th :: These x y) p -- x y can be anything
-
-type IsThis p = IsTh ('This '()) p
-type IsThat p = IsTh ('That '()) p
-type IsThese p = IsTh ('These '() '()) p
-
--- trying to avoid show instance cos of ambiguities
-instance (PP p x ~ These a b
-        , P p x
-        , Show a
-        , Show b
-        , GetThese th
-        ) => P (IsTh (th :: These x1 x2) p) x where
-  type PP (IsTh th p) x = Bool
-  eval _ opts x = do
-    let msg0 = "IsTh"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let (t,f) = getThese (Proxy @th)
-            b = f p
-        in mkNodeB opts b [msg0 <> " " <> t <> show1 opts " | " p] []
-
--- | similar to 'these'
---
--- >>> pl @(TheseIn Id Len (Fst Id + Length (Snd Id))) (This 13)
--- Present 13
--- PresentT 13
---
--- >>> pl @(TheseIn Id Len (Fst Id + Length (Snd Id))) (That "this is a long string")
--- Present 21
--- PresentT 21
---
--- >>> pl @(TheseIn Id Len (Fst Id + Length (Snd Id))) (These 20 "somedata")
--- Present 28
--- PresentT 28
---
--- >>> pl @(TheseIn (MkLeftAlt _ Id) (MkRightAlt _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (That "this is a long string")
--- Present Right "this is a long string"
--- PresentT (Right "this is a long string")
---
--- >>> pl @(TheseIn (MkLeftAlt _ Id) (MkRightAlt _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (These 1 "this is a long string")
--- Present Right "this is a long string"
--- PresentT (Right "this is a long string")
---
--- >>> pl @(TheseIn (MkLeftAlt _ Id) (MkRightAlt _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (These 100 "this is a long string")
--- Present Left 100
--- PresentT (Left 100)
---
-data TheseIn p q r
-type TheseId p q = TheseIn '(I, p) '(q, I) I
-
-instance (Show a
-        , Show b
-        , Show (PP p a)
-        , P p a
-        , P q b
-        , P r (a,b)
-        , PP p a ~ PP q b
-        , PP p a ~ PP r (a,b)
-        , PP q b ~ PP r (a,b)
-         )  => P (TheseIn p q r) (These a b) where
-  type PP (TheseIn p q r) (These a b) = PP p a
-  eval _ opts =
-     \case
-        This a -> do
-          let msg0 = "This"
-          pp <- eval (Proxy @p) opts a
-          pure $ case getValueLR opts (msg0 <> " p failed") pp [] of
-               Left e -> e
-               Right c -> mkNode opts (PresentT c) [show01' opts msg0 c "This " a] [hh pp]
-        That b -> do
-          let msg0 = "That"
-          qq <- eval (Proxy @q) opts b
-          pure $ case getValueLR opts (msg0 <> " q failed") qq [] of
-               Left e -> e
-               Right c -> mkNode opts (PresentT c) [show01' opts msg0 c "That " b] [hh qq]
-        These a b -> do
-          let msg0 = "TheseIn"
-          rr <- eval (Proxy @r) opts (a,b)
-          pure $ case getValueLR opts (msg0 <> " r failed") rr [] of
-               Left e -> e
-               Right c -> mkNode opts (PresentT c) [show01 opts msg0 c (These a b)] [hh rr]
-
--- | creates an empty list of the given type
---
--- >>> pl @(Id :+ EmptyList _) 99
--- Present [99]
--- PresentT [99]
---
-data EmptyList' t
-type EmptyList (t :: Type) = EmptyList' (Hole t)
-
-instance P (EmptyList' t) x where
-  type PP (EmptyList' t) x = [PP t x]
-  eval _ opts _ =
-    pure $ mkNode opts (PresentT []) ["EmptyList"] []
-
--- | creates a singleton from a value
---
--- >>> pl @(Singleton (Char1 "aBc")) ()
--- Present "a"
--- PresentT "a"
---
--- >>> pl @(Singleton Id) False
--- Present [False]
--- PresentT [False]
---
--- >>> pl @(Singleton (Snd Id)) (False,"hello")
--- Present ["hello"]
--- PresentT ["hello"]
---
-type Singleton p = p :+ EmptyT [] p
-
--- | extracts the first character from a non empty 'Symbol'
---
--- >>> pl @(Char1 "aBc") ()
--- Present 'a'
--- PresentT 'a'
---
-data Char1 (s :: Symbol)  -- gets the first char from the Symbol [requires that Symbol is not empty]
-instance (KnownSymbol s, NullT s ~ 'False) => P (Char1 s) a where
-  type PP (Char1 s) a = Char
-  eval _ opts _ =
-     let c = head $ symb @s
-     in pure $ mkNode opts (PresentT c) ["Char1" <> show0 opts " " c] []
-
--- | similar to 'Data.Align.align' thats pads with 'Data.These.This' or 'Data.These.That' if one list is shorter than the other
---
--- the key is that all information about both lists are preserved
---
--- >>> pl @(ZipThese (Fst Id) (Snd Id)) ("aBc", [1..5])
--- Present [These 'a' 1,These 'B' 2,These 'c' 3,That 4,That 5]
--- PresentT [These 'a' 1,These 'B' 2,These 'c' 3,That 4,That 5]
---
--- >>> pl @(ZipThese (Fst Id) (Snd Id)) ("aBcDeF", [1..3])
--- Present [These 'a' 1,These 'B' 2,These 'c' 3,This 'D',This 'e',This 'F']
--- PresentT [These 'a' 1,These 'B' 2,These 'c' 3,This 'D',This 'e',This 'F']
---
--- >>> pl @(ZipThese Id Reverse) "aBcDeF"
--- Present [These 'a' 'F',These 'B' 'e',These 'c' 'D',These 'D' 'c',These 'e' 'B',These 'F' 'a']
--- PresentT [These 'a' 'F',These 'B' 'e',These 'c' 'D',These 'D' 'c',These 'e' 'B',These 'F' 'a']
---
--- >>> pl @(ZipThese Id '[]) "aBcDeF"
--- Present [This 'a',This 'B',This 'c',This 'D',This 'e',This 'F']
--- PresentT [This 'a',This 'B',This 'c',This 'D',This 'e',This 'F']
---
--- >>> pl @(ZipThese '[] Id) "aBcDeF"
--- Present [That 'a',That 'B',That 'c',That 'D',That 'e',That 'F']
--- PresentT [That 'a',That 'B',That 'c',That 'D',That 'e',That 'F']
---
-data ZipThese p q
-
-instance (PP p a ~ [x]
-        , PP q a ~ [y]
-        , P p a
-        , P q a
-        , Show x
-        , Show y
-        ) => P (ZipThese p q) a where
-  type PP (ZipThese p q) a = [These (ExtractAFromList (PP p a)) (ExtractAFromList (PP q a))]
-  eval _ opts a = do
-    let msg0 = "ZipThese"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = simpleAlign p q
-        in mkNode opts (PresentT d) [show01' opts msg0 d "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
-
-simpleAlign :: [a] -> [b] -> [These a b]
-simpleAlign as [] = map This as
-simpleAlign [] bs = map That bs
-simpleAlign (a:as) (b:bs) = These a b : simpleAlign as bs
-
-type family ExtractAFromTA (ta :: Type) :: Type where
-  ExtractAFromTA (t a) = a
-  ExtractAFromTA z = GL.TypeError (
-      'GL.Text "ExtractAFromTA: expected (t a) but found something else"
-      ':$$: 'GL.Text "t a = "
-      ':<>: 'GL.ShowType z)
-
--- todo: get ExtractAFromList error to fire if wrong Type
--- | extract \'a\' from \'[a]\' which I need for type PP
-type family ExtractAFromList (as :: Type) :: Type where
-  ExtractAFromList [a] = a
-  ExtractAFromList z = GL.TypeError (
-      'GL.Text "ExtractAFromList: expected [a] but found something else"
-      ':$$: 'GL.Text "as = "
-      ':<>: 'GL.ShowType z)
-
-
--- | Zip two lists optionally cycling the one of the lists to match the size
---
--- >>> pl @(ZipL (Fst Id) (Snd Id)) ("abc", [1..5])
--- Present [('a',1),('b',2),('c',3),('a',4),('b',5)]
--- PresentT [('a',1),('b',2),('c',3),('a',4),('b',5)]
---
--- >>> pl @(ZipL (Fst Id) (Snd Id)) ("abcdefg", [1..5])
--- Present [('a',1),('b',2),('c',3),('d',4),('e',5)]
--- PresentT [('a',1),('b',2),('c',3),('d',4),('e',5)]
---
--- >>> pl @(ZipR (Fst Id) (Snd Id)) ("abcdefg", [1..5])
--- Present [('a',1),('b',2),('c',3),('d',4),('e',5),('f',1),('g',2)]
--- PresentT [('a',1),('b',2),('c',3),('d',4),('e',5),('f',1),('g',2)]
---
-data Zip (lc :: Bool) (rc :: Bool) p q
-type ZipL p q = Zip 'True 'False p q
-type ZipR p q = Zip 'False 'True p q
-type ZipTrunc p q = Zip 'False 'False p q
---type ZipWith r p q = ZipTrunc p q >> Map r Id
-
-instance (FailIfT (AndT lc rc) ()
-           ('GL.Text "Zip': left and right cannot both be True")
-        , GetBool lc
-        , GetBool rc
-        , PP p a ~ [x]
-        , PP q a ~ [y]
-        , P p a
-        , P q a
-        , Show x
-        , Show y
-        ) => P (Zip lc rc p q) a where
-  type PP (Zip lc rc p q) a = [(ExtractAFromList (PP p a), ExtractAFromList (PP q a))]
-  eval _ opts a = do
-    let msg0 = "Zip" <> cyc
-        lc = getBool @lc
-        rc = getBool @rc
-        cyc = case (lc,rc) of
-               (True,False) -> "L"
-               (False,True) -> "R"
-               _ -> ""
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = case (lc,rc) of
-                  (True,False) -> zip (take (length q) (cycle p)) q
-                  (False,True) -> zip p (take (length p) (cycle q))
-                  _ -> zip p q
-        in mkNode opts (PresentT d) [show01' opts msg0 d "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
-
--- | Luhn predicate check on last digit
---
--- >>> pl @(Luhn Id) [1,2,3,0]
--- True
--- TrueT
---
--- >>> pl @(Luhn Id) [1,2,3,4]
--- False
--- FalseT
---
--- >>> pl @(GuardSimple (Luhn Id)) [15,4,3,1,99]
--- Error Luhn map=[90,2,3,8,6] sum=109 ret=9 | [15,4,3,1,99]
--- FailT "Luhn map=[90,2,3,8,6] sum=109 ret=9 | [15,4,3,1,99]"
---
-data Luhn p
-
-instance (PP p x ~ [Int]
-        , P p x
-        ) => P (Luhn p) x where
-  type PP (Luhn p) x = Bool
-  eval _ opts x = do
-    let msg0 = "Luhn"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let xs = zipWith (*) (reverse p) (cycle [1,2])
-            ys = map (\w -> if w>=10 then w-9 else w) xs
-            z = sum ys
-            ret = z `mod` 10
-            hhs = [hh pp]
-        in if ret == 0 then mkNodeB opts True [msg0 <> show0 opts " | " p] hhs
-           else mkNodeB opts False [msg0 <> " map=" <> show ys <> " sum=" <> show z <> " ret=" <> show ret <> show1 opts " | " p] hhs
-
--- | Read a number using base 2 through a maximum of 36
---
--- >>> pl @(ReadBase Int 16) "00feD"
--- Present 4077
--- PresentT 4077
---
--- >>> pl @(ReadBase Int 16) "-ff"
--- Present -255
--- PresentT (-255)
---
--- >>> pl @(ReadBase Int 2) "10010011"
--- Present 147
--- PresentT 147
---
--- >>> pl @(ReadBase Int 8) "Abff"
--- Error invalid base 8
--- FailT "invalid base 8"
---
--- supports negative numbers unlike readInt
-data ReadBase' t (n :: Nat) p
-type ReadBase (t :: Type) (n :: Nat) = ReadBase' (Hole t) n Id
-type ReadBaseInt (n :: Nat) = ReadBase' (Hole Int) n Id
-
-instance (Typeable (PP t x)
-        , BetweenT 2 36 n
-        , Show (PP t x)
-        , Num (PP t x)
-        , KnownNat n
-        , PP p x ~ String
-        , P p x
-        ) => 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
-        msg0 = "ReadBase(" <> t <> "," <> show n <> ")"
-        t = showT @(PP t x)
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let (ff,p1) = case p of
-                        '-':q -> (negate,q)
-                        _ -> (id,p)
-        in case readInt (fromIntegral n)
-            ((`elem` xs) . toLower)
-            (fromJust . (`elemIndex` xs) . toLower)
-            p1 of
-             [(b,"")] -> mkNode opts (PresentT (ff b)) [msg0 <> show0 opts " " (ff b) <> show1 opts " | " p] [hh pp]
-             o -> mkNode opts (FailT ("invalid base " <> show n)) [msg0 <> " as=" <> p <> " err=" <> show o] [hh pp]
-
-getValidBase :: Int -> String
-getValidBase n =
-  let xs = ['0'..'9'] <> ['a'..'z']
-      len = length xs
-  in if n > len || n < 2 then error $ "oops invalid base valid is 2 thru " ++ show len ++ " found " ++ show n
-     else take n xs
-
--- | Display a number at base 2 to 36, similar to 'showIntAtBase' but supports signed numbers
---
--- >>> pl @(ShowBase 16) 4077
--- Present "fed"
--- PresentT "fed"
---
--- >>> pl @(ShowBase 16) (-255)
--- Present "-ff"
--- PresentT "-ff"
---
--- >>> pl @(ShowBase 2) 147
--- Present "10010011"
--- PresentT "10010011"
---
--- >>> pl @(ShowBase' 2 (Negate 147)) "whatever"
--- Present "-10010011"
--- PresentT "-10010011"
---
-data ShowBase' (n :: Nat) p
-type ShowBase (n :: Nat) = ShowBase' n Id
-
-instance (PP p x ~ a
-        , P p x
-        , Show a
-        , 2 GL.<= n
-        , n GL.<= 36
-        , KnownNat n
-        , Integral a
-        ) => P (ShowBase' n p) x where
-  type PP (ShowBase' n p) x = String
-  eval _ opts x = do
-    let n = nat @n
-        xs = getValidBase n
-        msg0 = "ShowBase " <> show n
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let (ff,a') = if p < 0 then (('-':), abs p) else (id,p)
-            b = showIntAtBase (fromIntegral n) (xs !!) a' ""
-        in mkNode opts (PresentT (ff b)) [msg0 <> showLit0 opts " " (ff b) <> show1 opts " | " p] []
-
--- | intercalate two lists
---
--- >>> pl @(Intercalate '["aB"] '["xxxx","yz","z","www","xyz"]) ()
--- Present ["xxxx","aB","yz","aB","z","aB","www","aB","xyz"]
--- PresentT ["xxxx","aB","yz","aB","z","aB","www","aB","xyz"]
---
--- >>> pl @(Intercalate '[W 99,Negate 98] Id) [1..5]
--- Present [1,99,-98,2,99,-98,3,99,-98,4,99,-98,5]
--- PresentT [1,99,-98,2,99,-98,3,99,-98,4,99,-98,5]
---
--- >>> pl @(Intercalate '[99,100] Id) [1..5]
--- Present [1,99,100,2,99,100,3,99,100,4,99,100,5]
---PresentT [1,99,100,2,99,100,3,99,100,4,99,100,5]
---
-data Intercalate p q
-
-instance (PP p x ~ [a]
-        , PP q x ~ PP p x
-        , P p x
-        , P q x
-        , Show a
-      ) => P (Intercalate p q) x where
-  type PP (Intercalate p q) x = PP p x
-  eval _ opts x = do
-    let msg0 = "Intercalate"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = intercalate p (map (:[]) q)
-        in mkNode opts (PresentT d) [show01 opts msg0 d p <> show1 opts " | " q] [hh pp, hh qq]
-
--- | uses Printf to format output
---
--- >>> pl @(Printf "value=%03d" Id) 12
--- Present "value=012"
--- PresentT "value=012"
---
--- >>> pl @(Printf "%s" (Fst Id)) ("abc",'x')
--- Present "abc"
--- PresentT "abc"
---
--- >>> pl @(Printf "%d" (Fst Id)) ("abc",'x')
--- Error Printf (IO e=printf: bad formatting char 'd')
--- FailT "Printf (IO e=printf: bad formatting char 'd')"
---
-data Printf s p
-
-instance (PrintfArg (PP p x)
-        , Show (PP p x)
-        , PP s x ~ String
-        , P s x
-        , P p x
-        ) => P (Printf s p) x where
-  type PP (Printf s p) x = String
-  eval _ opts x = do
-    let msg0 = "Printf"
-    lrx <- runPQ msg0 (Proxy @s) (Proxy @p) opts x
-    case lrx of
-      Left e -> pure e
-      Right (s,p,ss,pp) -> do
-        let msg1 = msg0
-        lr <- catchitNF @_ @E.SomeException (printf s p)
-        pure $ case lr of
-          Left e -> mkNode opts (FailT (msg1 <> " (" <> e <> ")")) [msg1 <> show0 opts " " p <> " s=" <> s] [hh ss, hh pp]
-          Right ret -> mkNode opts (PresentT ret) [msg1 <> " [" <> showLit0 opts "" ret <> "]" <> show1 opts " | p=" p <> showLit1 opts " | s=" s] [hh ss, hh pp]
-
-type family GuardsT (ps :: [k]) where
-  GuardsT '[] = '[]
-  GuardsT (p ': ps) = Guard' p ': GuardsT ps
-
-type Guards' (ps :: [k]) = Para (GuardsT ps)
-
-type ToGuards (prt :: k) (os :: [k1]) = Proxy (Guards (ToGuardsT prt os))
-
-type family ToGuardsT (prt :: k) (os :: [k1]) :: [(k,k1)] where
-  ToGuardsT prt '[] = GL.TypeError ('GL.Text "ToGuardsT cannot be empty")
-  ToGuardsT prt '[p] = '(prt,p) : '[]
-  ToGuardsT prt (p ': ps) = '(prt,p) ': ToGuardsT prt ps
-
--- | runs values in parallel unlike 'Do' which is serial
---
--- >>> pl @(Para '[Id,Id + 1,Id * 4]) [10,20,30]
--- Present [10,21,120]
--- PresentT [10,21,120]
---
--- >>> pl @(Para '[Id,Id + 1,Id * 4]) [10,20,30,40]
--- Error Para: data elements(4) /= predicates(3)
--- FailT "Para: data elements(4) /= predicates(3)"
---
--- >>> pl @(ParaLax '[Id,Id + 1,Id * 4]) [10,20,30,40,50,20,1]
--- Present [10,21,120]
--- PresentT [10,21,120]
---
--- >>> pl @(ParaLax '[Id,Id + 1,Id * 4,Id]) [10,20,30]
--- Present [10,21,120]
--- PresentT [10,21,120]
---
-data ParaImpl (n :: Nat) (strict :: Bool) (os :: [k])
-type Para (os :: [k]) = ParaImplW 'True os
-type ParaLax (os :: [k]) = ParaImplW 'False os
-type ToPara (os :: [k]) = Proxy (ParaImplW 'True os)
-
-data ParaImplW (strict :: Bool) (ps :: [k])
-
--- passthru but adds the length of ps (replaces LenT in the type synonym to avoid type synonyms being expanded out
-instance (GetBool strict, GetLen ps, P (ParaImpl (LenT ps) strict ps) [a]) => P (ParaImplW strict ps) [a] where
-  type PP (ParaImplW strict ps) [a] = PP (ParaImpl (LenT ps) strict ps) [a]
-  eval _ opts as = do
-    let strict = getBool @strict
-        msgbase0 = "Para" <> strictmsg @strict
-        n = getLen @ps
-    if strict && n /= length as then
-       let xx = msgbase0 <> ": data elements(" <> show (length as) <> ") /= predicates(" <> show n <> ")"
-       in pure $ mkNode opts (FailT xx) [xx] []
-    else eval (Proxy @(ParaImpl (LenT ps) strict ps)) opts as
-
--- only allow non empty lists
-instance GL.TypeError ('GL.Text "ParaImpl '[] invalid: requires at least one value in the list")
-   => P (ParaImpl n strict ('[] :: [k])) [a] where
-  type PP (ParaImpl n strict ('[] :: [k])) [a] = Void
-  eval _ _ _ = error "should not get this far"
-
-instance (Show (PP p a)
-        , KnownNat n
-        , GetBool strict
-        , Show a
-        , P p a
-        ) => P (ParaImpl n strict '[p]) [a] where
-  type PP (ParaImpl n strict '[p]) [a] = [PP p a]
-  eval _ opts as' = do
-    let strict = getBool @strict
-        msgbase0 = "Para" <> strictmsg @strict
-        msgbase1 = msgbase0 <> "(" <> show n <> ")"
-        n :: Int
-        n = nat @n
-    case as' of
-      [] -> pure $ mkNode opts (PresentT mempty) [msgbase1 <> " (ran out of data!!)"] []
-      a:as -> do
-        pp <- eval (Proxy @p) opts a
-        pure $ case getValueLR opts msgbase1 pp [] of
-          Left e -> e
-          -- show1 opts " " [b]  fails but using 'b' is ok and (b : []) also works!
-          -- GE.List error
-          Right b -> mkNode opts (PresentT [b]) [msgbase1 <> (if null as then " done!" else " Truncated") <> show0 opts " " (b : []) <> show1 opts " | " a <> (if strict then "" else show1 opts " | leftovers=" as)] [hh pp]
-
-instance (KnownNat n
-        , GetBool strict
-        , GetLen ps
-        , P p a
-        , P (ParaImpl n strict (p1 ': ps)) [a]
-        , PP (ParaImpl n strict (p1 ': ps)) [a] ~ [PP p a]
-        , Show a
-        , Show (PP p a)
-        )
-     => P (ParaImpl n strict (p ': p1 ': ps)) [a] where
-  type PP (ParaImpl n strict (p ': p1 ': ps)) [a] = [PP p a]
-  eval _ opts as' = do
-     let msgbase0 = msgbase2 <> "(" <> show (n-pos) <> " of " <> show n <> ")"
-         msgbase1 = msgbase2 <> "(" <> show (n-pos) <> ")"
-         msgbase2 = "Para" <> strictmsg @strict
-         n = nat @n
-         pos = 1 + getLen @ps -- cos p1!
-     case as' of
-       [] -> pure $ mkNode opts (PresentT mempty) [msgbase0 <> " (ran out of data!!)"] []
-       a:as -> do
-         pp <- eval (Proxy @p) opts a
-         case getValueLR opts msgbase0 pp [] of
-           Left e -> pure e
-           Right b -> do
-                        qq <- eval (Proxy @(ParaImpl n strict (p1 ': ps))) opts as
-                        pure $ case getValueLRHide opts (msgbase1 <> " rhs failed " <> show b) qq [hh pp] of
-                          Left e -> e
-                          Right bs -> mkNode opts (PresentT (b:bs)) [msgbase1 <> show0 opts " " (b:bs) <> show1 opts " | " as'] [hh pp, hh qq]
-
--- | leverages 'Para' for repeating predicates (passthrough method)
---
--- >>> pl @(ParaNImpl 'True 4 (Succ Id)) [1..4]
--- Present [2,3,4,5]
--- PresentT [2,3,4,5]
---
--- >>> pl @(ParaNLax 4 (Succ Id)) "azwxm"
--- Present "b{xy"
--- PresentT "b{xy"
---
--- >>> pl @(ParaN 4 (Succ Id)) "azwxm"
--- Error Para: data elements(5) /= predicates(4)
--- FailT "Para: data elements(5) /= predicates(4)"
---
--- >>> pl @(ParaN 4 (Succ Id)) "azwx"
--- Present "b{xy"
--- PresentT "b{xy"
---
--- >>> pl @(ParaNLax 4 (FromEnum Id)) "azwxs"
--- Present [97,122,119,120]
--- PresentT [97,122,119,120]
---
-data ParaNImpl (strict :: Bool) (n :: Nat) p
-type ParaN (n :: Nat) p = ParaNImpl 'True n p
-type ParaNLax (n :: Nat) p = ParaNImpl 'False n p
-
-instance ( P (ParaImpl (LenT (RepeatT n p)) strict (RepeatT n p)) [a]
-         , GetLen (RepeatT n p)
-         , GetBool strict
-         ) => P (ParaNImpl strict n p) [a] where
-  type PP (ParaNImpl strict n p) [a] = PP (ParaImplW strict (RepeatT n p)) [a]
-  eval _ opts as =
-    eval (Proxy @(ParaImplW strict (RepeatT n p))) opts as
-
--- | tries each predicate ps and on the first match runs the corresponding qs but if there is no match on ps then runs the fail case e
---
--- >>> pl @(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) 50
--- Present "50 is same50"
--- PresentT "50 is same50"
---
--- >>> pl @(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) 9
--- Present "9 is lt10"
--- PresentT "9 is lt10"
---
--- >>> pl @(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) 3
--- Present "3 is lt4"
--- PresentT "3 is lt4"
---
--- >>> pl @(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
--- Error asdf
--- FailT "asdf"
---
-data CaseImpl (n :: Nat) (e :: k0) (ps :: [k]) (qs :: [k1]) (r :: k2)
--- ps = conditions
--- qs = what to do [one to one
--- r = the value
--- e = otherwise  -- leave til later
-data Case (e :: k0) (ps :: [k]) (qs :: [k1]) (r :: k2)
-type Case' (ps :: [k]) (qs :: [k1]) (r :: k2) = Case (Snd Id >> Failp "Case:no match") ps qs r
-type Case'' s (ps :: [k]) (qs :: [k1]) (r :: k2) = Case (FailCase s) ps qs r -- eg s= Printf "%s" (ShowP Id)
-
-type FailCase p = Fail (Snd Id >> Unproxy) (Fst Id >> p)
-
--- passthru but adds the length of ps (replaces LenT in the type synonym to avoid type synonyms being expanded out
-instance (FailIfT (NotT (LenT ps DE.== LenT qs)) ((LenT ps DE.== LenT qs) ~ 'True)
-                  ('GL.Text "lengths are not the same "
-                   ':<>: 'GL.ShowType (LenT ps)
-                   ':<>: 'GL.Text " vs "
-                   ':<>: 'GL.ShowType (LenT qs))
-        , P (CaseImpl (LenT ps) e ps qs r) x
-        ) => P (Case e ps qs r) x where
-  type PP (Case e ps qs r) x = PP (CaseImpl (LenT ps) e ps qs r) x
-  eval _ = eval (Proxy @(CaseImpl (LenT ps) e ps qs r))
-
--- only allow non empty lists!
-instance (GL.TypeError ('GL.Text "CaseImpl '[] invalid: lhs requires at least one value in the list"))
-   => P (CaseImpl n e ('[] :: [k]) (q ': qs) r) x where
-  type PP (CaseImpl n e ('[] :: [k]) (q ': qs) r) x = Void
-  eval _ _ _ = error "should not get this far"
-
-instance (GL.TypeError ('GL.Text "CaseImpl '[] invalid: rhs requires at least one value in the list"))
-   => P (CaseImpl n e (p ': ps) ('[] :: [k1]) r) x where
-  type PP (CaseImpl n e (p ': ps) ('[] :: [k1]) r) x = Void
-  eval _ _ _ = error "should not get this far"
-
-instance (GL.TypeError ('GL.Text "CaseImpl '[] invalid: lists are both empty"))
-   => P (CaseImpl n e ('[] :: [k]) ('[] :: [k1]) r) x where
-  type PP (CaseImpl n e ('[] :: [k]) ('[] :: [k1]) r) x = Void
-  eval _ _ _ = error "should not get this far"
-
-instance (P r x
-        , P q (PP r x)
-        , Show (PP q (PP r x))
-        , P p (PP r x)
-        , PP p (PP r x) ~ Bool
-        , KnownNat n
-        , Show (PP r x)
-        , P e (PP r x, Proxy (PP q (PP r x)))
-        , PP e (PP r x, Proxy (PP q (PP r x))) ~ PP q (PP r x)
-        ) => P (CaseImpl n e '[p] '[q] r) x where
-  type PP (CaseImpl n e '[p] '[q] r) x = PP q (PP r x)
-  eval _ opts z = do
-    let msgbase0 = "Case" <> "(" <> show n <> ")"
-        n :: Int = nat @n
-    rr <- eval (Proxy @r) opts z
-    case getValueLR opts msgbase0 rr [] of
-      Left e -> pure e
-      Right a -> do
-        pp <- evalBool (Proxy @p) opts a
-        case getValueLR opts msgbase0 pp [hh rr] of
-          Left e -> pure e
-          Right True -> do
-            qq <- eval (Proxy @q) opts a
-            pure $ case getValueLR opts msgbase0 qq [hh rr, hh pp] of
-              Left e -> e
-              Right b -> mkNode opts (PresentT b) [show01 opts msgbase0 b a] [hh rr, hh pp, hh qq]
-          Right False -> do
-            ee <- eval (Proxy @e) opts (a, Proxy @(PP q (PP r x)))
-            pure $ case getValueLR opts (msgbase0 <> "  otherwise failed") ee [hh rr, hh pp] of
-              Left e -> e
-              Right b -> mkNode opts (PresentT b) [show01 opts msgbase0 b a] [hh rr, hh pp, hh ee]
-
-instance (KnownNat n
-        , GetLen ps
-        , P r x
-        , P p (PP r x)
-        , P q (PP r x)
-        , PP p (PP r x) ~ Bool
-        , Show (PP q (PP r x))
-        , Show (PP r x)
-        , P (CaseImpl n e (p1 ': ps) (q1 ': qs) r) x
-        , PP (CaseImpl n e (p1 ': ps) (q1 ': qs) r) x ~ PP q (PP r x)
-        )
-     => P (CaseImpl n e (p ': p1 ': ps) (q ': q1 ': qs) r) x where
-  type PP (CaseImpl n e (p ': p1 ': ps) (q ': q1 ': qs) r) x = PP q (PP r x)
-  eval _ opts z = do
-    let msgbase0 = msgbase2 <> "(" <> show (n-pos) <> " of " <> show n <> ")"
-        msgbase1 = msgbase2 <> "(" <> show (n-pos) <> ")"
-        msgbase2 = "Case"
-        n = nat @n
-        pos = 1 + getLen @ps -- cos p1!
-    rr <- eval (Proxy @r) opts z
-    case getValueLR opts msgbase0 rr [] of
-      Left e -> pure e
-      Right a -> do
-        pp <- evalBool (Proxy @p) opts a
-        case getValueLR opts msgbase0 pp [hh rr] of
-          Left e -> pure e
-          Right True -> do
-            qq <- eval (Proxy @q) opts a
-            pure $ case getValueLR opts msgbase0 qq [hh rr] of
-              Left e -> e
-              Right b -> mkNode opts (PresentT b) [show01 opts msgbase0 b a] [hh rr, hh pp, hh qq]
-          Right False -> do
-            ww <- eval (Proxy @(CaseImpl n e (p1 ': ps) (q1 ': qs) r)) opts z
-            pure $ case getValueLR opts (msgbase1 <> " failed rhs") ww [hh rr, hh pp] of
-              Left e -> e
-              Right b -> mkNode opts (PresentT b) [show01 opts msgbase1 b a] [hh rr, hh pp, hh ww]
-
--- | similar to 'sequenceA'
---
--- >>> pl @Sequence [Just 10, Just 20, Just 30]
--- Present Just [10,20,30]
--- PresentT (Just [10,20,30])
---
--- >>> pl @Sequence [Just 10, Just 20, Just 30, Nothing, Just 40]
--- Present Nothing
--- PresentT Nothing
---
-data Sequence
-type Traverse p q = Map p q >> Sequence
-
-
-instance (Show (f (t a))
-        , Show (t (f a))
-        , Traversable t
-        , Applicative f
-        ) => P Sequence (t (f a)) where
-  type PP Sequence (t (f a)) = f (t a)
-  eval _ opts tfa =
-     let d = sequenceA tfa
-     in pure $ mkNode opts (PresentT d) ["Sequence" <> show0 opts " " d <> show1 opts " | " tfa] []
-
-data Hide p
-type H = Hide
--- 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
-  eval _ opts x = do
-      tt <- eval (Proxy @(Msg "!" p)) opts x
-      pure $ tt & tForest .~ []
-
--- | similar to 'readFile'
---
--- >>> pl @(ReadFile ".ghci" >> 'Just Id >> Len >> Gt 0) ()
--- True
--- TrueT
---
--- >>> pl @(FileExists "xyzzy") ()
--- False
--- FalseT
---
-data ReadFile p
-type FileExists p = ReadFile p >> IsJust
-
-instance (PP p x ~ String, P p x) => P (ReadFile p) x where
-  type PP (ReadFile p) x = Maybe String
-  eval _ opts x = do
-    let msg0 = "ReadFile"
-    pp <- eval (Proxy @p) opts x
-    case getValueLR opts msg0 pp [] of
-      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
-        pure $ case mb of
-          Nothing -> mkNode opts (FailT (msg1 <> " must run in IO")) [msg1 <> " must run in IO"] []
-          Just Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " does not exist"] []
-          Just (Just b) -> mkNode opts (PresentT (Just b)) [msg1 <> " len=" <> show (length b) <> showLit0 opts " Just " b] []
-
--- | does the directory exists
---
--- >>> pl @(DirExists ".") ()
--- True
--- TrueT
---
-data ReadDir p
-type DirExists p = ReadDir p >> IsJust
-
-instance (PP p x ~ String, P p x) => P (ReadDir p) x where
-  type PP (ReadDir p) x = Maybe [FilePath]
-  eval _ opts x = do
-    let msg0 = "ReadDir"
-    pp <- eval (Proxy @p) opts x
-    case getValueLR opts msg0 pp [] of
-      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
-        pure $ case mb of
-          Nothing -> mkNode opts (FailT (msg1 <> " must run in IO")) [msg1 <> " must run in IO"] []
-          Just Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " does not exist"] []
-          Just (Just b) -> mkNode opts (PresentT (Just b)) [msg1 <> " len=" <> show (length b) <> show0 opts " Just " b] []
-
--- | does the directory exists
---
--- >>> pl @(ReadEnv "PATH" >> 'Just Id >> 'True) ()
--- True
--- TrueT
---
-data ReadEnv p
-
-instance (PP p x ~ String, P p x) => P (ReadEnv p) x where
-  type PP (ReadEnv p) x = Maybe String
-  eval _ opts x = do
-    let msg0 = "ReadEnv"
-    pp <- eval (Proxy @p) opts x
-    case getValueLR opts msg0 pp [] of
-      Left e -> pure e
-      Right p -> do
-        let msg1 = msg0 <> "[" <> p <> "]"
-        mb <- runIO $ lookupEnv p
-        pure $ case mb of
-          Nothing -> mkNode opts (FailT (msg1 <> " must run in IO")) [msg1 <> " must run in IO"] []
-          Just Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " does not exist"] []
-          Just (Just v) -> mkNode opts (PresentT (Just v)) [msg1 <> showLit0 opts " " v] []
-
-data ReadEnvAll
-
-instance P ReadEnvAll a where
-  type PP ReadEnvAll a = [(String,String)]
-  eval _ opts _ = do
-    let msg0 = "ReadEnvAll"
-    mb <- runIO $ getEnvironment
-    pure $ case mb of
-      Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] []
-      Just v -> mkNode opts (PresentT v) [msg0 <> " count=" <> show (length v)] []
-
-data TimeUtc
-
-instance P TimeUtc a where
-  type PP TimeUtc a = UTCTime
-  eval _ opts _a = do
-    let msg0 = "TimeUtc"
-    mb <- runIO $ getCurrentTime
-    pure $ case mb of
-      Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] []
-      Just v -> mkNode opts (PresentT v) [msg0 <> show0 opts " " v] []
-
-data TimeZt
-
-instance P TimeZt a where
-  type PP TimeZt a = ZonedTime
-  eval _ opts _a = do
-    let msg0 = "TimeZt"
-    mb <- runIO $ getZonedTime
-    pure $ case mb of
-      Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] []
-      Just v -> mkNode opts (PresentT v) [msg0 <> show0 opts " " v] []
-
-data FHandle s = FStdout | FStderr | FOther s WFMode deriving Show
-
-class GetFHandle (x :: FHandle Symbol) where getFHandle :: FHandle String
-instance GetFHandle 'FStdout where getFHandle = FStdout
-instance GetFHandle 'FStderr where getFHandle = FStderr
-instance (GetMode w, KnownSymbol s) => GetFHandle ('FOther s w) where getFHandle = FOther (symb @s) (getMode @w)
-
-data WFMode = WFAppend | WFWrite | WFWriteForce deriving (Show,Eq)
-
-class GetMode (x :: WFMode) where getMode :: WFMode
-instance GetMode 'WFAppend where getMode = WFAppend
-instance GetMode 'WFWriteForce where getMode = WFWriteForce
-instance GetMode 'WFWrite where getMode = WFWrite
-
-data WriteFileImpl (hh :: FHandle Symbol) p
-type AppendFile (s :: Symbol) p = WriteFileImpl ('FOther s 'WFAppend) p
-type WriteFile' (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWriteForce) p
-type WriteFile (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWrite) p
-type Stdout p = WriteFileImpl 'FStdout p
-type Stderr p = WriteFileImpl 'FStderr p
-
-instance (GetFHandle fh
-        , P p a
-        , PP p a ~ String
-        ) => P (WriteFileImpl fh p) a where
-  type PP (WriteFileImpl fh p) a = ()
-  eval _ opts a = do
-    let fh = getFHandle @fh
-        msg0 = case fh of
-                      FStdout -> "Stdout"
-                      FStderr -> "Stderr"
-                      FOther s w -> (<>("[" <> s <> "]")) $ case w of
-                         WFAppend -> "AppendFile"
-                         WFWrite -> "WriteFile"
-                         WFWriteForce -> "WriteFile'"
-    pp <- eval (Proxy @p) opts a
-    case getValueLR opts msg0 pp [] of
-      Left e -> pure e
-      Right ss -> do
-          mb <- runIO $ do
-                          case fh of
-                            FStdout -> fmap (left show) $ E.try @E.SomeException $ hPutStr stdout ss
-                            FStderr -> fmap (left show) $ 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"
-                               else do
-                                      let md = case w of
-                                             WFAppend -> AppendMode
-                                             _ -> WriteMode
-                                      fmap (left show) $ E.try @E.SomeException $ withFile s md (flip hPutStr ss)
-          pure $ case mb of
-            Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] [hh pp]
-            Just (Left e) -> mkNode opts (FailT e) [msg0 <> " " <> e] [hh pp]
-            Just (Right ()) -> mkNode opts (PresentT ()) [msg0] [hh pp]
-
-data Stdin
-
-instance P Stdin a where
-  type PP Stdin a = String
-  eval _ opts _a = do
-    let msg0 = "Stdin"
-    mb <- runIO $ do
-                      lr <- E.try $ hGetContents stdin
-                      pure $ case lr of
-                        Left (e :: E.SomeException) -> Left $ show e
-                        Right ss -> Right ss
-    pure $ case mb of
-      Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] []
-      Just (Left e) -> mkNode opts (FailT e) [msg0 <> " " <> e] []
-      Just (Right ss) -> mkNode opts (PresentT ss) [msg0 <> "[" <> showLit1 opts "" ss <> "]"] []
-
---type Just' = JustFail "expected Just" Id
---type Nothing' = Guard "expected Nothing" IsNothing
-
--- | similar to 'isInfixOf' 'isPrefixOf' 'isSuffixOf' for strings only.
---
--- The \'I\' suffixed versions work are case insensitive.
---
--- >>> pl @(IsInfixI "abc" "axAbCd") ()
--- True
--- TrueT
---
--- >>> pl @(IsPrefixI "abc" "aBcbCd") ()
--- True
--- TrueT
---
--- >>> pl @(IsPrefix "abc" "aBcbCd") ()
--- False
--- FalseT
---
--- >>> pl @(IsSuffix "bCd" "aBcbCd") ()
--- True
--- TrueT
---
-data IsFixImpl (cmp :: Ordering) (ignore :: Bool) p q
-
-type IsPrefix p q = IsFixImpl 'LT 'False p q
-type IsInfix p q = IsFixImpl 'EQ 'False p q
-type IsSuffix p q = IsFixImpl 'GT 'False p q
-
-type IsPrefixI p q = IsFixImpl 'LT 'True p q
-type IsInfixI p q = IsFixImpl 'EQ 'True p q
-type IsSuffixI p q = IsFixImpl 'GT 'True p q
-
-instance (GetBool ignore
-        , P p x
-        , P q x
-        , PP p x ~ String
-        , PP q x ~ String
-        , GetOrdering cmp
-        ) => P (IsFixImpl cmp ignore p q) x where
-  type PP (IsFixImpl cmp ignore 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) = case cmp of
-                    LT -> (isPrefixOf, "IsPrefix")
-                    EQ -> (isInfixOf, "IsInfix")
-                    GT -> (isSuffixOf, "IsSuffix")
-    pp <- eval (Proxy @p) opts x
-    case getValueLR opts msg0 pp [] of
-        Left e -> pure e
-        Right s0 -> do
-          let msg1 = msg0 <> (if ignore then "I" else "") <> "(" <> s0 <> ")"
-          qq <- eval (Proxy @q) opts x
-          pure $ case getValueLR opts (msg1 <> " q failed") qq [hh pp] of
-            Left e -> e
-            Right s1 -> mkNodeB opts (on ff lwr s0 s1) [msg1 <> showLit0 opts " " s1] [hh pp, hh qq]
-
--- | similar to 'SG.<>'
---
--- >>> pl @(Fst Id <> Snd Id) ("abc","def")
--- Present "abcdef"
--- PresentT "abcdef"
---
--- >>> pl @("abcd" <> "ef" <> Id) "ghi"
--- Present "abcdefghi"
--- PresentT "abcdefghi"
---
--- >>> pl @("abcd" <> "ef" <> Id) "ghi"
--- Present "abcdefghi"
--- PresentT "abcdefghi"
---
--- >>> pl @(Wrap (SG.Sum _) Id <> FromInteger _ 10) 13
--- Present Sum {getSum = 23}
--- PresentT (Sum {getSum = 23})
---
--- >>> pl @(Wrap (SG.Product _) Id <> FromInteger _ 10) 13
--- Present Product {getProduct = 130}
--- PresentT (Product {getProduct = 130})
---
--- >>> pl @('(FromInteger _ 10,"def") <> Id) (SG.Sum 12, "_XYZ")
--- Present (Sum {getSum = 22},"def_XYZ")
--- PresentT (Sum {getSum = 22},"def_XYZ")
---
-data p <> q
-infixr 6 <>
-type Sapa' (t :: Type) = Wrap t (Fst Id) <> Wrap t (Snd Id)
-type Sapa = Fst Id <> Snd Id
-
-instance (Semigroup (PP p x)
-        , PP p x ~ PP q x
-        , P p x
-        , Show (PP q x)
-        ,P q x
-        ) => P (p <> q) x where
-  type PP (p <> q) x = PP p x
-  eval _ opts x = do
-    let msg0 = "<>"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = p <> q
-        in mkNode opts (PresentT d) [show p <> " <> " <> show q <> " = " <> show d] [hh pp, hh qq]
-
-
--- | uses inductive tuples to replace variable arguments
---
-class PrintC x where
-  prtC :: (PrintfArg a, PrintfType r) => String -> (a,x) -> r
-instance PrintC () where
-  prtC s (a,()) = printf s a
-instance (PrintfArg a, PrintC rs) => PrintC (a,rs) where
-  prtC s (a,rs) = prtC s rs a
-
-data TupleListImpl (strict :: Bool) (n :: Nat)
-type TupleList (n :: Nat) = TupleListImpl 'True n
-type TupleListLax (n :: Nat) = TupleListImpl 'False n
-
-instance (Show a
-        , KnownNat n
-        , GetBool strict
-        , TupleListD (ToN n) a
-        , Show (TupleListT (ToN n) a)
-        ) => P (TupleListImpl strict n) [a] where
-  type PP (TupleListImpl strict n) [a] = TupleListT (ToN n) a
-  eval _ opts as = do
-    let strict = getBool @strict
-        n :: Int
-        n = nat @n
-        msg0 = "TupleList" <> (if strict then "" else "Lax") <> "(" <> show n <> ")"
-    pure $ case tupleListD @(ToN n) @a strict as of
-      Left e -> mkNode opts (FailT (msg0 <> " " <> e)) [msg0 <> " " <> e] []
-      Right ret -> mkNode opts (PresentT ret) [show01 opts msg0 ret as] []
-
--- | reverses inductive tuples
---
--- >>> pl @ReverseTupleN (1,('a',(True,("def",()))))
--- Present ("def",(True,('a',(1,()))))
--- PresentT ("def",(True,('a',(1,()))))
---
--- >>> pl @ReverseTupleN (1,('a',()))
--- Present ('a',(1,()))
--- PresentT ('a',(1,()))
---
--- >>> pl @ReverseTupleN (999,())
--- Present (999,())
--- PresentT (999,())
---
-data ReverseTupleN
-
-instance (ReverseTupleC tp
-        , Show (ReverseTupleP tp)
-        , Show tp
-        ) => P ReverseTupleN tp where
-  type PP ReverseTupleN tp = ReverseTupleP tp
-  eval _ opts tp =
-    let ret = reverseTupleC tp
-    in pure $ mkNode opts (PresentT ret) ["ReverseTupleN" <> show0 opts " " ret <> show1 opts " | " tp] []
-
--- | Printfn prints an inductive tuple
---
--- >>> pl @(Printfn "%s %s" Id) ("123",("def",()))
--- Present "123 def"
--- PresentT "123 def"
---
--- >>> pl @(Printfn "s=%s d=%03d" Id) ("ab",(123,()))
--- Present "s=ab d=123"
--- PresentT "s=ab d=123"
---
-data Printfn s p
-type Printfnt (n :: Nat) s =  Printfn s (TupleList n)
-type PrintfntLax (n :: Nat) s = Printfn s (TupleListLax n)
-
--- | print a 2-tuple
---
--- >>> pl @(Printf2 "fst=%s snd=%03d") ("ab",123)
--- Present "fst=ab snd=123"
--- PresentT "fst=ab snd=123"
---
-type Printf2 s = Printfn s '(Fst Id,'(Snd Id, '()))
--- | print a 3-tuple
---
--- >>> pl @(Printf3 "fst=%s snd=%03d thd=%s") ("ab",123,"xx")
--- Present "fst=ab snd=123 thd=xx"
--- PresentT "fst=ab snd=123 thd=xx"
---
-type Printf3 s = Printfn s '(Fst Id, '(Snd Id, '(Thd Id, '())))
-type Printf3' s = Printfn s (TupleI '[Fst Id, Snd Id, Thd Id])
-
-
-instance (KnownNat (TupleLenT as)
-        , PrintC bs
-        , (b,bs) ~ ReverseTupleP (a,as)
-        , ReverseTupleC (a,as)
-        , Show a
-        , Show as
-        , PrintfArg b
-        , PP s x ~ String
-        , PP p x ~ (a,as)
-        , P s x
-        , P p x
-        , CheckT (PP p x) ~ 'True
-        ) => P (Printfn s p) x where
-  type PP (Printfn s p) x = String
-  eval _ opts x = do
-    let msg0 = "Printfn"
-    lrx <- runPQ msg0 (Proxy @s) (Proxy @p) opts x
-    case lrx of
-      Left e -> pure e
-      Right (s,(a,as),ss,pp) -> do
-        let len :: Int = 1 + nat @(TupleLenT as)
-            msg1 = msg0 <> "(" <> show len <> ")"
-            hhs = [hh ss, hh pp]
-        lr <- catchitNF @_ @E.SomeException (prtC @bs s (reverseTupleC (a,as)))
-        pure $ case lr of
-          Left e -> mkNode opts (FailT (msg1 <> "(" <> e <> ")")) [msg1 <> show0 opts " " a <> " s=" <> s] hhs
-          Right ret -> mkNode opts (PresentT ret) [msg1 <> " [" <> showLit0 opts "" ret <> "]" <> show1 opts " | (a,as)=" (a,as) <> showLit0 opts " | s=" s] hhs
-
-type family CheckT (tp :: Type) :: Bool where
-  CheckT () = GL.TypeError ('GL.Text "Printfn: inductive tuple cannot be empty")
-  CheckT o = 'True
-
-type family ApplyConstT (ta :: Type) (b :: Type) :: Type where
---type family ApplyConstT ta b where -- less restrictive so allows ('Just Int) Bool through!
-  ApplyConstT (t a) b = t b
-  ApplyConstT ta b = GL.TypeError (
-       'GL.Text "ApplyConstT: (t a) b but found something else"
-       ':$$: 'GL.Text "t a = "
-       ':<>: 'GL.ShowType ta
-       ':$$: 'GL.Text "b = "
-       ':<>: 'GL.ShowType b)
-
--- | similar to 'Control.Applicative.<$'
---
--- >>> pl @(Fst Id <$ Snd Id) ("abc",Just 20)
--- Present Just "abc"
--- PresentT (Just "abc")
---
-data p <$ q
-infixl 4 <$
-
-instance (P p x
-        , P q x
-        , Show (PP p x)
-        , Functor t
-        , PP q x ~ t c
-        , ApplyConstT (PP q x) (PP p x) ~ t (PP p x)
-        ) => P (p <$ q) x where
-  type PP (p <$ q) x = ApplyConstT (PP q x) (PP p x)
-  eval _ opts x = do
-    let msg0 = "(<$)"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = p <$ q
-        in mkNode opts (PresentT d) [msg0 <> show0 opts " " p] [hh pp, hh qq]
-
-data p <* q
-infixl 4 <*
-
--- | similar to 'Control.Applicative.<*'
---
--- >>> pl @(Fst Id <* Snd Id) (Just "abc",Just 20)
--- Present Just "abc"
--- PresentT (Just "abc")
---
-type p *> q = q <* p
-infixl 4 *>
-
-instance (Show (t c)
-        , P p x
-        , P q x
-        , Show (t b)
-        , Applicative t
-        , t b ~ PP p x
-        , PP q x ~ t c
-        ) => P (p <* q) x where
-  type PP (p <* q) x = PP p x
-  eval _ opts x = do
-    let msg0 = "(<*)"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = p <* q
-        in mkNode opts (PresentT d) [show01' opts msg0 p "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
-
--- | similar to 'Control.Applicative.<|>'
---
--- >>> pl @(Fst Id <|> Snd Id) (Nothing,Just 20)
--- Present Just 20
--- PresentT (Just 20)
---
--- >>> pl @(Fst Id <|> Snd Id) (Just 10,Just 20)
--- Present Just 10
--- PresentT (Just 10)
---
--- >>> pl @(Fst Id <|> Snd Id) (Nothing,Nothing)
--- Present Nothing
--- PresentT Nothing
---
-data p <|> q
-infixl 3 <|>
-
-instance (P p x
-        , P q x
-        , Show (t b)
-        , Alternative t
-        , t b ~ PP p x
-        , PP q x ~ t b
-        ) => P (p <|> q) x where
-  type PP (p <|> q) x = PP p x
-  eval _ opts x = do
-    let msg0 = "(<|>)"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq) ->
-        let d = p <|> q
-        in mkNode opts (PresentT d) [show01' opts msg0 d "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
-
-
--- | similar to 'Control.Comonad.extract'
---
--- >>> pl @Extract (Nothing,Just 20)
--- Present Just 20
--- PresentT (Just 20)
---
--- >>> pl @Extract (Identity 20)
--- Present 20
--- PresentT 20
---
-data Extract
-instance (Show (t a)
-        , Show a
-        , Comonad t
-        ) => P Extract (t a) where
-  type PP Extract (t a) = a
-  eval _ opts ta =
-    let msg0 = "Extract"
-        d = extract ta
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d ta] []
-
--- | similar to 'Control.Comonad.duplicate'
---
--- >>> pl @Duplicate (20,"abc")
--- Present (20,(20,"abc"))
--- PresentT (20,(20,"abc"))
---
-data Duplicate
-
-instance (Show (t a)
-        , Show (t (t a))
-        , Comonad t
-        ) => P Duplicate (t a) where
-  type PP Duplicate (t a) = t (t a)
-  eval _ opts ta =
-    let msg0 = "Duplicate"
-        d = duplicate ta
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d ta] []
-
--- | similar to 'Control.Monad.join'
---
--- >>> pl @Join  (Just (Just 20))
--- Present Just 20
--- PresentT (Just 20)
---
--- >>> pl @Join  ["ab","cd","","ef"]
--- Present "abcdef"
--- PresentT "abcdef"
---
-data Join
-
-instance (Show (t (t a))
-        , Show (t a)
-        , Monad t
-        ) => P Join (t (t a)) where
-  type PP Join (t (t a)) = t a
-  eval _ opts tta =
-    let msg0 = "Join"
-        d = join tta
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d tta] []
-
--- same as $ but shows 'a' and 'b'
-data p $ q
-infixl 0 $
-
-instance (P p x
-        , P q x
-        , PP p x ~ (a -> b)
-        , FnT (PP p x) ~ b
-        , PP q x ~ a
-        , Show a
-        , Show b
-        ) => P (p $ q) x where
-  type PP (p $ q) x = FnT (PP p x)
-  eval _ opts x = do
-    let msg0 = "($)"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq)  ->
-        let d = p q
-        in mkNode opts (PresentT d) ["fn $ " <> show q <> " = " <> show d] [hh pp, hh qq]
-
--- reify this so we can combine (type synonyms dont work as well)
-data q & p -- flips the args eg a & b & (,) = (b,a)
-infixr 1 &
-
-instance (P p x
-        , P q x
-        , PP p x ~ (a -> b)
-        , FnT (PP p x) ~ b
-        , PP q x ~ a
-        , Show a
-        , Show b
-        ) => P (q & p) x where
-  type PP (q & p) x = FnT (PP p x)
-  eval _ opts x = do
-    let msg0 = "(&)"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,q,pp,qq)  ->
-        let d = p q
-        in mkNode opts (PresentT d) ["fn & " <> show q <> " = " <> show d] [hh pp, hh qq]
-
-type family FnT ab :: Type where
-  FnT (a -> b) = b
-  FnT ab = GL.TypeError (
-      'GL.Text "FnT: expected Type -> Type but found a simple Type?"
-      ':$$: 'GL.Text "ab = "
-      ':<>: 'GL.ShowType ab)
-
--- | similar to 'T.strip' 'T.stripStart' 'T.stripEnd'
---
--- >>> pl @(Trim (Snd Id)) (20," abc   " :: String)
--- Present "abc"
--- PresentT "abc"
---
--- >>> pl @(Trim (Snd Id)) (20,T.pack " abc   ")
--- Present "abc"
--- PresentT "abc"
---
--- >>> pl @(TrimStart (Snd Id)) (20," abc   ")
--- Present "abc   "
--- PresentT "abc   "
---
--- >>> pl @(TrimEnd (Snd Id)) (20," abc   ")
--- Present " abc"
--- PresentT " abc"
---
--- >>> pl @(TrimEnd "  abc ") ()
--- Present "  abc"
--- PresentT "  abc"
---
--- >>> pl @(TrimEnd "") ()
--- Present ""
--- PresentT ""
---
--- >>> pl @(Trim "         ") ()
--- Present ""
--- PresentT ""
---
--- >>> pl @(Trim "") ()
--- Present ""
--- PresentT ""
---
-data Trim' (left :: Bool) (right :: Bool) p
-type Trim p = Trim' 'True 'True p
-type TrimStart p = Trim' 'True 'False p
-type TrimEnd p = Trim' 'False 'True p
-
-instance (FailIfT (NotT (OrT l r)) ()
-           ('GL.Text "Trim': left and right cannot both be False")
-        , GetBool l
-        , GetBool r
-        , TL.IsText (PP p x)
-        , P p x
-        ) => P (Trim' l r p) x where
-  type PP (Trim' l r p) x = PP p x
-  eval _ opts x = do
-    let msg0 = "Trim" ++ (if l && r then "" else if l then "Start" else "End")
-        l = getBool @l
-        r = getBool @r
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right (view TL.unpacked -> p) ->
-        let fl = if l then dropWhile isSpace else id
-            fr = if r then dropWhileEnd isSpace else id
-            b =  (fl . fr) p
-        in mkNode opts (PresentT (b ^. TL.packed)) [msg0 <> showLit0 opts "" b <> showLit1 opts " | " p] [hh pp]
-
--- | similar to 'T.stripLeft' 'T.stripRight'
---
--- >>> pl @(StripLeft "xyz" Id) ("xyzHello" :: String)
--- Present Just "Hello"
--- PresentT (Just "Hello")
---
--- >>> pl @(StripLeft "xyz" Id) (T.pack "xyzHello")
--- Present Just "Hello"
--- PresentT (Just "Hello")
---
--- >>> pl @(StripLeft "xyz" Id) "xywHello"
--- Present Nothing
--- PresentT Nothing
---
--- >>> pl @(StripRight "xyz" Id) "Hello xyz"
--- Present Just "Hello "
--- PresentT (Just "Hello ")
---
--- >>> pl @(StripRight "xyz" Id) "xyzHelloxyw"
--- Present Nothing
--- PresentT Nothing
---
--- >>> pl @(StripRight "xyz" Id) ""
--- Present Nothing
--- PresentT Nothing
---
--- >>> pl @(StripRight "xyz" "xyz") ()
--- Present Just ""
--- PresentT (Just "")
---
-data StripLR (right :: Bool) p q
-type StripRight p q = StripLR 'True p q
-type StripLeft p q = StripLR 'False p q
-
-instance (GetBool r
-        , PP p x ~ String
-        , P p x
-        , TL.IsText (PP q x)
-        , P q x
-        ) => P (StripLR r p q) x where
-  type PP (StripLR r p q) x = Maybe (PP q x)
-  eval _ opts x = do
-    let msg0 = "Strip" ++ (if r then "Right" else "Left")
-        r = getBool @r
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x
-    pure $ case lr of
-      Left e -> e
-      Right (p,view TL.unpacked -> q,pp,qq) ->
-        let b = if r then
-                  let (before,after) = splitAt (length q - length p) q
-                  in if after == p then Just before else Nothing
-                else
-                  let (before,after) = splitAt (length p) q
-                  in if before == p then Just after else Nothing
-        in mkNode opts (PresentT (fmap (view TL.packed) b)) [msg0 <> show0 opts "" b <> showLit1 opts " | p=" p <> showLit1 opts " | q=" q] [hh pp, hh qq]
-
--- | creates a promoted list of predicates and then evaluates them into a list. see PP instance for '[k]
---
--- >>> pl @(Repeat 4 (Succ Id)) 'c'
--- Present "dddd"
--- PresentT "dddd"
---
--- >>> pl @(Repeat 4 "abc") ()
--- Present ["abc","abc","abc","abc"]
--- PresentT ["abc","abc","abc","abc"]
---
-data Repeat (n :: Nat) p
-instance (P (RepeatT n p) a
-         ) => P (Repeat n p) a where
-  type PP (Repeat n p) a = PP (RepeatT n p) a
-  eval _ opts a =
-    eval (Proxy @(RepeatT n p)) opts a
-
--- | leverages 'Do' for repeating predicates (passthrough method)
--- same as @DoN n p == FoldN n p Id@ but more efficient
---
--- >>> pl @(DoN 4 (Succ Id)) 'c'
--- Present 'g'
--- PresentT 'g'
---
--- >>> pl @(DoN 4 (Id <> " | ")) "abc"
--- Present "abc |  |  |  | "
--- PresentT "abc |  |  |  | "
---
--- >>> pl @(DoN 4 (Id <> "|" <> Id)) "abc"
--- Present "abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc"
--- PresentT "abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc"
---
-data DoN (n :: Nat) p
-instance (P (DoExpandT (RepeatT n p)) a
-         ) => P (DoN n p) a where
-  type PP (DoN n p) a = PP (Do (RepeatT n p)) a
-  eval _ opts a =
-    eval (Proxy @(Do (RepeatT n p))) opts a
-
+{-# LANGUAGE NoOverloadedLists #-}
+{- |
+     Dsl for evaluating and displaying type level expressions
+
+     Contains instances of the class 'P' for evaluating expressions at the type level.
+-}
+module Predicate.Prelude (
+  -- ** boolean expressions
+    type (&&)
+  , type (||)
+  , type (~>)
+  , Not
+  , Ands
+  , Ors
+  , Asc
+  , Asc'
+  , Desc
+  , Desc'
+  , Between
+  , type (<..>)
+  , Between'
+  , All
+  , Any
+  , AllPositive
+  , Positive
+  , AllNegative
+  , Negative
+
+  -- ** regex expressions
+  , Re
+  , Re'
+  , Rescan
+  , Rescan'
+  , RescanRanges
+  , RescanRanges'
+  , Resplit
+  , Resplit'
+  , ReplaceAll
+  , ReplaceAll'
+  , ReplaceOne
+  , ReplaceOne'
+  , ReplaceAllString
+  , ReplaceAllString'
+  , ReplaceOneString
+  , ReplaceOneString'
+  , MakeRR
+  , MakeRR1
+  , MakeRR2
+  , MakeRR3
+
+  -- ** tuple expressions
+  , Fst
+  , Snd
+  , Thd
+  , L1
+  , L2
+  , L3
+  , L4
+  , L5
+  , L6
+  , Dup
+  , Swap
+  , Assoc
+  , Unassoc
+  , Pairs
+
+ -- ** character expressions
+  , IsLower
+  , IsUpper
+  , IsNumber
+  , IsSpace
+  , IsPunctuation
+  , IsControl
+  , IsHexDigit
+  , IsOctDigit
+  , IsSeparator
+  , IsLatin1
+
+  -- ** datetime expressions
+  , FormatTimeP
+  , ParseTimeP
+  , ParseTimeP'
+  , ParseTimes
+  , ParseTimes'
+  , MkDay
+  , MkDay'
+  , UnMkDay
+
+  -- ** numeric expressions
+  , type (+)
+  , type (-)
+  , type (*)
+  , type (/)
+  , Negate
+  , Abs
+  , Signum
+  , FromInteger
+  , FromInteger'
+  , FromIntegral
+  , FromIntegral'
+  , Truncate
+  , Truncate'
+  , Ceiling
+  , Ceiling'
+  , Floor
+  , Floor'
+  , Even
+  , Odd
+  , Div
+  , Mod
+  , DivMod
+  , QuotRem
+  , Quot
+  , Rem
+
+  -- *** rational numbers
+  , type (%)
+  , type (%-)
+  , type (-%)
+  , ToRational
+  , FromRational
+  , FromRational'
+
+ -- ** proxy expressions
+  , MkProxy
+  , ProxyT
+  , ProxyT'
+  , Unproxy
+
+ -- ** read / show expressions
+  , ShowP
+  , ReadP
+  , ReadP'
+  , ReadQ
+  , ReadQ'
+  , ReadMaybe
+  , ReadMaybe'
+  , ReadBase
+  , ReadBase'
+  , ReadBaseInt
+  , ShowBase
+
+  -- ** arrow expressions
+  , type (&&&)
+  , type (***)
+  , First
+  , Second
+  , type (|||)
+  , type (+++)
+
+ -- ** compare expressions
+  , type (>)
+  , type (>=)
+  , type (==)
+  , type (/=)
+  , type (<=)
+  , type (<)
+  , type (>~)
+  , type (>=~)
+  , type (==~)
+  , type (/=~)
+  , type (<=~)
+  , type (<~)
+  , Gt
+  , Ge
+  , Same
+  , Le
+  , Lt
+  , Ne
+  , OrdP
+  , type (==!)
+  , OrdA'
+  , OrdA
+  , OrdI
+  , type (===~)
+  , Cmp
+  , CmpI
+
+  -- ** enum expressions
+  , Succ
+  , Pred
+  , FromEnum
+  , ToEnum
+  , ToEnum'
+  , EnumFromTo
+  -- *** bounded enum expressions
+  , SuccB
+  , SuccB'
+  , PredB
+  , PredB'
+  , ToEnumBDef
+  , ToEnumBDef'
+  , ToEnumBFail
+
+ -- ** wrap / unwrap expressions
+  , Unwrap
+  , Wrap
+  , Wrap'
+  , Coerce
+  , Coerce2
+
+  -- ** list / foldable expressions
+  , Map
+  , Concat
+  , ConcatMap
+  , Partition
+  , Filter
+  , Break
+  , Span
+  , Intercalate
+  , Elem
+  , Inits
+  , Tails
+  , Ones
+  , OneP
+  , Len
+  , Length
+  , PadL
+  , PadR
+  , Cycle
+  , SplitAts
+  , SplitAt
+  , Take
+  , Drop
+  , Min
+  , Max
+  , Sum
+  , IsEmpty
+  , Null
+  , ToList
+  , ToList'
+  , IToList
+  , IToList'
+  , FromList
+  , EmptyList
+  , EmptyList'
+  , Singleton
+  , Reverse
+  , ReverseL
+  , SortBy
+  , SortOn
+  , SortOnDesc
+  , Remove
+  , Keep
+ -- *** overloaded list expressions
+  , ToListExt
+  , FromListExt
+
+ -- ** maybe expressions
+  , MkNothing
+  , MkNothing'
+  , MkJust
+  , IsNothing
+  , IsJust
+  , MapMaybe
+  , CatMaybes
+  , Just
+  , JustDef
+  , JustFail
+  , MaybeIn
+  , MaybeBool
+
+ -- ** either expressions
+  , PartitionEithers
+  , IsLeft
+  , IsRight
+  , MkLeft
+  , MkLeft'
+  , MkRight
+  , MkRight'
+  , Left'
+  , Right'
+  , LeftDef
+  , LeftFail
+  , RightDef
+  , RightFail
+  , EitherBool
+  , MkRightAlt
+  , MkLeftAlt
+  , EitherIn
+
+  -- ** semigroup / monoid expressions
+  , type (<>)
+  , MConcat
+  , STimes
+  , Sapa
+  , Sapa'
+  , MEmptyT
+  , MEmptyT'
+  , MEmptyP
+  , MEmptyT2
+  , MEmptyT2'
+
+  -- ** indexing expressions
+  , Ix
+  , Ix'
+  , IxL
+  , type (!!)
+  , Lookup
+  , LookupDef
+  , LookupDef'
+  , LookupFail
+  , LookupFail'
+
+ -- cons / uncons expressions
+  , type (:+)
+  , type (+:)
+  , Uncons
+  , Unsnoc
+  , Head
+  , Tail
+  , Init
+  , Last
+  , HeadDef
+  , HeadFail
+  , TailDef
+  , TailFail
+  , LastDef
+  , LastFail
+  , InitDef
+  , InitFail
+
+ -- ** these expressions
+  , PartitionThese
+  , Thiss
+  , Thats
+  , Theses
+  , This'
+  , That'
+  , These'
+  , IsThis
+  , IsThat
+  , IsThese
+  , MkThis
+  , MkThis'
+  , MkThat
+  , MkThat'
+  , MkThese
+  , ThisDef
+  , ThisFail
+  , ThatDef
+  , ThatFail
+  , TheseDef
+  , TheseFail
+  , TheseIn
+  , TheseId
+  , TheseX
+
+ -- ** fold / unfold expressions
+  , Scanl
+  , ScanN
+  , ScanNA
+  , FoldN
+  , Foldl
+  , Unfoldr
+  , IterateN
+  , IterateUntil
+  , IterateWhile
+  , IterateNWhile
+  , IterateNUntil
+
+  -- ** failure expressions
+  , Fail
+  , Failp
+  , Failt
+  , FailS
+  , Catch
+  , Catch'
+
+  -- ** zip expressions
+  , ZipThese
+  , ZipL
+  , ZipR
+  , Zip
+  , Unzip
+  , Unzip3
+
+  -- ** conditional expressions
+  , If
+  , Case
+  , Case'
+  , Case''
+  , Guards
+  , GuardsQuick
+  , Guard
+  , ExitWhen
+  , GuardSimple
+  , GuardsN
+  , GuardsDetail
+
+  , Bools
+  , BoolsQuick
+  , BoolsN
+
+  -- ** IO expressions
+  , ReadFile
+  , FileExists
+  , ReadDir
+  , DirExists
+  , ReadEnv
+  , ReadEnvAll
+  , TimeUtc
+  , TimeZt
+  , AppendFile
+  , WriteFile
+  , WriteFile'
+  , Stdout
+  , Stderr
+  , Stdin
+
+  -- ** string expressions
+  , ToLower
+  , ToUpper
+  , Trim
+  , TrimStart
+  , TrimEnd
+  , StripLR
+  , StripRight
+  , StripLeft
+  , IsPrefix
+  , IsInfix
+  , IsSuffix
+  , IsPrefixI
+  , IsInfixI
+  , IsSuffixI
+  , FromStringP
+  , FromStringP'
+
+  -- ** print expressions
+  , PrintF
+  , PrintL
+  , PrintT
+
+  -- ** higher order expressions
+  , Pure
+  , Pure2
+  , FoldMap
+  , type (<$)
+  , type (<*)
+  , type (*>)
+  , FMapFst
+  , FMapSnd
+  , Sequence
+  , Traverse
+  , Join
+  , EmptyT
+  , type (<|>)
+  , Extract
+  , Duplicate
+
+  -- ** expression combinators
+  , type ($)
+  , type (&)
+  , Do
+  , type (>>)
+  , type (<<)
+  , type (>>>)
+  , DoN
+
+  -- *** parallel expressions
+  , Para
+  , ParaN
+  , Repeat
+
+  -- ** miscellaneous
+  , Prime
+  , Luhn
+  , Char1
+  , Hide
+  , Hole
+  , Skip
+  , type (|>)
+  , type (>|)
+  , type (>|>)
+ ) where
+import Predicate.Core
+import Predicate.Util
+import Safe (succMay, predMay, toEnumMay)
+import GHC.TypeLits (Symbol,Nat,KnownSymbol,KnownNat,ErrorMessage((:$$:),(:<>:)))
+import qualified GHC.TypeLits as GL
+import Control.Lens hiding (iall)
+--import Control.Lens (Unwrapped, Wrapped, _Unwrapped', _Wrapped', Ixed, IxValue, Index, Reversing, Cons, Snoc, AsEmpty, FoldableWithIndex, allOf, (%~), (<&>), (^.), (^?), coerced, view, reversed, ix, cons, snoc, _Cons, _Snoc, (^?!), (.~), itoList, Identity(..), _Empty, has)
+import Data.List
+import qualified Data.Text.Lens as TL
+import Data.Proxy
+import Control.Applicative
+import Data.Typeable
+import Control.Monad.Except
+import qualified Control.Exception as E
+import Data.Kind (Type)
+import qualified Text.Regex.PCRE.Heavy as RH
+import Data.String
+import Data.Foldable
+import Data.Maybe
+import Control.Arrow
+import qualified Data.Semigroup as SG
+import Numeric
+import Data.Char
+import Data.Function
+import Data.These (These(..), partitionThese)
+import qualified Data.Bifunctor.Swap as SW (Swap(..))
+import qualified Data.Bifunctor.Assoc as AS (Assoc(..))
+import Data.Ratio
+import Data.Time
+import Data.Coerce
+import Data.Void
+import qualified Data.Sequence as Seq
+import Text.Printf
+import System.Directory
+import Control.Comonad
+import System.IO
+import System.Environment
+import qualified GHC.Exts as GE
+import Data.Bool
+import Data.Either
+import qualified Data.Type.Equality as DE
+import Data.Time.Calendar.WeekDate
+
+-- $setup
+-- >>> :set -XDataKinds
+-- >>> :set -XTypeApplications
+-- >>> :set -XTypeOperators
+-- >>> :set -XNoStarIsType
+-- >>> :set -XOverloadedStrings
+-- >>> :set -XNoOverloadedLists
+-- >>> import qualified Data.Map.Strict as M
+-- >>> import qualified Data.Text as T
+
+-- | a type level predicate for a monotonic increasing list
+--
+-- >>> pl @Asc "aaacdef"
+-- True (All(6))
+-- TrueT
+--
+-- >>> pz @Asc [1,2,3,4,5,5,7]
+-- True
+-- TrueT
+--
+-- >>> pz @Asc' [1,2,3,4,5,5,7]
+-- False
+-- FalseT
+--
+-- >>> pz @Asc "axacdef"
+-- False
+-- FalseT
+--
+
+
+-- | a type level predicate for a monotonic increasing list
+type Asc = All (Fst Id <= Snd Id) Pairs
+-- | a type level predicate for a strictly increasing list
+type Asc' = All (Fst Id < Snd Id) Pairs
+-- | a type level predicate for a monotonic decreasing list
+type Desc = All (Fst Id >= Snd Id) Pairs
+-- | a type level predicate for a strictly decreasing list
+type Desc' = All (Fst Id > Snd Id) Pairs
+
+--type AscAlt = SortOn Id Id == Id
+--type DescAlt = SortOnDesc Id Id == Id
+
+-- | A predicate that determines if the value is between \'p\' and \'q\'
+--
+-- >>> pz @(Between' 5 8 Len) [1,2,3,4,5,5,7]
+-- True
+-- TrueT
+--
+-- >>> pz @(Between 5 8) 6
+-- True
+-- TrueT
+--
+-- >>> pz @(Between 5 8) 9
+-- False
+-- FalseT
+--
+-- >>> pz @(10 % 4 <..> 40 % 5) 4
+-- True
+-- TrueT
+--
+-- >>> pz @(10 % 4 <..> 40 % 5) 33
+-- False
+-- FalseT
+--
+data Between' p q r -- reify as it is used a lot! nicer specific messages at the top level!
+type Between p q = Between' p q Id
+type p <..> q = Between p q
+infix 4 <..>
+
+instance (Ord (PP p x)
+       , Show (PP p x)
+       , PP r x ~ PP p x
+       , PP r x ~ PP q x
+       , P p x
+       , P q x
+       , P r x
+       ) => P (Between' p q r) x where
+  type PP (Between' p q r) x = Bool
+  eval _ opts x = do
+    let msg0 = "Between"
+    rr <- eval (Proxy @r) opts x
+    case getValueLR opts msg0 rr [] of
+      Left e -> pure e
+      Right r -> do
+        lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x [hh rr]
+        pure $ case lr of
+          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 [show p <> " <= " <> show r <> " <= " <> show q] hhs
+               else if p > r then mkNodeB opts False [show p <> " <= " <> show r] hhs
+               else mkNodeB opts False [show r <> " <= " <> show q] hhs
+
+-- | similar to 'all'
+--
+-- >>> pl @(All Even Id) [1,5,11,5,3]
+-- False (All i=0 (1 == 0) 5 false)
+-- FalseT
+--
+-- >>> pz @(All Odd Id) [1,5,11,5,3]
+-- True
+-- TrueT
+--
+-- >>> pz @(All Odd Id) []
+-- True
+-- TrueT
+--
+-- >>> pe @(All Even Id) [1,5,11,5,3]
+-- False All i=0 (1 == 0) 5 false
+-- |
+-- +- P Id [1,5,11,5,3]
+-- |
+-- +- False i=0:1 == 0
+-- |  |
+-- |  +- P 1 `mod` 2 = 1
+-- |  |  |
+-- |  |  +- P I
+-- |  |  |
+-- |  |  `- P '2
+-- |  |
+-- |  `- P '0
+-- |
+-- +- False i=1:1 == 0
+-- |  |
+-- |  +- P 5 `mod` 2 = 1
+-- |  |  |
+-- |  |  +- P I
+-- |  |  |
+-- |  |  `- P '2
+-- |  |
+-- |  `- P '0
+-- |
+-- +- False i=2:1 == 0
+-- |  |
+-- |  +- P 11 `mod` 2 = 1
+-- |  |  |
+-- |  |  +- P I
+-- |  |  |
+-- |  |  `- P '2
+-- |  |
+-- |  `- P '0
+-- |
+-- +- False i=3:1 == 0
+-- |  |
+-- |  +- P 5 `mod` 2 = 1
+-- |  |  |
+-- |  |  +- P I
+-- |  |  |
+-- |  |  `- P '2
+-- |  |
+-- |  `- P '0
+-- |
+-- `- False i=4:1 == 0
+--    |
+--    +- P 3 `mod` 2 = 1
+--    |  |
+--    |  +- P I
+--    |  |
+--    |  `- P '2
+--    |
+--    `- P '0
+-- FalseT
+--
+data All p q
+
+instance (P p a
+        , PP p a ~ Bool
+        , PP q x ~ f a
+        , P q x
+        , Show a
+        , Foldable f
+        ) => P (All p q) x where
+  type PP (All p q) x = Bool
+  eval _ opts x = do
+    let msg0 = "All"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case chkSize opts msg0 q [hh qq] of
+          Left e -> pure e
+          Right () -> do
+            ts <- zipWithM (\i a -> ((i, a),) <$> evalBool (Proxy @p) opts a) [0::Int ..] (toList q)
+            pure $ case splitAndAlign opts [msg0] ts of
+                 Left e -> e
+                 Right (vals, ixtts) ->
+                   let hhs = hh qq : map (hh . fixit) ts
+                   in case filter (not . snd) (zip [0..] vals) of
+                        [] -> mkNodeB opts True [msg0 ++ "(" ++ show (length q) ++ ")"] hhs
+                        (i,_):fs -> let (_,tt) = ixtts !! i
+                                    in mkNodeB opts False [msg0 <> " i=" ++ showIndex i ++ " " <> topMessage tt ++ " " ++ show (length fs+1) ++ " false"] hhs
+
+chkSize :: Foldable t => POpts -> String -> t a -> [Holder] -> Either (TT x) ()
+chkSize opts msg0 xs hhs =
+  case splitAt _MX (toList xs) of
+    (_,[]) -> Right ()
+    (_,_:_) -> Left $ mkNode opts (FailT (msg0 <> " list size exceeded")) [msg0 <> " list size exceeded: max is " ++ show _MX] hhs
+
+showIndex :: (Show i, Num i) => i -> String
+showIndex i = show (i+0)
+-- | similar to 'any'
+--
+-- >>> pz @(Any Even Id) [1,5,11,5,3]
+-- False
+-- FalseT
+--
+-- >>> pz @(Any Even Id) [1,5,112,5,3]
+-- True
+-- TrueT
+--
+-- >>> pz @(Any Even Id) []
+-- False
+-- FalseT
+--
+data Any p q
+
+instance (P p a
+        , PP p a ~ Bool
+        , PP q x ~ f a
+        , P q x
+        , Show a
+        , Foldable f
+        ) => P (Any p q) x where
+  type PP (Any p q) x = Bool
+  eval _ opts x = do
+    let msg0 = "Any"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case chkSize opts msg0 q [hh qq] of
+          Left e -> pure e
+          Right () -> do
+            ts <- zipWithM (\i a -> ((i, a),) <$> evalBool (Proxy @p) opts a) [0::Int ..] (toList q)
+            pure $ case splitAndAlign opts [msg0] ts of
+                 Left e -> e
+                 Right (vals, ixtts) ->
+                   let hhs = hh qq : map (hh . fixit) ts
+                   in case filter snd (zip [0..] vals) of
+                        [] -> mkNodeB opts False [msg0 ++ "(" ++ show (length q) ++ ")"] hhs
+                        (i,_):fs -> let (_,tt) = ixtts !! i
+                                    in mkNodeB opts True [msg0 <> " i=" ++ showIndex i ++ " " <> topMessage tt ++ " " ++ show (length fs+1) ++ " false"] hhs
+
+
+-- | a type level predicate for all positive elements in a list
+--
+-- >>> pz @AllPositive [1,5,10,2,3]
+-- True
+-- TrueT
+--
+-- >>> pz @AllPositive [0,1,5,10,2,3]
+-- False
+-- FalseT
+--
+-- >>> pz @AllPositive [3,1,-5,10,2,3]
+-- False
+-- FalseT
+--
+-- >>> pz @AllNegative [-1,-5,-10,-2,-3]
+-- True
+-- TrueT
+--
+type AllPositive = All Positive Id
+-- | a type level predicate for all negative elements in a list
+type AllNegative = All Negative Id
+type Positive = Gt 0
+type Negative = Lt 0
+
+-- | 'unzip' equivalent
+--
+-- >>> pz @Unzip (zip [1..5] "abcd")
+-- Present ([1,2,3,4],"abcd")
+-- PresentT ([1,2,3,4],"abcd")
+--
+type Unzip = '(Map (Fst Id) Id, Map (Snd Id) Id)
+
+-- | 'unzip3' equivalent
+--
+-- >>> pz @Unzip3 (zip3 [1..5] "abcd" (cycle [True,False]))
+-- Present ([1,2,3,4],"abcd",[True,False,True,False])
+-- PresentT ([1,2,3,4],"abcd",[True,False,True,False])
+--
+type Unzip3 = '(Map (Fst Id) Id, Map (Snd Id) Id, Map (Thd Id) Id)
+
+-- | represents a predicate using a 'Symbol' as a regular expression
+-- evaluates 'Re' and returns True if there is a match
+--
+-- >>> pz @(Re "^\\d{2}:\\d{2}:\\d{2}$" Id) "13:05:25"
+-- True
+-- TrueT
+--
+data Re' (rs :: [ROpt]) p q
+type Re p q = Re' '[] p q
+
+instance (GetROpts rs
+        , PP p x ~ String
+        , PP q x ~ String
+        , P p x
+        , P q x
+        ) => P (Re' rs p q) x where
+  type PP (Re' rs p q) x = Bool
+  eval _ opts x = do
+    let msg0 = "Re" <> (if null rs then "' " <> show rs else "")
+        rs = getROpts @rs
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let msg1 = msg0 <> " (" <> p <> ")"
+            hhs = [hh pp, hh qq]
+        in case compileRegex @rs opts msg1 p hhs of
+            Left tta -> tta
+            Right regex ->
+               let b = q RH.=~ regex
+               in mkNodeB opts b [msg1 <> showLit1 opts " | " q] hhs
+
+-- only way with rescan is to be explicit: no repeats! and useanchors but not (?m)
+-- or just use Re' but then we only get a bool ie doesnt capture groups
+-- rescan returns Right [] as an failure!
+-- [] is failure!
+
+
+-- | runs a regex matcher returning the original values and optionally any groups
+--
+-- >>> pz @(Rescan "^(\\d{2}):(\\d{2}):(\\d{2})$" Id) "13:05:25"
+-- Present [("13:05:25",["13","05","25"])]
+-- PresentT [("13:05:25",["13","05","25"])]
+--
+-- >>> pz @(Rescan (Snd Id) "13:05:25") ('a',"^(\\d{2}):(\\d{2}):(\\d{2})$")
+-- Present [("13:05:25",["13","05","25"])]
+-- PresentT [("13:05:25",["13","05","25"])]
+--
+data Rescan' (rs :: [ROpt]) p q
+type Rescan p q = Rescan' '[] p q
+
+instance (GetROpts rs
+        , PP p x ~ String
+        , PP q x ~ String
+        , P p x
+        , P q x
+        ) => P (Rescan' rs p q) x where
+  type PP (Rescan' rs p q) x = [(String, [String])]
+  eval _ opts x = do
+    let msg0 = "Rescan" <> (if null rs then "' " <> show rs else "")
+        rs = getROpts @rs
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let msg1 = msg0 <> " (" <> p <> ")"
+            hhs = [hh pp, hh qq]
+        in case compileRegex @rs opts msg1 p hhs of
+          Left tta -> tta
+          Right regex ->
+            case splitAt _MX $ RH.scan regex q of
+              (b, _:_) -> mkNode opts (FailT "Regex looping") [msg1 <> " Looping? " <> show (take 10 b) <> "..." <> show1 opts " | " q] hhs
+              ([], _) -> -- this is a failure cos empty string returned: so reuse p?
+                         mkNode opts (FailT "Regex no results") [msg1 <> " no match" <> show1 opts " | " q] [hh pp, hh qq]
+              (b, _) -> mkNode opts (PresentT b) [lit01 opts msg1 b q] [hh pp, hh qq]
+
+
+-- | similar to 'Rescan' but gives the column start and ending positions instead of values
+--
+-- >>> pz @(RescanRanges "^(\\d{2}):(\\d{2}):(\\d{2})$" Id) "13:05:25"
+-- Present [((0,8),[(0,2),(3,5),(6,8)])]
+-- PresentT [((0,8),[(0,2),(3,5),(6,8)])]
+--
+data RescanRanges' (rs :: [ROpt]) p q
+type RescanRanges p q = RescanRanges' '[] p q
+
+instance (GetROpts rs
+        , PP p x ~ String
+        , PP q x ~ String
+        , P p x
+        , P q x
+        ) => P (RescanRanges' rs p q) x where
+  type PP (RescanRanges' rs p q) x = [((Int,Int), [(Int,Int)])]
+  eval _ opts x = do
+    let msg0 = "RescanRanges" <> (if null rs then "' " <> show rs else "")
+        rs = getROpts @rs
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let msg1 = msg0 <> " (" <> p <> ")"
+            hhs = [hh pp, hh qq]
+        in case compileRegex @rs opts msg1 p hhs of
+          Left tta -> tta
+          Right regex ->
+            case splitAt _MX $ RH.scanRanges regex q of
+              (b, _:_) -> mkNode opts (FailT "Regex looping") [msg1 <> " Looping? " <> show (take 10 b) <> "..." <> show1 opts " | " q] hhs
+              ([], _) -> -- this is a failure cos empty string returned: so reuse p?
+                         mkNode opts (FailT "Regex no results") [msg1 <> " no match" <> show1 opts " | " q] hhs
+              (b, _) -> mkNode opts (PresentT b) [lit01 opts msg1 b q] hhs
+
+-- | splits a string on a regex delimiter
+--
+-- >>> pz @(Resplit "\\." Id) "141.201.1.22"
+-- Present ["141","201","1","22"]
+-- PresentT ["141","201","1","22"]
+--
+-- >>> pz @(Resplit (Singleton (Fst Id)) (Snd Id)) (':', "12:13:1")
+-- Present ["12","13","1"]
+-- PresentT ["12","13","1"]
+--
+data Resplit' (rs :: [ROpt]) p q
+type Resplit p q = Resplit' '[] p q
+
+instance (GetROpts rs
+        , PP p x ~ String
+        , PP q x ~ String
+        , P p x
+        , P q x
+        ) => P (Resplit' rs p q) x where
+  type PP (Resplit' rs p q) x  = [String]
+  eval _ opts x = do
+    let msg0 = "Resplit" <> (if null rs then "' " <> show rs else "")
+        rs = getROpts @rs
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let msg1 = msg0 <> " (" <> p <> ")"
+            hhs = [hh pp, hh qq]
+        in case compileRegex @rs opts msg1 p hhs of
+          Left tta -> tta
+          Right regex ->
+            case splitAt _MX $ RH.split regex q of
+              (b, _:_) -> mkNode opts (FailT "Regex looping") [msg1 <> " Looping? " <> show (take 10 b) <> "..." <> show1 opts " | " q] hhs
+              ([], _) -> -- this is a failure cos empty string returned: so reuse p?
+                         mkNode opts (FailT "Regex no results") [msg1 <> " no match" <> show1 opts " | " q] hhs
+              (b, _) -> mkNode opts (PresentT b) [lit01 opts msg1 b q] hhs
+
+_MX :: Int
+_MX = 100
+
+-- | replaces regex \'s\' with a string \'s1\' inside the value
+--
+-- >>> pz @(ReplaceAllString "\\." ":" Id) "141.201.1.22"
+-- Present "141:201:1:22"
+-- PresentT "141:201:1:22"
+--
+data ReplaceImpl (alle :: Bool) (rs :: [ROpt]) p q r
+type ReplaceAll' (rs :: [ROpt]) p q r = ReplaceImpl 'True rs p q r
+type ReplaceAll p q r = ReplaceAll' '[] p q r
+type ReplaceOne' (rs :: [ROpt]) p q r = ReplaceImpl 'False rs p q r
+type ReplaceOne p q r = ReplaceOne' '[] p q r
+
+type ReplaceAllString' (rs :: [ROpt]) p q r = ReplaceAll' rs p (MakeRR q) r
+type ReplaceAllString p q r = ReplaceAllString' '[] p q r
+
+type ReplaceOneString' (rs :: [ROpt]) p q r = ReplaceOne' rs p (MakeRR q) r
+type ReplaceOneString p q r = ReplaceOneString' '[] p q r
+
+-- | Simple replacement string: see 'ReplaceAllString' and 'ReplaceOneString'
+--
+data MakeRR p
+
+instance (PP p x ~ String
+        , P p x) => P (MakeRR p) x where
+  type PP (MakeRR p) x = RR
+  eval _ opts x = do
+    let msg0 = "MakeRR"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = RR p
+        in mkNode opts (PresentT b) [msg0 <> show1 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'
+--
+-- Requires "Text.Show.Functions"
+--
+data MakeRR1 p
+
+instance (PP p x ~ (String -> [String] -> String)
+        , P p x) => P (MakeRR1 p) x where
+  type PP (MakeRR1 p) x = RR
+  eval _ opts x = do
+    let msg0 = "MakeRR1 (String -> [String] -> String)"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right f -> mkNode opts (PresentT (RR1 f)) [msg0] [hh pp]
+
+-- | A replacement function @(String -> String)@ that yields the whole match
+-- Used by 'RH.sub' and 'RH.gsub'
+--
+-- Requires "Text.Show.Functions"
+--
+-- >>> :m + Text.Show.Functions
+-- >>> pz @(ReplaceAll "\\." (MakeRR2 (Fst Id)) (Snd Id)) (\x -> x <> ":" <> x, "141.201.1.22")
+-- Present "141.:.201.:.1.:.22"
+-- PresentT "141.:.201.:.1.:.22"
+--
+data MakeRR2 p
+
+instance (PP p x ~ (String -> String)
+        , P p x) => P (MakeRR2 p) x where
+  type PP (MakeRR2 p) x = RR
+  eval _ opts x = do
+    let msg0 = "MakeRR2 (String -> String)"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right f -> mkNode opts (PresentT (RR2 f)) [msg0] [hh pp]
+
+-- | A replacement function @([String] -> String)@ which yields the groups
+-- Used by 'RH.sub' and 'RH.gsub'
+--
+-- Requires "Text.Show.Functions"
+--
+-- >>> :m + Text.Show.Functions
+-- >>> pz @(ReplaceAll "^(\\d+)\\.(\\d+)\\.(\\d+)\\.(\\d+)$" (MakeRR3 (Fst Id)) (Snd Id)) (\ys -> intercalate  " | " $ map (show . succ . read @Int) ys, "141.201.1.22")
+-- Present "142 | 202 | 2 | 23"
+-- PresentT "142 | 202 | 2 | 23"
+--
+data MakeRR3 p
+
+instance (PP p x ~ ([String] -> String)
+        , P p x) => P (MakeRR3 p) x where
+  type PP (MakeRR3 p) x = RR
+  eval _ opts x = do
+    let msg0 = "MakeRR3 ([String] -> String)"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right f -> mkNode opts (PresentT (RR3 f)) [msg0] [hh pp]
+
+instance (GetBool b
+        , GetROpts rs
+        , PP p x ~ String
+        , PP q x ~ RR
+        , PP r x ~ String
+        , 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
+  eval _ opts x = do
+    let msg0 = "Replace" <> (if alle then "All" else "One") <> (if null rs then "' " <> show rs else "")
+        rs = getROpts @rs
+        alle = getBool @b
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    case lr of
+      Left e -> pure e
+      Right (p,q,pp,qq) ->
+        let msg1 = msg0 <> " (" <> p <> ")"
+            hhs = [hh pp, hh qq]
+        in case compileRegex @rs opts msg1 p hhs of
+          Left tta -> pure tta
+          Right regex -> do
+            rr <- eval (Proxy @r) opts x
+            pure $ case getValueLR opts msg0 rr hhs of
+              Left e -> e
+              Right r ->
+               let ret :: String
+                   ret = case q of
+                           RR s -> (if alle then RH.gsub else RH.sub) regex s r
+                           RR1 s -> (if alle then RH.gsub else RH.sub) regex s r
+                           RR2 s -> (if alle then RH.gsub else RH.sub) regex s r
+                           RR3 s -> (if alle then RH.gsub else RH.sub) regex s r
+               in mkNode opts (PresentT ret) [msg1 <> showLit0 opts " " r <> showLit1 opts " | " ret] (hhs <> [hh rr])
+
+-- | a predicate for determining if a string 'Data.Text.IsText' belongs to the given character set
+--
+-- >>> pz @IsLower "abc"
+-- True
+-- TrueT
+--
+-- >>> pz @IsLower "abcX"
+-- False
+-- FalseT
+--
+-- >>> pz @IsLower (T.pack "abcX")
+-- False
+-- FalseT
+--
+-- >>> pz @IsHexDigit "01efA"
+-- True
+-- TrueT
+--
+-- >>> pz @IsHexDigit "01egfA"
+-- False
+-- FalseT
+--
+data IsCharSet (cs :: CharSet)
+
+data CharSet = CLower
+             | CUpper
+             | CNumber
+             | CSpace
+             | CPunctuation
+             | CControl
+             | CHexDigit
+             | COctDigit
+             | CSeparator
+             | CLatin1
+             deriving Show
+
+class GetCharSet (cs :: CharSet) where
+  getCharSet :: (CharSet, Char -> Bool)
+instance GetCharSet 'CLower where
+  getCharSet = (CLower, isLower)
+instance GetCharSet 'CUpper where
+  getCharSet = (CUpper, isUpper)
+instance GetCharSet 'CNumber where
+  getCharSet = (CNumber, isNumber)
+instance GetCharSet 'CPunctuation where
+  getCharSet = (CPunctuation, isPunctuation)
+instance GetCharSet 'CControl where
+  getCharSet = (CControl, isControl)
+instance GetCharSet 'CHexDigit where
+  getCharSet = (CHexDigit, isHexDigit)
+instance GetCharSet 'COctDigit where
+  getCharSet = (COctDigit, isOctDigit)
+instance GetCharSet 'CSeparator where
+  getCharSet = (CSeparator, isSeparator)
+instance GetCharSet 'CLatin1 where
+  getCharSet = (CLatin1, isLatin1)
+
+-- | predicate for determining if a string is all lowercase
+--
+-- >>> pz @IsLower "abcdef213"
+-- False
+-- FalseT
+--
+-- >>> pz @IsLower "abcdef"
+-- True
+-- TrueT
+--
+-- >>> pz @IsLower ""
+-- True
+-- TrueT
+--
+-- >>> pz @IsLower "abcdefG"
+-- False
+-- FalseT
+--
+type IsLower = IsCharSet 'CLower
+type IsUpper = IsCharSet 'CUpper
+-- | predicate for determining if the string is all digits
+--
+-- >>> pz @IsNumber "213G"
+-- False
+-- FalseT
+--
+-- >>> pz @IsNumber "929"
+-- True
+-- TrueT
+--
+type IsNumber = IsCharSet 'CNumber
+type IsSpace = IsCharSet 'CSpace
+type IsPunctuation = IsCharSet 'CPunctuation
+type IsControl = IsCharSet 'CControl
+type IsHexDigit = IsCharSet 'CHexDigit
+type IsOctDigit = IsCharSet 'COctDigit
+type IsSeparator = IsCharSet 'CSeparator
+type IsLatin1 = IsCharSet 'CLatin1
+
+instance (GetCharSet cs
+        , Show a
+        , TL.IsText a
+        ) => P (IsCharSet cs) a where
+  type PP (IsCharSet cs) a = Bool
+  eval _ opts as =
+    let b = allOf TL.text f as
+        msg0 = "IsCharSet " ++ show cs
+        (cs,f) = getCharSet @cs
+    in pure $ mkNodeB opts b [msg0 <> show1 opts " | " as] []
+
+
+-- | converts a string 'Data.Text.Lens.IsText' value to lower case
+--
+-- >>> pz @ToLower "HeLlO wOrld!"
+-- Present "hello world!"
+-- PresentT "hello world!"
+--
+data ToLower
+
+instance (Show a, TL.IsText a) => P ToLower a where
+  type PP ToLower a = a
+  eval _ opts as =
+    let msg0 = "ToLower"
+        xs = as & TL.text %~ toLower
+    in pure $ mkNode opts (PresentT xs) [show01 opts msg0 xs as] []
+
+-- | converts a string 'Data.Text.Lens.IsText' value to upper case
+--
+-- >>> pz @ToUpper "HeLlO wOrld!"
+-- Present "HELLO WORLD!"
+-- PresentT "HELLO WORLD!"
+--
+data ToUpper
+
+instance (Show a, TL.IsText a) => P ToUpper a where
+  type PP ToUpper a = a
+  eval _ opts as =
+    let msg0 = "ToUpper"
+        xs = as & TL.text %~ toUpper
+    in pure $ mkNode opts (PresentT xs) [show01 opts msg0 xs as] []
+
+
+-- | similar to 'Data.List.inits'
+--
+-- >>> pz @Inits [4,8,3,9]
+-- Present [[],[4],[4,8],[4,8,3],[4,8,3,9]]
+-- PresentT [[],[4],[4,8],[4,8,3],[4,8,3,9]]
+--
+-- >>> pz @Inits []
+-- Present [[]]
+-- PresentT [[]]
+--
+data Inits
+
+instance Show a => P Inits [a] where
+  type PP Inits [a] = [[a]]
+  eval _ opts as =
+    let msg0 = "Inits"
+        xs = inits as
+    in pure $ mkNode opts (PresentT xs) [show01 opts msg0 xs as] []
+
+-- | similar to 'Data.List.tails'
+--
+-- >>> pz @Tails [4,8,3,9]
+-- Present [[4,8,3,9],[8,3,9],[3,9],[9],[]]
+-- PresentT [[4,8,3,9],[8,3,9],[3,9],[9],[]]
+--
+-- >>> pz @Tails []
+-- Present [[]]
+-- PresentT [[]]
+--
+data Tails
+
+instance Show a => P Tails [a] where
+  type PP Tails [a] = [[a]]
+  eval _ opts as =
+    let msg0 = "Tails"
+        xs = tails as
+    in pure $ mkNode opts (PresentT xs) [show01 opts msg0 xs as] []
+
+-- | split a list into single values
+--
+-- >>> pz @(Ones Id) [4,8,3,9]
+-- Present [[4],[8],[3],[9]]
+-- PresentT [[4],[8],[3],[9]]
+--
+-- >>> pz @(Ones Id) []
+-- Present []
+-- PresentT []
+--
+data Ones p
+
+instance ( PP p x ~ [a]
+         , P p x
+         , Show a
+         ) => P (Ones p) x where
+  type PP (Ones p) x = [PP p x]
+  eval _ opts x = do
+    let msg0 = "Ones"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = map (:[]) p
+        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
+
+-- | similar to 'show'
+--
+-- >>> pz @(ShowP Id) [4,8,3,9]
+-- Present "[4,8,3,9]"
+-- PresentT "[4,8,3,9]"
+--
+-- >>> pz @(ShowP Id) 'x'
+-- Present "'x'"
+-- PresentT "'x'"
+--
+-- >>> pz @(ShowP (42 %- 10)) 'x'
+-- Present "(-21) % 5"
+-- PresentT "(-21) % 5"
+--
+data ShowP p
+
+instance (Show (PP p x), P p x) => P (ShowP p) x where
+  type PP (ShowP p) x = String
+  eval _ opts x = do
+    let msg0 = "ShowP"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = show p
+        in mkNode opts (PresentT d) [msg0 <> showLit0 opts " " d <> show1 opts " | " p] [hh pp]
+
+-- | type level expression representing a formatted time
+-- similar to 'Data.Time.formatTime' using a type level 'Symbol' to get the formatting string
+--
+-- >>> pz @(FormatTimeP "%F %T" Id) (read "2019-05-24 05:19:59" :: LocalTime)
+-- Present "2019-05-24 05:19:59"
+-- PresentT "2019-05-24 05:19:59"
+--
+-- >>> pz @(FormatTimeP (Fst Id) (Snd Id)) ("the date is %d/%m/%Y", read "2019-05-24" :: Day)
+-- Present "the date is 24/05/2019"
+-- PresentT "the date is 24/05/2019"
+--
+data FormatTimeP p q
+
+instance (PP p x ~ String
+        , FormatTime (PP q x)
+        , P p x
+        , Show (PP q x)
+        , P q x
+        ) => P (FormatTimeP p q) x where
+  type PP (FormatTimeP p q) x = String
+  eval _ opts x = do
+    let msg0 = "FormatTimeP"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let msg1 = msg0 <> " (" <> p <> ")"
+            b = formatTime defaultTimeLocale p q
+        in mkNode opts (PresentT b) [msg1 <> showLit0 opts " " b <> show1 opts " | " q] [hh pp, hh qq]
+
+-- | similar to 'Data.Time.parseTimeM' where \'t\' is the 'Data.Time.ParseTime' type, \'p\' is the datetime format and \'q\' points to the content to parse
+--
+-- >>> pz @(ParseTimeP LocalTime "%F %T" Id) "2019-05-24 05:19:59"
+-- Present 2019-05-24 05:19:59
+-- PresentT 2019-05-24 05:19:59
+--
+-- >>> pz @(ParseTimeP LocalTime "%F %T" "2019-05-24 05:19:59") (Right "never used")
+-- Present 2019-05-24 05:19:59
+-- PresentT 2019-05-24 05:19:59
+--
+-- keeping \'q\' as we might want to extract from a tuple
+data ParseTimeP' t p q
+type ParseTimeP (t :: Type) p q = ParseTimeP' (Hole t) p q
+
+instance (ParseTime (PP t a)
+        , Typeable (PP t a)
+        , Show (PP t a)
+        , P p a
+        , P q a
+        , PP p a ~ String
+        , PP q a ~ String
+        ) => P (ParseTimeP' t p q) a where
+  type PP (ParseTimeP' t p q) a = PP t a
+  eval _ opts a = do
+    let msg0 = "ParseTimeP " <> t
+        t = showT @(PP t a)
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let msg1 = msg0 <> " (" <> p <> ")"
+            hhs = [hh pp, hh qq]
+        in case parseTimeM @Maybe @(PP t a) True defaultTimeLocale p q of
+             Just b -> mkNode opts (PresentT b) [lit01' opts msg1 b "fmt=" p <> show1 opts " | " q] hhs
+             Nothing -> mkNode opts (FailT (msg1 <> " failed to parse")) [msg1 <> " failed"] hhs
+
+-- | A convenience method to match against many different datetime formats to find a match
+--
+-- >>> pz @(ParseTimes LocalTime '["%Y-%m-%d %H:%M:%S", "%m/%d/%y %H:%M:%S", "%B %d %Y %H:%M:%S", "%Y-%m-%dT%H:%M:%S"] "03/11/19 01:22:33") ()
+-- Present 2019-03-11 01:22:33
+-- PresentT 2019-03-11 01:22:33
+--
+-- >>> pz @(ParseTimes LocalTime (Fst Id) (Snd Id)) (["%Y-%m-%d %H:%M:%S", "%m/%d/%y %H:%M:%S", "%B %d %Y %H:%M:%S", "%Y-%m-%dT%H:%M:%S"], "03/11/19 01:22:33")
+-- Present 2019-03-11 01:22:33
+-- PresentT 2019-03-11 01:22:33
+--
+data ParseTimes' t p q
+type ParseTimes (t :: Type) p q = ParseTimes' (Hole t) p q
+
+instance (ParseTime (PP t a)
+        , Typeable (PP t a)
+        , Show (PP t a)
+        , P p a
+        , P q a
+        , PP p a ~ [String]
+        , PP q a ~ String
+        ) => P (ParseTimes' t p q) a where
+  type PP (ParseTimes' t p q) a = PP t a
+  eval _ opts a = do
+    let msg0 = "ParseTimes " <> t
+        t = showT @(PP t a)
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let msg1 = msg0
+            hhs = [hh pp, hh qq]
+            zs = map (\d -> (d,) <$> parseTimeM @Maybe @(PP t a) True defaultTimeLocale d q) p
+        in case catMaybes zs of
+             [] -> mkNode opts (FailT ("no match on [" ++ q ++ "]")) [msg1 <> " no match"] hhs
+             (d,b):_ -> mkNode opts (PresentT b) [lit01' opts msg1 b "fmt=" d <> show1 opts " | " q] hhs
+
+-- | create a 'Day' from three int values passed in as year month and day
+--
+-- >>> pz @MkDay (2019,12,30)
+-- Present Just (2019-12-30,1,1)
+-- PresentT (Just (2019-12-30,1,1))
+--
+-- >>> pz @(MkDay' (Fst Id) (Snd Id) (Thd Id)) (2019,99,99999)
+-- Present Nothing
+-- PresentT Nothing
+--
+-- >>> pz @MkDay (1999,3,13)
+-- Present Just (1999-03-13,10,6)
+-- PresentT (Just (1999-03-13,10,6))
+--
+data MkDay' p q r
+type MkDay = MkDay' (Fst Id) (Snd Id) (Thd Id)
+
+instance (P p x
+        , P q x
+        , P r x
+        , PP p x ~ Int
+        , PP q x ~ Int
+        , PP r x ~ Int
+        ) => P (MkDay' p q r) x where
+  type PP (MkDay' p q r) x = Maybe (Day, Int, Int)
+  eval _ opts x = do
+    let msg0 = "MkDay"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    case lr of
+      Left e -> pure e
+      Right (p,q,pp,qq) -> do
+        let hhs = [hh pp, hh qq]
+        rr <- eval (Proxy @r) opts x
+        pure $ case getValueLR opts msg0 rr hhs of
+          Left e -> e
+          Right r ->
+            let mday = fromGregorianValid (fromIntegral p) q r
+                b = mday <&> \day ->
+                      let (_, week, dow) = toWeekDate day
+                      in (day, week, dow)
+            in mkNode opts (PresentT b) [show01' opts msg0 b "(y,m,d)=" (p,q,r)] (hhs <> [hh rr])
+
+-- | uncreate a 'Day' returning year month and day
+--
+-- >>> pz @(UnMkDay Id) (read "2019-12-30")
+-- Present (2019,12,30)
+-- PresentT (2019,12,30)
+--
+data UnMkDay p
+
+instance (PP p x ~ Day, P p x) => P (UnMkDay p) x where
+  type PP (UnMkDay p) x = (Int, Int, Int)
+  eval _ opts x = do
+    let msg0 = "UnMkDay"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let (fromIntegral -> y, m, d) = toGregorian p
+            b = (y, m, d)
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] []
+
+-- | uses the 'Read' of the given type \'t\' and \'p\' which points to the content to read
+--
+-- >>> pz @(ReadP Rational Id) "4 % 5"
+-- Present 4 % 5
+-- PresentT (4 % 5)
+--
+-- >>> pz @(ReadP Day Id >> Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30")) "2018-10-12"
+-- True
+-- TrueT
+--
+-- >>> pz @(ReadP Day Id >> Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30")) "2016-10-12"
+-- False
+-- FalseT
+--
+data ReadP' t p
+type ReadP (t :: Type) p = ReadP' (Hole t) p
+
+instance (P p x
+        , PP p x ~ String
+        , Typeable (PP t x)
+        , Show (PP t x)
+        , Read (PP t x)
+        ) => P (ReadP' t p) x where
+  type PP (ReadP' t p) x = PP t x
+  eval _ opts x = do
+    let msg0 = "ReadP " <> t
+        t = showT @(PP t x)
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right s ->
+        let msg1 = msg0 <> " (" <> s <> ")"
+            hhs = [hh pp]
+        in case reads @(PP t x) s of
+           [(b,"")] -> mkNode opts (PresentT b) [lit01 opts msg1 b s] hhs
+           o -> mkNode opts (FailT (msg1 <> " failed")) [msg1 <> " failed " <> show o] hhs
+
+-- [] (a,s) (a,[])
+
+-- | Read but returns the Maybe of the value and any remaining unparsed string
+--
+-- >>> pz @(ReadMaybe Int Id) "123x"
+-- Present Just (123,"x")
+-- PresentT (Just (123,"x"))
+--
+-- >>> pz @(ReadMaybe Int Id) "123"
+-- Present Just (123,"")
+-- PresentT (Just (123,""))
+--
+-- >>> pz @(ReadMaybe Int Id) "x123"
+-- Present Nothing
+-- PresentT Nothing
+--
+data ReadMaybe' t p
+type ReadMaybe (t :: Type) p = ReadMaybe' (Hole t) p
+
+-- | emulates ReadP
+type ReadQ' t p = ReadMaybe' t p >> MaybeIn (Failp "read failed") (Guard "oops" (Snd Id >> Null) >> Fst Id)
+type ReadQ (t :: Type) p = ReadQ' (Hole t) p
+
+-- not as good as ReadQ
+-- type ReadZ' t p = ReadMaybe' t p >> JustFail "read failed" Id >> (Guard "oops" (Snd Id >> Null) >> Fst Id)
+
+instance (P p x
+        , PP p x ~ String
+        , Typeable (PP t x)
+        , Show (PP t x)
+        , Read (PP t x)
+        ) => P (ReadMaybe' t p) x where
+  type PP (ReadMaybe' t p) x = Maybe (PP t x, String)
+  eval _ opts x = do
+    let msg0 = "ReadMaybe " <> t
+        t = showT @(PP t x)
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right s ->
+        let msg1 = msg0 <> " (" <> s <> ")"
+            hhs = [hh pp]
+        in case reads @(PP t x) s of
+           [(b,rest)] -> mkNode opts (PresentT (Just (b,rest))) [lit01 opts msg1 b s] hhs
+           o -> mkNode opts (PresentT Nothing) [msg1 <> " failed " <> show o] hhs
+
+-- | similar to 'sum'
+--
+-- >>> pz @Sum [10,4,5,12,3,4]
+-- Present 38
+-- PresentT 38
+--
+-- >>> pz @Sum []
+-- Present 0
+-- PresentT 0
+--
+data Sum
+
+instance (Num a, Show a) => P Sum [a] where
+  type PP Sum [a] = a
+  eval _ opts as =
+    let msg0 = "Sum"
+        v = sum as
+    in pure $ mkNode opts (PresentT v) [show01 opts msg0 v as] []
+
+-- | similar to 'minimum'
+--
+-- >>> pz @Min [10,4,5,12,3,4]
+-- Present 3
+-- PresentT 3
+--
+-- >>> pz @Min []
+-- Error empty list
+-- FailT "empty list"
+--
+data Min
+
+instance (Ord a, Show a) => P Min [a] where
+  type PP Min [a] = a
+  eval _ opts as' = do
+    let msg0 = "Min"
+    pure $ case as' of
+     [] -> mkNode opts (FailT "empty list") [msg0 <> "(empty list)"] []
+     as@(_:_) ->
+       let v = minimum as
+       in mkNode opts (PresentT v) [show01 opts msg0 v as] []
+
+-- | similar to 'maximum'
+--
+-- >>> pz @Max [10,4,5,12,3,4]
+-- Present 12
+-- PresentT 12
+--
+-- >>> pz @Max []
+-- Error empty list
+-- FailT "empty list"
+--
+
+data Max
+
+instance (Ord a, Show a) => P Max [a] where
+  type PP Max [a] = a
+  eval _ opts as' = do
+    let msg0 = "Max"
+    pure $ case as' of
+      [] -> mkNode opts (FailT "empty list") [msg0 <> "(empty list)"] []
+      as@(_:_) ->
+        let v = maximum as
+        in mkNode opts (PresentT v) [show01 opts msg0 v as] []
+
+-- | sort a list
+--
+-- >>> pz @(SortOn (Fst Id) Id) [(10,"abc"), (3,"def"), (4,"gg"), (10,"xyz"), (1,"z")]
+-- Present [(1,"z"),(3,"def"),(4,"gg"),(10,"abc"),(10,"xyz")]
+-- PresentT [(1,"z"),(3,"def"),(4,"gg"),(10,"abc"),(10,"xyz")]
+--
+-- >>> pz @(SortBy (OrdP (Snd Id) (Fst Id)) Id) [(10,"ab"),(4,"x"),(20,"bbb")]
+-- Present [(20,"bbb"),(10,"ab"),(4,"x")]
+-- PresentT [(20,"bbb"),(10,"ab"),(4,"x")]
+--
+-- >>> pz @(SortBy 'LT Id) [1,5,2,4,7,0]
+-- Present [1,5,2,4,7,0]
+-- PresentT [1,5,2,4,7,0]
+--
+-- >>> pz @(SortBy 'GT Id) [1,5,2,4,7,0]
+-- Present [0,7,4,2,5,1]
+-- PresentT [0,7,4,2,5,1]
+--
+-- >>> pz @(SortBy ((Fst (Fst Id) ==! Fst (Snd Id)) <> (Snd (Fst Id) ==! Snd (Snd Id))) Id) [(10,"ab"),(4,"x"),(20,"bbb"),(4,"a"),(4,"y")]
+-- Present [(4,"a"),(4,"x"),(4,"y"),(10,"ab"),(20,"bbb")]
+-- PresentT [(4,"a"),(4,"x"),(4,"y"),(10,"ab"),(20,"bbb")]
+--
+-- >>> pz @(SortBy ((Fst (Fst Id) ==! Fst (Snd Id)) <> (Snd (Snd Id) ==! Snd (Fst Id))) Id) [(10,"ab"),(4,"x"),(20,"bbb"),(4,"a"),(4,"y")]
+-- Present [(4,"y"),(4,"x"),(4,"a"),(10,"ab"),(20,"bbb")]
+-- PresentT [(4,"y"),(4,"x"),(4,"a"),(10,"ab"),(20,"bbb")]
+--
+data SortBy p q
+type SortOn p q = SortBy (OrdA p) q
+type SortOnDesc p q = SortBy (Swap >> OrdA p) q
+
+type SortByHelper p = Partition (p == 'GT) Id
+
+instance (P p (a,a)
+        , P q x
+        , Show a
+        , PP q x ~ [a]
+        , PP p (a,a) ~ Ordering
+        ) => P (SortBy p q) x where
+  type PP (SortBy p q) x = PP q x
+  eval _ opts x = do
+    let msg0 = "SortBy"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts (msg0 <> " q failed") qq [] of
+      Left e -> pure e
+      Right as -> do
+        let ff :: MonadEval m => [a] -> m (TT [a])
+            ff = \case
+                [] -> pure $ mkNode opts (PresentT mempty) [msg0 <> " empty"] []
+                [w] -> pure $ mkNode opts (PresentT [w]) [msg0 <> " one element " <> show w] []
+                w:ys@(_:_) -> do
+                  pp <- (if isVerbose opts then
+                              eval (Proxy @(SortByHelper p))
+                         else eval (Proxy @(Hide (SortByHelper p)))) opts (map (w,) ys)
+--                  pp <- eval (Proxy @(Hide (Partition (p >> Id == 'GT) Id))) opts (map (w,) ys)
+-- too much output: dont need (Map (Snd Id) *** Map (Snd Id)) -- just do map snd in code
+--                  pp <- eval (Proxy @(Partition (p >> (Id == 'GT)) Id >> (Map (Snd Id) *** Map (Snd Id)))) opts (map (w,) ys)
+                  case getValueLR opts msg0 pp [] of
+                    Left e -> pure e
+                    Right (ll', rr') -> do
+                      lhs <- ff (map snd ll')
+                      case getValueLR opts msg0 lhs [] of
+                        Left _ -> pure lhs -- dont rewrap
+                        Right ll -> do
+                          rhs <- ff (map snd rr')
+                          case getValueLR opts msg0 rhs [] of
+                            Left _ -> pure rhs
+                            Right rr -> do
+                              pure $  mkNode opts (PresentT (ll ++ w : rr))
+                                     [msg0 <> show0 opts " lhs=" ll <> " pivot " <> show w <> show0 opts " rhs=" rr]
+                                     (hh pp : [hh lhs | length ll > 1] ++ [hh rhs | length rr > 1])
+        ret <- ff as
+        pure $ case getValueLR opts msg0 ret [hh qq] of
+          Left _e -> ret -- dont rewrap the error
+          Right xs -> mkNode opts (_tBool ret) [msg0 <> show0 opts " " xs] [hh qq, hh ret]
+
+-- | similar to 'length'
+--
+-- >>> pz @Len [10,4,5,12,3,4]
+-- Present 6
+-- PresentT 6
+--
+-- >>> pz @Len []
+-- Present 0
+-- PresentT 0
+--
+data Len
+instance (Show a, as ~ [a]) => P Len as where
+  type PP Len as = Int
+  eval _ opts as =
+    let msg0 = "Len"
+        n = length as
+    in pure $ mkNode opts (PresentT n) [show01 opts msg0 n as] []
+
+-- | similar to 'length' for 'Foldable' instances
+--
+-- >>> pz @(Length Id) (Left "aa")
+-- Present 0
+-- PresentT 0
+--
+-- >>> pz @(Length Id) (Right "aa")
+-- Present 1
+-- PresentT 1
+--
+-- >>> pz @(Length (Right' Id)) (Right "abcd")
+-- Present 4
+-- PresentT 4
+--
+-- >>> pz @(Length (Thd (Snd Id))) (True,(23,'x',[10,9,1,3,4,2]))
+-- Present 6
+-- PresentT 6
+--
+data Length p
+
+instance (PP p x ~ t a
+        , P p x
+        , Show (t a)
+        , Foldable t) => P (Length p) x where
+  type PP (Length p) x = Int
+  eval _ opts x = do
+    let msg0 = "Length"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+            let n = length p
+            in mkNode opts (PresentT n) [show01 opts msg0 n p] []
+
+-- | similar to 'fst'
+--
+-- >>> pz @(Fst Id) (10,"Abc")
+-- Present 10
+-- PresentT 10
+--
+-- >>> pz @(Fst Id) (10,"Abc",'x')
+-- Present 10
+-- PresentT 10
+--
+-- >>> pz @(Fst Id) (10,"Abc",'x',False)
+-- Present 10
+-- PresentT 10
+--
+data Fst p
+type L1 p = Fst p
+
+instance (Show (ExtractL1T (PP p x))
+        , ExtractL1C (PP p x)
+        , P p x
+        , Show (PP p x)
+        ) => P (Fst p) x where
+  type PP (Fst p) x = ExtractL1T (PP p x)
+  eval _ opts x = do
+    let msg0 = "Fst"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = extractL1C p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+class ExtractL1C tp where
+  type ExtractL1T tp
+  extractL1C :: tp -> ExtractL1T tp
+instance ExtractL1C (a,b) where
+  type ExtractL1T (a,b) = a
+  extractL1C (a,_) = a
+instance ExtractL1C (a,b,c) where
+  type ExtractL1T (a,b,c) = a
+  extractL1C (a,_,_) = a
+instance ExtractL1C (a,b,c,d) where
+  type ExtractL1T (a,b,c,d) = a
+  extractL1C (a,_,_,_) = a
+instance ExtractL1C (a,b,c,d,e) where
+  type ExtractL1T (a,b,c,d,e) = a
+  extractL1C (a,_,_,_,_) = a
+instance ExtractL1C (a,b,c,d,e,f) where
+  type ExtractL1T (a,b,c,d,e,f) = a
+  extractL1C (a,_,_,_,_,_) = a
+
+-- | similar to 'snd'
+--
+-- >>> pz @(Snd Id) (10,"Abc")
+-- Present "Abc"
+-- PresentT "Abc"
+--
+-- >>> pz @(Snd Id) (10,"Abc",True)
+-- Present "Abc"
+-- PresentT "Abc"
+--
+data Snd p
+type L2 p = Snd p
+
+instance (Show (ExtractL2T (PP p x))
+        , ExtractL2C (PP p x)
+        , P p x
+        , Show (PP p x)
+        ) => P (Snd p) x where
+  type PP (Snd p) x = ExtractL2T (PP p x)
+  eval _ opts x = do
+    let msg0 = "Snd"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = extractL2C p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+class ExtractL2C tp where
+  type ExtractL2T tp
+  extractL2C :: tp -> ExtractL2T tp
+instance ExtractL2C (a,b) where
+  type ExtractL2T (a,b) = b
+  extractL2C (_,b) = b
+instance ExtractL2C (a,b,c) where
+  type ExtractL2T (a,b,c) = b
+  extractL2C (_,b,_) = b
+instance ExtractL2C (a,b,c,d) where
+  type ExtractL2T (a,b,c,d) = b
+  extractL2C (_,b,_,_) = b
+instance ExtractL2C (a,b,c,d,e) where
+  type ExtractL2T (a,b,c,d,e) = b
+  extractL2C (_,b,_,_,_) = b
+instance ExtractL2C (a,b,c,d,e,f) where
+  type ExtractL2T (a,b,c,d,e,f) = b
+  extractL2C (_,b,_,_,_,_) = b
+
+-- | similar to 3rd element in a n-tuple
+--
+-- >>> pz @(Thd Id) (10,"Abc",133)
+-- Present 133
+-- PresentT 133
+--
+-- >>> pz @(Thd Id) (10,"Abc",133,True)
+-- Present 133
+-- PresentT 133
+--
+data Thd p
+type L3 p = Thd p
+
+instance (Show (ExtractL3T (PP p x))
+        , ExtractL3C (PP p x)
+        , P p x
+        , Show (PP p x)
+        ) => P (Thd p) x where
+  type PP (Thd p) x = ExtractL3T (PP p x)
+  eval _ opts x = do
+    let msg0 = "Thd"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = extractL3C p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+class ExtractL3C tp where
+  type ExtractL3T tp
+  extractL3C :: tp -> ExtractL3T tp
+instance ExtractL3C (a,b) where
+  type ExtractL3T (a,b) = GL.TypeError ('GL.Text "Thd doesn't work for 2-tuples")
+  extractL3C _ = error "Thd doesn't work for 2-tuples"
+instance ExtractL3C (a,b,c) where
+  type ExtractL3T (a,b,c) = c
+  extractL3C (_,_,c) = c
+instance ExtractL3C (a,b,c,d) where
+  type ExtractL3T (a,b,c,d) = c
+  extractL3C (_,_,c,_) = c
+instance ExtractL3C (a,b,c,d,e) where
+  type ExtractL3T (a,b,c,d,e) = c
+  extractL3C (_,_,c,_,_) = c
+instance ExtractL3C (a,b,c,d,e,f) where
+  type ExtractL3T (a,b,c,d,e,f) = c
+  extractL3C (_,_,c,_,_,_) = c
+
+-- | similar to 4th element in a n-tuple
+--
+-- >>> pz @(L4 Id) (10,"Abc",'x',True)
+-- Present True
+-- PresentT True
+--
+-- >>> pz @(L4 (Fst (Snd Id))) ('x',((10,"Abc",'x',999),"aa",1),9)
+-- Present 999
+-- PresentT 999
+--
+data L4 p
+
+instance (Show (ExtractL4T (PP p x))
+        , ExtractL4C (PP p x)
+        , P p x
+        , Show (PP p x)
+        ) => P (L4 p) x where
+  type PP (L4 p) x = ExtractL4T (PP p x)
+  eval _ opts x = do
+    let msg0 = "L4"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = extractL4C p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+class ExtractL4C tp where
+  type ExtractL4T tp
+  extractL4C :: tp -> ExtractL4T tp
+instance ExtractL4C (a,b) where
+  type ExtractL4T (a,b) = GL.TypeError ('GL.Text "L4 doesn't work for 2-tuples")
+  extractL4C _ = error "L4 doesn't work for 2-tuples"
+instance ExtractL4C (a,b,c) where
+  type ExtractL4T (a,b,c) = GL.TypeError ('GL.Text "L4 doesn't work for 3-tuples")
+  extractL4C _ = error "L4 doesn't work for 3-tuples"
+instance ExtractL4C (a,b,c,d) where
+  type ExtractL4T (a,b,c,d) = d
+  extractL4C (_,_,_,d) = d
+instance ExtractL4C (a,b,c,d,e) where
+  type ExtractL4T (a,b,c,d,e) = d
+  extractL4C (_,_,_,d,_) = d
+instance ExtractL4C (a,b,c,d,e,f) where
+  type ExtractL4T (a,b,c,d,e,f) = d
+  extractL4C (_,_,_,d,_,_) = d
+
+-- | similar to 5th element in a n-tuple
+--
+-- >>> pz @(L5 Id) (10,"Abc",'x',True,1)
+-- Present 1
+-- PresentT 1
+--
+data L5 p
+
+instance (Show (ExtractL5T (PP p x))
+        , ExtractL5C (PP p x)
+        , P p x
+        , Show (PP p x)
+        ) => P (L5 p) x where
+  type PP (L5 p) x = ExtractL5T (PP p x)
+  eval _ opts x = do
+    let msg0 = "L5"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = extractL5C p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+class ExtractL5C tp where
+  type ExtractL5T tp
+  extractL5C :: tp -> ExtractL5T tp
+instance ExtractL5C (a,b) where
+  type ExtractL5T (a,b) = GL.TypeError ('GL.Text "L5 doesn't work for 2-tuples")
+  extractL5C _ = error "L5 doesn't work for 2-tuples"
+instance ExtractL5C (a,b,c) where
+  type ExtractL5T (a,b,c) = GL.TypeError ('GL.Text "L5 doesn't work for 3-tuples")
+  extractL5C _ = error "L5 doesn't work for 3-tuples"
+instance ExtractL5C (a,b,c,d) where
+  type ExtractL5T (a,b,c,d) = GL.TypeError ('GL.Text "L5 doesn't work for 4-tuples")
+  extractL5C _ = error "L5 doesn't work for 4-tuples"
+instance ExtractL5C (a,b,c,d,e) where
+  type ExtractL5T (a,b,c,d,e) = e
+  extractL5C (_,_,_,_,e) = e
+instance ExtractL5C (a,b,c,d,e,f) where
+  type ExtractL5T (a,b,c,d,e,f) = e
+  extractL5C (_,_,_,_,e,_) = e
+
+
+-- | similar to 6th element in a n-tuple
+--
+-- >>> pz @(L6 Id) (10,"Abc",'x',True,1,99)
+-- Present 99
+-- PresentT 99
+--
+data L6 p
+
+instance (Show (ExtractL6T (PP p x))
+        , ExtractL6C (PP p x)
+        , P p x
+        , Show (PP p x)
+        ) => P (L6 p) x where
+  type PP (L6 p) x = ExtractL6T (PP p x)
+  eval _ opts x = do
+    let msg0 = "L6"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = extractL6C p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+class ExtractL6C tp where
+  type ExtractL6T tp
+  extractL6C :: tp -> ExtractL6T tp
+instance ExtractL6C (a,b) where
+  type ExtractL6T (a,b) = GL.TypeError ('GL.Text "L6 doesn't work for 2-tuples")
+  extractL6C _ = error "L6 doesn't work for 2-tuples"
+instance ExtractL6C (a,b,c) where
+  type ExtractL6T (a,b,c) = GL.TypeError ('GL.Text "L6 doesn't work for 3-tuples")
+  extractL6C _ = error "L6 doesn't work for 3-tuples"
+instance ExtractL6C (a,b,c,d) where
+  type ExtractL6T (a,b,c,d) = GL.TypeError ('GL.Text "L6 doesn't work for 4-tuples")
+  extractL6C _ = error "L6 doesn't work for 4-tuples"
+instance ExtractL6C (a,b,c,d,e) where
+  type ExtractL6T (a,b,c,d,e) = GL.TypeError ('GL.Text "L6 doesn't work for 5-tuples")
+  extractL6C _ = error "L6 doesn't work for 5-tuples"
+instance ExtractL6C (a,b,c,d,e,f) where
+  type ExtractL6T (a,b,c,d,e,f) = f
+  extractL6C (_,_,_,_,_,f) = f
+
+
+-- | 'fromString' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(FromStringP (Identity _) Id) "abc"
+-- Present Identity "abc"
+-- PresentT (Identity "abc")
+--
+-- >>> pz @(FromStringP (Seq.Seq _) Id) "abc"
+-- Present fromList "abc"
+-- PresentT (fromList "abc")
+data FromStringP' t s
+type FromStringP (t :: Type) p = FromStringP' (Hole t) p
+
+instance (P s a
+        , PP s a ~ String
+        , Show (PP t a)
+        , IsString (PP t a)
+        ) => P (FromStringP' t s) a where
+  type PP (FromStringP' t s) a = PP t a
+  eval _ opts a = do
+    let msg0 = "FromStringP"
+    ss <- eval (Proxy @s) opts a
+    pure $ case getValueLR opts msg0 ss [] of
+      Left e -> e
+      Right s ->
+        let b = fromString @(PP t a) s
+        in mkNode opts (PresentT b) [msg0 <> show0 opts " " b] [hh ss]
+
+
+-- | 'fromInteger' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(FromInteger (SG.Sum _) Id) 23
+-- Present Sum {getSum = 23}
+-- PresentT (Sum {getSum = 23})
+--
+-- >>> pz @(FromInteger Rational 44) 12
+-- Present 44 % 1
+-- PresentT (44 % 1)
+--
+-- >>> pz @(FromInteger Rational Id) 12
+-- Present 12 % 1
+-- PresentT (12 % 1)
+--
+data FromInteger' t n
+type FromInteger (t :: Type) p = FromInteger' (Hole t) p
+--type FromIntegerP n = FromInteger' Unproxy n
+
+instance (Num (PP t a)
+        , Integral (PP n a)
+        , P n a
+        , Show (PP t a)
+        ) => P (FromInteger' t n) a where
+  type PP (FromInteger' t n) a = PP t a
+  eval _ opts a = do
+    let msg0 = "FromInteger"
+    nn <- eval (Proxy @n) opts a
+    pure $ case getValueLR opts msg0 nn [] of
+      Left e -> e
+      Right n ->
+        let b = fromInteger (fromIntegral n)
+        in mkNode opts (PresentT b) [msg0 <> show0 opts " " b] [hh nn]
+
+-- | 'fromIntegral' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(FromIntegral (SG.Sum _) Id) 23
+-- Present Sum {getSum = 23}
+-- PresentT (Sum {getSum = 23})
+data FromIntegral' t n
+type FromIntegral (t :: Type) p = FromIntegral' (Hole t) p
+
+instance (Num (PP t a)
+        , Integral (PP n a)
+        , P n a
+        , Show (PP t a)
+        , Show (PP n a)
+        ) => P (FromIntegral' t n) a where
+  type PP (FromIntegral' t n) a = PP t a
+  eval _ opts a = do
+    let msg0 = "FromIntegral"
+    nn <- eval (Proxy @n) opts a
+    pure $ case getValueLR opts msg0 nn [] of
+      Left e -> e
+      Right n ->
+        let b = fromIntegral n
+        in mkNode opts (PresentT b) [show01 opts msg0 b n] [hh nn]
+
+-- | 'toRational' function
+--
+-- >>> pz @(ToRational Id) 23.5
+-- Present 47 % 2
+-- PresentT (47 % 2)
+
+data ToRational p
+
+instance (a ~ PP p x
+         , Show a
+         , Real a
+         , P p x)
+   => P (ToRational p) x where
+  type PP (ToRational p) x = Rational
+  eval _ opts x = do
+    let msg0 = "ToRational"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right a ->
+        let r = (toRational a)
+        in mkNode opts (PresentT r) [show01 opts msg0 r a] [hh pp]
+
+-- | 'fromRational' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(FromRational Rational Id) 23.5
+-- Present 47 % 2
+-- PresentT (47 % 2)
+data FromRational' t r
+type FromRational (t :: Type) p = FromRational' (Hole t) p
+
+instance (P r a
+        , PP r a ~ Rational
+        , Show (PP t a)
+        , Fractional (PP t a)
+        ) => P (FromRational' t r) a where
+  type PP (FromRational' t r) a = PP t a
+  eval _ opts a = do
+    let msg0 = "FromRational"
+    rr <- eval (Proxy @r) opts a
+    pure $ case getValueLR opts msg0 rr [] of
+      Left e -> e
+      Right r ->
+        let b = fromRational @(PP t a) r
+        in mkNode opts (PresentT b) [show01 opts msg0 b r] [hh rr]
+
+-- | 'truncate' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(Truncate Int Id) (23 % 5)
+-- Present 4
+-- PresentT 4
+data Truncate' t p
+type Truncate (t :: Type) p = Truncate' (Hole t) p
+
+instance (Show (PP p x)
+        , P p x
+        , Show (PP t x)
+        , RealFrac (PP p x)
+        , Integral (PP t x)
+        ) => P (Truncate' t p) x where
+  type PP (Truncate' t p) x = PP t x
+  eval _ opts x = do
+    let msg0 = "Truncate"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = truncate p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+-- | 'ceiling' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(Ceiling Int Id) (23 % 5)
+-- Present 5
+-- PresentT 5
+data Ceiling' t p
+type Ceiling (t :: Type) p = Ceiling' (Hole t) p
+
+instance (Show (PP p x)
+        , P p x
+        , Show (PP t x)
+        , RealFrac (PP p x)
+        , Integral (PP t x)
+        ) => P (Ceiling' t p) x where
+  type PP (Ceiling' t p) x = PP t x
+  eval _ opts x = do
+    let msg0 = "Ceiling"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = ceiling p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+-- | 'floor' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(Floor Int Id) (23 % 5)
+-- Present 4
+-- PresentT 4
+data Floor' t p
+type Floor (t :: Type) p = Floor' (Hole t) p
+
+instance (Show (PP p x)
+        , P p x
+        , Show (PP t x)
+        , RealFrac (PP p x)
+        , Integral (PP t x)
+        ) => P (Floor' t p) x where
+  type PP (Floor' t p) x = PP t x
+  eval _ opts x = do
+    let msg0 = "Floor"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = floor p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+-- | converts a value to a 'Proxy': the same as '\'Proxy'
+--
+-- >>> pz @MkProxy 'x'
+-- Present Proxy
+-- PresentT Proxy
+--
+data MkProxy
+
+instance Show a => P MkProxy a where
+  type PP MkProxy a = Proxy a
+  eval _ opts a =
+    let msg0 = "MkProxy"
+        b = Proxy @a
+    in pure $ mkNode opts (PresentT b) [msg0 <> show1 opts " | " a] []
+
+type family DoExpandT (ps :: [k]) :: Type where
+  DoExpandT '[] = GL.TypeError ('GL.Text "'[] invalid: requires at least one predicate in the list")
+  DoExpandT '[p] = Id >> p -- need this else fails cos 1 is nat and would mean that the result is nat not Type!
+  -- if p >> Id then turns TrueT to PresentT True
+  DoExpandT (p ': p1 ': ps) = p >> DoExpandT (p1 ': ps)
+
+-- | processes a type level list predicates running each in sequence: see 'Predicate.>>'
+--
+-- >>> pz @(Do [Pred Id, ShowP Id, Id &&& Len]) 9876543
+-- Present ("9876542",7)
+-- PresentT ("9876542",7)
+--
+-- >>> pz @(Do '[W 123, W "xyz", Len &&& Id, Pred Id *** Id<>Id]) ()
+-- Present (2,"xyzxyz")
+-- PresentT (2,"xyzxyz")
+--
+data Do (ps :: [k])
+instance (P (DoExpandT ps) a) => P (Do ps) a where
+  type PP (Do ps) a = PP (DoExpandT ps) a
+  eval _ = eval (Proxy @(DoExpandT ps))
+
+-- | Convenient method to convert a value \'p\' to a 'Maybe' based on a predicate '\b\'
+-- if '\b\' then Just \'p'\ else Nothing
+--
+-- >>> pz @(MaybeBool (Id > 4) Id) 24
+-- Present Just 24
+-- PresentT (Just 24)
+--
+-- >>> pz @(MaybeBool (Id > 4) Id) (-5)
+-- Present Nothing
+-- PresentT Nothing
+--
+data MaybeBool b p
+
+instance (Show (PP p a)
+        , P b a
+        , P p a
+        , PP b a ~ Bool
+        ) => P (MaybeBool b p) a where
+  type PP (MaybeBool b p) a = Maybe (PP p a)
+  eval _ opts z = do
+    let msg0 = "MaybeBool"
+    bb <- evalBool (Proxy @b) opts z
+    case getValueLR opts (msg0 <> " b failed") bb [] of
+      Left e -> pure e
+      Right True -> do
+        pp <- eval (Proxy @p) opts z
+        pure $ case getValueLR opts (msg0 <> " p failed") pp [hh bb] of
+          Left e -> e
+          Right p -> mkNode opts (PresentT (Just p)) [msg0 <> "(False)" <> show0 opts " Just " p] [hh bb, hh pp]
+      Right False -> pure $ mkNode opts (PresentT Nothing) [msg0 <> "(True)"] [hh bb]
+
+-- | Convenient method to convert a \'p\' or '\q'\ to a 'Either' based on a predicate '\b\'
+-- if \'b\' then Right \'p\' else Left '\q\'
+--
+-- >>> pz @(EitherBool (Fst Id > 4) (Snd Id >> Fst Id) (Snd Id >> Snd Id)) (24,(-1,999))
+-- Present Right 999
+-- PresentT (Right 999)
+--
+-- >>> pz @(EitherBool (Fst Id > 4) (Fst (Snd Id)) (Snd (Snd Id))) (1,(-1,999))
+-- Present Left (-1)
+-- PresentT (Left (-1))
+--
+data EitherBool b p q
+
+instance (Show (PP p a)
+        , P p a
+        , Show (PP q a)
+        , P q a
+        , P b a
+        , PP b a ~ Bool
+        ) => P (EitherBool b p q) a where
+  type PP (EitherBool b p q) a = Either (PP p a) (PP q a)
+  eval _ opts z = do
+    let msg0 = "EitherBool"
+    bb <- evalBool (Proxy @b) opts z
+    case getValueLR opts (msg0 <> " b failed") bb [] of
+      Left e -> pure e
+      Right False -> do
+        pp <- eval (Proxy @p) opts z
+        pure $ case getValueLR opts (msg0 <> " p failed") pp [hh bb] of
+          Left e -> e
+          Right p -> mkNode opts (PresentT (Left p)) [msg0 <> "(False)" <> show0 opts " Left " p] [hh bb, hh pp]
+      Right True -> do
+        qq <- eval (Proxy @q) opts z
+        pure $ case getValueLR opts (msg0 <> " q failed") qq [hh bb] of
+          Left e -> e
+          Right q -> mkNode opts (PresentT (Right q)) [msg0 <> "(True)" <> show0 opts " Right " q] [hh bb, hh qq]
+
+-- | pad \'q\' with '\n'\ values from '\p'\
+--
+-- >>> pz @(PadL 5 999 Id) [12,13]
+-- Present [999,999,999,12,13]
+-- PresentT [999,999,999,12,13]
+--
+-- >>> pz @(PadR 5 (Fst Id) '[12,13]) (999,'x')
+-- Present [12,13,999,999,999]
+-- PresentT [12,13,999,999,999]
+--
+-- >>> pz @(PadR 2 (Fst Id) '[12,13,14]) (999,'x')
+-- Present [12,13,14]
+-- PresentT [12,13,14]
+--
+data Pad (left :: Bool) n p q
+type PadL n p q = Pad 'True n p q
+type PadR n p q = Pad 'False n p q
+
+instance (P n a
+        , GetBool left
+        , Integral (PP n a)
+        , [PP p a] ~ PP q a
+        , P p a
+        , P q a
+        , Show (PP p a)
+        ) => P (Pad left n p q) a where
+  type PP (Pad left n p q) a = PP q a
+  eval _ opts a = do
+    let msg0 = "Pad" <> (if lft then "L" else "R")
+        lft = getBool @left
+    lr <- runPQ msg0 (Proxy @n) (Proxy @p) opts a []
+    case lr of
+      Left e -> pure e
+      Right (fromIntegral -> n,p,nn,pp) -> do
+        let msg1 = msg0 <> show0 opts " " n <> " pad=" <> show p
+            hhs = [hh nn, hh pp]
+        qq <- eval (Proxy @q) opts a
+        pure $ case getValueLR opts (msg1 <> " q failed") qq hhs of
+          Left e -> e
+          Right q ->
+            let l = length q
+                diff = if n<=l then 0 else n-l
+                bs = if lft
+                     then (replicate diff p) <> q
+                     else q <> (replicate diff p)
+            in mkNode opts (PresentT bs) [show01 opts msg1 bs q] (hhs <> [hh qq])
+
+-- | split a list \'p\' into parts using the lengths in the type level list \'ns\'
+--
+-- >>> pz @(SplitAts '[2,3,1,1] Id) "hello world"
+-- Present ["he","llo"," ","w","orld"]
+-- PresentT ["he","llo"," ","w","orld"]
+--
+-- >>> pz @(SplitAts '[2] Id) "hello world"
+-- Present ["he","llo world"]
+-- PresentT ["he","llo world"]
+--
+-- >>> pz @(SplitAts '[10,1,1,5] Id) "hello world"
+-- Present ["hello worl","d","",""]
+-- PresentT ["hello worl","d","",""]
+--
+data SplitAts ns p
+instance (P ns x
+        , P p x
+        , PP p x ~ [a]
+        , Show n
+        , Show a
+        , PP ns x ~ [n]
+        , Integral n
+        ) => P (SplitAts ns p) x where
+  type PP (SplitAts ns p) x = [PP p x]
+  eval _ opts x = do
+    let msg0 = "SplitAts"
+    lr <- runPQ msg0 (Proxy @ns) (Proxy @p) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (ns,p,nn,pp) ->
+        let zs = foldr (\n k s -> let (a,b) = splitAt (fromIntegral n) s
+                              in a:k b
+                   ) (\as -> if null as then [] else [as]) ns p
+        in mkNode opts (PresentT zs) [show01' opts msg0 zs "ns=" ns <> show1 opts " | " p] [hh nn, hh pp]
+
+-- | similar to 'splitAt'
+--
+-- >>> pz @(SplitAt 4 Id) "hello world"
+-- Present ("hell","o world")
+-- PresentT ("hell","o world")
+--
+-- >>> pz @(SplitAt 20 Id) "hello world"
+-- Present ("hello world","")
+-- PresentT ("hello world","")
+--
+-- >>> pz @(SplitAt 0 Id) "hello world"
+-- Present ("","hello world")
+-- PresentT ("","hello world")
+--
+-- >>> pz @(SplitAt (Snd Id) (Fst Id)) ("hello world",4)
+-- Present ("hell","o world")
+-- PresentT ("hell","o world")
+--
+data SplitAt n p
+type Take n p = Fst (SplitAt n p)
+type Drop n p = Snd (SplitAt n p)
+
+instance (PP p a ~ [b]
+        , P n a
+        , P p a
+        , Show b
+        , Integral (PP n a)
+        ) => P (SplitAt n p) a where
+  type PP (SplitAt n p) a = (PP p a, PP p a)
+  eval _ opts a = do
+    let msg0 = "SplitAt"
+    lr <- runPQ msg0 (Proxy @n) (Proxy @p) opts a []
+    pure $ case lr of
+      Left e -> e -- (Left e, tt')
+      Right (fromIntegral -> n,p,pp,qq) ->
+        let msg1 = msg0 <> show0 opts " " n <> show0 opts " " p
+            (x,y) = splitAt n p
+            ret = (x,y)
+       in mkNode opts (PresentT ret) [show01' opts msg1 ret "n=" n <> show1 opts " | " p] [hh pp, hh qq]
+
+--type Tail = Uncons >> 'Just (Snd Id)
+--type Head = Uncons >> 'Just (Fst Id)
+--type Init = Unsnoc >> 'Just (Fst Id)
+--type Last = Unsnoc >> 'Just (Snd Id)
+
+-- | similar to 'Control.Arrow.&&&'
+type p &&& q = W '(p, q)
+infixr 3 &&&
+
+-- | similar to 'Control.Arrow.***'
+--
+-- >>> pz @(Pred Id *** ShowP Id) (13, True)
+-- Present (12,"True")
+-- PresentT (12,"True")
+--
+data p *** q
+infixr 3 ***
+type First p = p *** I
+type Second q = I *** q
+
+instance (Show (PP p a)
+        , Show (PP q b)
+        , P p a
+        , P q b
+        , Show a
+        , Show b
+        ) => P (p *** q) (a,b) where
+  type PP (p *** q) (a,b) = (PP p a, PP q b)
+  eval _ opts (a,b) = do
+    let msg0 = "(***)"
+    pp <- eval (Proxy @p) opts a
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right a1 -> do
+        qq <- eval (Proxy @q) opts b
+        pure $ case getValueLR opts msg0 qq [hh pp] of
+          Left e -> e
+          Right b1 -> mkNode opts (PresentT (a1,b1)) [msg0 <> show0 opts " " (a1,b1) <> show1 opts " | " (a,b)] [hh pp, hh qq]
+
+-- | similar 'Control.Arrow.|||'
+--
+-- >>> pz @(Pred Id ||| Id) (Left 13)
+-- Present 12
+-- PresentT 12
+--
+-- >>> pz @(ShowP Id ||| Id) (Right "hello")
+-- Present "hello"
+-- PresentT "hello"
+--
+data p ||| q
+infixr 2 |||
+type EitherIn p q = p ||| q
+type IsLeft = 'True ||| 'False
+type IsRight = 'False ||| 'True
+
+instance (Show (PP p a)
+        , P p a
+        , P q b
+        , PP p a ~ PP q b
+        , Show a
+        , Show b
+        ) => P (p ||| q) (Either a b) where
+  type PP (p ||| q) (Either a b) = PP p a
+  eval _ opts lr = do
+    let msg0 = "(|||)"
+    case lr of
+      Left a -> do
+        pp <- eval (Proxy @p) opts a
+        pure $ case getValueLR opts msg0 pp [] of
+          Left e -> e
+          Right a1 -> let msg1 = msg0 ++ " Left"
+                      in mkNode opts (_tBool pp) [show01 opts msg1 a1 a] [hh pp]
+      Right a -> do
+        qq <- eval (Proxy @q) opts a
+        pure $ case getValueLR opts msg0 qq [] of
+          Left e -> e
+          Right a1 ->
+            let msg1 = msg0 ++ " Right"
+            in mkNode opts (_tBool qq) [show01 opts msg1 a1 a] [hh qq]
+
+-- | similar 'Control.Arrow.+++'
+--
+-- >>> pz @(Pred Id +++ Id) (Left 13)
+-- Present Left 12
+-- PresentT (Left 12)
+--
+-- >>> pz @(ShowP Id +++ Reverse) (Right "hello")
+-- Present Right "olleh"
+-- PresentT (Right "olleh")
+--
+data p +++ q
+infixr 2 +++
+
+instance (Show (PP p a)
+        , Show (PP q b)
+        , P p a
+        , P q b
+        , Show a
+        , Show b
+        ) => P (p +++ q) (Either a b) where
+  type PP (p +++ q) (Either a b) = Either (PP p a) (PP q b)
+  eval _ opts lr = do
+    let msg0 = "(+++)"
+    case lr of
+      Left a -> do
+        pp <- eval (Proxy @p) opts a
+        pure $ case getValueLR opts msg0 pp [] of
+          Left e -> e
+          Right a1 ->
+            let msg1 = msg0 ++ " Left"
+            in mkNode opts (PresentT (Left a1)) [msg1 <> show0 opts " " a1 <> show1 opts " | " a] [hh pp]
+      Right a -> do
+        qq <- eval (Proxy @q) opts a
+        pure $ case getValueLR opts msg0 qq [] of
+          Left e -> e
+          Right a1 ->
+            let msg1 = msg0 ++ " Right"
+            in mkNode opts (PresentT (Right a1)) [msg1 <> show0 opts " " a1 <> show1 opts " | " a] [hh qq]
+
+type Dup = '(Id, Id)
+
+data BinOp = BMult | BSub | BAdd deriving (Show,Eq)
+
+type Mult p q = Bin 'BMult p q
+type Add p q = Bin 'BAdd p q
+type Sub p q = Bin 'BSub p q
+
+type p + q = Add p q
+infixl 6 +
+type p - q = Sub p q
+infixl 6 -
+type p * q = Mult p q
+infixl 7 *
+
+type p > q = Cmp 'Cgt p q
+infix 4 >
+type p >= q = Cmp 'Cge p q
+infix 4 >=
+type p == q = Cmp 'Ceq p q
+infix 4 ==
+type p /= q = Cmp 'Cne p q
+infix 4 /=
+type p <= q = Cmp 'Cle p q
+infix 4 <=
+type p < q = Cmp 'Clt p q
+infix 4 <
+
+type Gt n = Cmp 'Cgt I n
+type Ge n = Cmp 'Cge I n
+type Same n = Cmp 'Ceq I n
+type Le n = Cmp 'Cle I n
+type Lt n = Cmp 'Clt I n
+type Ne n = Cmp 'Cne I n
+
+type p >~ q = CmpI 'Cgt p q
+infix 4 >~
+type p >=~ q = CmpI 'Cge p q
+infix 4 >=~
+type p ==~ q = CmpI 'Ceq p q
+infix 4 ==~
+type p /=~ q = CmpI 'Cne p q
+infix 4 /=~
+type p <=~ q = CmpI 'Cle p q
+infix 4 <=~
+type p <~ q = CmpI 'Clt p q
+infix 4 <~
+
+class GetBinOp (k :: BinOp) where
+  getBinOp :: (Num a, a ~ b) => (String, a -> b -> a)
+
+instance GetBinOp 'BMult where
+  getBinOp = ("*",(*))
+instance GetBinOp 'BSub where
+  getBinOp = ("-",(-))
+instance GetBinOp 'BAdd where
+  getBinOp = ("+",(+))
+
+-- | addition, multiplication and subtraction
+--
+-- >>> pz @(Fst Id * Snd Id) (13,5)
+-- Present 65
+-- PresentT 65
+--
+-- >>> pz @(Fst Id + 4 * Length (Snd Id) - 4) (3,"hello")
+-- Present 19
+-- PresentT 19
+--
+data Bin (op :: BinOp) p q
+
+instance (GetBinOp op
+        , PP p a ~ PP q a
+        , P p a
+        , P q a
+        , Show (PP p a)
+        , Num (PP p a)
+        ) => P (Bin op p q) a where
+  type PP (Bin op p q) a = PP p a
+  eval _ opts a = do
+    let (s,f) = getBinOp @op
+    lr <- runPQ s (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let d = p `f` q
+        in mkNode opts (PresentT d) [show p <> " " <> s <> " " <> show q <> " = " <> show d] [hh pp, hh qq]
+
+-- | fractional division
+--
+-- >>> pz @(Fst Id / Snd Id) (13,2)
+-- Present 6.5
+-- PresentT 6.5
+--
+-- >>> pz @(ToRational 13 / Id) 0
+-- Error (/) zero denominator
+-- FailT "(/) zero denominator"
+--
+-- >>> pz @(12 % 7 / 14 % 5 + Id) 12.4
+-- Present 3188 % 245
+-- PresentT (3188 % 245)
+--
+data p / q
+infixl 7 /
+
+instance (PP p a ~ PP q a
+        , Eq (PP q a)
+        , P p a
+        , P q a
+        , Show (PP p a)
+        , Fractional (PP p a)
+        ) => P (p / q) a where
+  type PP (p / q) a = PP p a
+  eval _ opts a = do
+    let msg0 = "(/)"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq)
+         | q == 0 -> let msg1 = msg0 <> " zero denominator"
+                     in mkNode opts (FailT msg1) [msg1] [hh pp, hh qq]
+         | otherwise ->
+            let d = p / q
+            in mkNode opts (PresentT d) [show p <> " / " <> show q <> " = " <> show d] [hh pp, hh qq]
+
+-- | creates a 'Rational' value
+--
+-- >>> pz @(Id < 21 % 5) (-3.1)
+-- True
+-- TrueT
+--
+-- >>> pz @(Id < 21 % 5) 4.5
+-- False
+-- FalseT
+--
+-- >>> pz @(Fst Id % Snd Id) (13,2)
+-- Present 13 % 2
+-- PresentT (13 % 2)
+--
+-- >>> pz @(13 % Id) 0
+-- Error MkRatio zero denominator
+-- FailT "MkRatio zero denominator"
+--
+-- >>> pz @(4 % 3 + 5 % 7) "asfd"
+-- Present 43 % 21
+-- PresentT (43 % 21)
+--
+-- >>> pz @(4 %- 7 * 5 %- 3) "asfd"
+-- Present 20 % 21
+-- PresentT (20 % 21)
+--
+-- >>> pz @(Negate (14 % 3)) ()
+-- Present (-14) % 3
+-- PresentT ((-14) % 3)
+--
+-- >>> pz @(14 % 3) ()
+-- Present 14 % 3
+-- PresentT (14 % 3)
+--
+-- >>> pz @(Negate (14 % 3) ==! FromIntegral _ (Negate 5)) ()
+-- Present GT
+-- PresentT GT
+--
+-- >>> pz @(14 -% 3 ==! 5 %- 1) "aa"
+-- Present GT
+-- PresentT GT
+--
+-- >>> pz @(Negate (14 % 3) ==! Negate 5 % 2) ()
+-- Present LT
+-- PresentT LT
+--
+-- >>> pz @(14 -% 3 * 5 -% 1) ()
+-- Present 70 % 3
+-- PresentT (70 % 3)
+--
+-- >>> pz @(14 % 3 ==! 5 % 1) ()
+-- Present LT
+-- PresentT LT
+--
+-- >>> pz @(15 % 3 / 4 % 2) ()
+-- Present 5 % 2
+-- PresentT (5 % 2)
+--
+data p % q
+infixl 8 %
+
+type p %- q = Negate (p % q)
+infixl 8 %-
+type p -% q = Negate (p % q)
+infixl 8 -%
+
+instance (Integral (PP p x)
+        , Integral (PP q x)
+        , Eq (PP q x)
+        , P p x
+        , P q x
+        , Show (PP p x)
+        , Show (PP q x)
+        ) => P (p % q) x where
+  type PP (p % q) x = Rational
+  eval _ opts x = do
+    let msg0 = "MkRatio"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq)
+         | q == 0 -> let msg1 = msg0 <> " zero denominator"
+                     in mkNode opts (FailT msg1) [msg1] [hh pp, hh qq]
+         | otherwise ->
+            let d = fromIntegral p % fromIntegral q
+            in mkNode opts (PresentT d) [show p <> " % " <> show q <> " = " <> show d] [hh pp, hh qq]
+
+
+-- | similar to 'negate'
+--
+-- >>> pz @(Negate Id) 14
+-- Present -14
+-- PresentT (-14)
+--
+-- >>> pz @(Negate (Fst Id * Snd Id)) (14,3)
+-- Present -42
+-- PresentT (-42)
+--
+-- >>> pz @(Negate (15 %- 4)) "abc"
+-- Present 15 % 4
+-- PresentT (15 % 4)
+--
+-- >>> pz @(Negate (15 % 3)) ()
+-- Present (-5) % 1
+-- PresentT ((-5) % 1)
+--
+-- >>> pz @(Negate (Fst Id % Snd Id)) (14,3)
+-- Present (-14) % 3
+-- PresentT ((-14) % 3)
+--
+data Negate p
+
+instance (Show (PP p x), Num (PP p x), P p x) => P (Negate p) x where
+  type PP (Negate p) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Negate"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = negate p
+        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
+
+
+-- | similar to 'abs'
+--
+-- >>> pz @(Abs Id) (-14)
+-- Present 14
+-- PresentT 14
+--
+-- >>> pz @(Abs (Snd Id)) ("xx",14)
+-- Present 14
+-- PresentT 14
+--
+-- >>> pz @(Abs Id) 0
+-- Present 0
+-- PresentT 0
+--
+-- >>> pz @(Abs (Negate 44)) "aaa"
+-- Present 44
+-- PresentT 44
+--
+data Abs p
+
+instance (Show (PP p x), Num (PP p x), P p x) => P (Abs p) x where
+  type PP (Abs p) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Abs"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = abs p
+        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
+
+
+
+-- | similar to 'signum'
+--
+-- >>> pz @(Signum Id) (-14)
+-- Present -1
+-- PresentT (-1)
+--
+-- >>> pz @(Signum Id) 14
+-- Present 1
+-- PresentT 1
+--
+-- >>> pz @(Signum Id) 0
+-- Present 0
+-- PresentT 0
+--
+data Signum p
+
+instance (Show (PP p x), Num (PP p x), P p x) => P (Signum p) x where
+  type PP (Signum p) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Signum"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = signum p
+        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
+
+-- | unwraps a value (see '_Wrapped'')
+--
+-- >>> pz @(Unwrap Id) (SG.Sum (-13))
+-- Present -13
+-- PresentT (-13)
+--
+data Unwrap p
+
+instance (PP p x ~ s
+        , P p x
+        , Show s
+        , Show (Unwrapped s)
+        , Wrapped s
+        ) => P (Unwrap p) x where
+  type PP (Unwrap p) x = Unwrapped (PP p x)
+  eval _ opts x = do
+    let msg0 = "Unwrap"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = p ^. _Wrapped'
+        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
+
+-- | wraps a value (see '_Wrapped'' and '_Unwrapped'')
+--
+-- >>> :m + Data.List.NonEmpty
+-- >>> pz @(Wrap (SG.Sum _) Id) (-13)
+-- Present Sum {getSum = -13}
+-- PresentT (Sum {getSum = -13})
+--
+-- >>> pz @(Wrap SG.Any (Ge 4)) 13
+-- Present Any {getAny = True}
+-- PresentT (Any {getAny = True})
+--
+-- >>> pz @(Wrap (NonEmpty _) (Uncons >> 'Just Id)) "abcd"
+-- Present 'a' :| "bcd"
+-- PresentT ('a' :| "bcd")
+--
+data Wrap' t p
+type Wrap (t :: Type) p = Wrap' (Hole t) p
+
+instance (Show (PP p x)
+        , P p x
+        , Unwrapped (PP s x) ~ PP p x
+        , Wrapped (PP s x)
+        , Show (PP s x)
+        ) => P (Wrap' s p) x where
+  type PP (Wrap' s p) x = PP s x
+  eval _ opts x = do
+    let msg0 = "Wrap"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = p ^. _Unwrapped'
+        in mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
+
+-- | similar to 'coerce'
+--
+-- >>> pz @(Coerce (SG.Sum Integer)) (Identity (-13))
+-- Present Sum {getSum = -13}
+-- PresentT (Sum {getSum = -13})
+--
+data Coerce (t :: k)
+
+instance (Show a
+        , Show t
+        , Coercible t a
+        ) => P (Coerce t) a where
+  type PP (Coerce t) a = t
+  eval _ opts a =
+    let msg0 = "Coerce"
+        d = a ^. coerced
+    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d a] []
+
+-- can coerce over a functor: but need to provide type of 'a' and 't' explicitly
+
+-- | see 'Coerce': coerce over a functor
+--
+-- >>> pz @(Coerce2 (SG.Sum Integer)) [Identity (-13), Identity 4, Identity 99]
+-- Present [Sum {getSum = -13},Sum {getSum = 4},Sum {getSum = 99}]
+-- PresentT [Sum {getSum = -13},Sum {getSum = 4},Sum {getSum = 99}]
+--
+-- >>> pz @(Coerce2 (SG.Sum Integer)) (Just (Identity (-13)))
+-- Present Just (Sum {getSum = -13})
+-- PresentT (Just (Sum {getSum = -13}))
+--
+-- >>> pz @(Coerce2 (SG.Sum Int)) (Nothing @(Identity Int))
+-- Present Nothing
+-- PresentT Nothing
+--
+data Coerce2 (t :: k)
+instance (Show (f a)
+        , Show (f t)
+        , Coercible t a
+        , Functor f
+        ) => P (Coerce2 t) (f a) where
+  type PP (Coerce2 t) (f a) = f t
+  eval _ opts fa =
+    let msg0 = "Coerce2"
+        d = view coerced <$> fa
+    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d fa] []
+
+-- | lift mempty over a Functor
+--
+-- >>> pz @(MEmptyT2 (SG.Product Int)) [Identity (-13), Identity 4, Identity 99]
+-- Present [Product {getProduct = 1},Product {getProduct = 1},Product {getProduct = 1}]
+-- PresentT [Product {getProduct = 1},Product {getProduct = 1},Product {getProduct = 1}]
+--
+data MEmptyT2' t
+type MEmptyT2 t = MEmptyT2' (Hole t)
+
+instance (Show (f a)
+        , Show (f (PP t (f a)))
+        , Functor f
+        , Monoid (PP t (f a))
+        ) => P (MEmptyT2' t) (f a) where
+  type PP (MEmptyT2' t) (f a) = f (PP t (f a))
+  eval _ opts fa =
+    let msg0 = "MEmptyT2"
+        b = mempty <$> fa
+    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b fa] []
+
+-- | lift pure over a Functor
+--
+-- >>> pz @(Pure2 (Either String)) [1,2,4]
+-- Present [Right 1,Right 2,Right 4]
+-- PresentT [Right 1,Right 2,Right 4]
+--
+data Pure2 (t :: Type -> Type)
+type MkRightAlt t p = Pure (Either t) p
+type MkLeftAlt t p = MkRightAlt t p >> Swap
+
+instance (Show (f (t a))
+        , Show (f a)
+        , Applicative t
+        , Functor f
+        ) => P (Pure2 t) (f a) where
+  type PP (Pure2 t) (f a) = f (t a)
+  eval _ opts fa =
+    let msg0 = "Pure2"
+        b = fmap pure fa
+    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b fa] []
+
+-- | similar to 'reverse'
+--
+-- >>> pz @Reverse [1,2,4]
+-- Present [4,2,1]
+-- PresentT [4,2,1]
+--
+-- >>> pz @Reverse "AbcDeF"
+-- Present "FeDcbA"
+-- PresentT "FeDcbA"
+--
+data Reverse
+
+instance (Show a, as ~ [a]) => P Reverse as where
+  type PP Reverse as = as
+  eval _ opts as =
+    let msg0 = "Reverse"
+        d = reverse as
+    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d as] []
+
+-- | reverses using 'reversing'
+--
+-- >>> pz @ReverseL (T.pack "AbcDeF")
+-- Present "FeDcbA"
+-- PresentT "FeDcbA"
+--
+-- >>> pz @ReverseL ("AbcDeF" :: String)
+-- Present "FeDcbA"
+-- PresentT "FeDcbA"
+--
+data ReverseL
+
+instance (Show t, Reversing t) => P ReverseL t where
+  type PP ReverseL t = t
+  eval _ opts as =
+    let msg0 = "ReverseL"
+        d = as ^. reversed
+    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d as] []
+
+-- | swaps using 'SW.swap'
+--
+-- >>> pz @Swap (Left 123)
+-- Present Right 123
+-- PresentT (Right 123)
+--
+-- >>> pz @Swap (Right 123)
+-- Present Left 123
+-- PresentT (Left 123)
+--
+-- >>> pz @Swap (These 'x' 123)
+-- Present These 123 'x'
+-- PresentT (These 123 'x')
+--
+-- >>> pz @Swap (This 'x')
+-- Present That 'x'
+-- PresentT (That 'x')
+--
+-- >>> pz @Swap (That 123)
+-- Present This 123
+-- PresentT (This 123)
+--
+-- >>> pz @Swap (123,'x')
+-- Present ('x',123)
+-- PresentT ('x',123)
+--
+-- >>> pz @Swap (Left "abc")
+-- Present Right "abc"
+-- PresentT (Right "abc")
+--
+-- >>> pz @Swap (Right 123)
+-- Present Left 123
+-- PresentT (Left 123)
+--
+data Swap
+
+instance (Show (p a b)
+        , SW.Swap p
+        , Show (p b a)
+        ) => P Swap (p a b) where
+  type PP Swap (p a b) = p b a
+  eval _ opts pab =
+    let msg0 = "Swap"
+        d = SW.swap pab
+    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d pab] []
+
+-- | assoc using 'AS.assoc'
+--
+-- >>> pz @Assoc (This (These 123 'x'))
+-- Present These 123 (This 'x')
+-- PresentT (These 123 (This 'x'))
+--
+-- >>> pz @Assoc ((99,'a'),True)
+-- Present (99,('a',True))
+-- PresentT (99,('a',True))
+--
+-- >>> pz @Assoc ((99,'a'),True)
+-- Present (99,('a',True))
+-- PresentT (99,('a',True))
+--
+-- >>> pz @Assoc (Right "Abc" :: Either (Either () ()) String)
+-- Present Right (Right "Abc")
+-- PresentT (Right (Right "Abc"))
+--
+-- >>> pz @Assoc (Left (Left 'x'))
+-- Present Left 'x'
+-- PresentT (Left 'x')
+--
+data Assoc
+
+instance (Show (p (p a b) c)
+        , Show (p a (p b c))
+        , AS.Assoc p
+        ) => P Assoc (p (p a b) c) where
+  type PP Assoc (p (p a b) c) = p a (p b c)
+  eval _ opts pabc =
+    let msg0 = "Assoc"
+        d = AS.assoc pabc
+    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d pabc] []
+
+-- | unassoc using 'AS.unassoc'
+--
+-- >>> pz @Unassoc (These 123 (This 'x'))
+-- Present This (These 123 'x')
+-- PresentT (This (These 123 'x'))
+--
+-- >>> pz @Unassoc (99,('a',True))
+-- Present ((99,'a'),True)
+-- PresentT ((99,'a'),True)
+--
+-- >>> pz @Unassoc (This 10 :: These Int (These Bool ()))
+-- Present This (This 10)
+-- PresentT (This (This 10))
+--
+-- >>> pz @Unassoc (Right (Right 123))
+-- Present Right 123
+-- PresentT (Right 123)
+--
+-- >>> pz @Unassoc (Left 'x' :: Either Char (Either Bool Double))
+-- Present Left (Left 'x')
+-- PresentT (Left (Left 'x'))
+--
+data Unassoc
+
+instance (Show (p (p a b) c)
+        , Show (p a (p b c))
+        , AS.Assoc p
+        ) => P Unassoc (p a (p b c)) where
+  type PP Unassoc (p a (p b c)) = p (p a b) c
+  eval _ opts pabc =
+    let msg0 = "Unassoc"
+        d = AS.unassoc pabc
+    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d pabc] []
+
+-- | bounded 'succ' function
+--
+-- >>> pz @(SuccB' Id) (13 :: Int)
+-- Present 14
+-- PresentT 14
+--
+-- >>> pz @(SuccB' Id) LT
+-- Present EQ
+-- PresentT EQ
+--
+-- >>> pz @(SuccB 'LT Id) GT
+-- Present LT
+-- PresentT LT
+--
+-- >>> pz @(SuccB' Id) GT
+-- Error Succ bounded failed
+-- FailT "Succ bounded failed"
+--
+data SuccB p q
+type SuccB' q = SuccB (Failp "Succ bounded failed") q
+
+instance (PP q x ~ a
+        , P q x
+        , P p (Proxy a)
+        , PP p (Proxy a) ~ a
+        , Show a
+        , Eq a
+        , Bounded a
+        , Enum a
+        ) => P (SuccB p q) x where
+  type PP (SuccB p q) x = PP q x
+  eval _ opts x = do
+    let msg0 = "SuccB"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case succMay q of
+          Nothing -> do
+             let msg1 = msg0 <> " out of range"
+             pp <- eval (Proxy @p) opts (Proxy @a)
+             pure $ case getValueLR opts msg1 pp [hh qq] of
+               Left e -> e
+               Right _ -> mkNode opts (_tBool pp) [msg1] [hh qq, hh pp]
+          Just n -> pure $ mkNode opts (PresentT n) [show01 opts msg0 n q] [hh qq]
+
+-- | bounded 'pred' function
+--
+-- >>> pz @(PredB' Id) (13 :: Int)
+-- Present 12
+-- PresentT 12
+--
+-- >>> pz @(PredB' Id) LT
+-- Error Pred bounded failed
+-- FailT "Pred bounded failed"
+--
+data PredB p q
+type PredB' q = PredB (Failp "Pred bounded failed") q
+
+instance (PP q x ~ a
+        , P q x
+        , P p (Proxy a)
+        , PP p (Proxy a) ~ a
+        , Show a
+        , Eq a
+        , Bounded a
+        , Enum a
+        ) => P (PredB p q) x where
+  type PP (PredB p q) x = PP q x
+  eval _ opts x = do
+    let msg0 = "PredB"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case predMay q of
+          Nothing -> do
+             let msg1 = msg0 <> " out of range"
+             pp <- eval (Proxy @p) opts (Proxy @a)
+             pure $ case getValueLR opts msg1 pp [hh qq] of
+               Left e -> e
+               Right _ -> mkNode opts (_tBool pp) [msg1] [hh qq, hh pp]
+          Just n -> pure $ mkNode opts (PresentT n) [show01 opts msg0 n q] [hh qq]
+
+
+-- | unbounded 'succ' function
+--
+-- >>> pz @(Succ Id) 13
+-- Present 14
+-- PresentT 14
+--
+-- >>> pz @(Succ Id) LT
+-- Present EQ
+-- PresentT EQ
+--
+-- >>> pz @(Succ Id) GT
+-- Error Succ IO e=Prelude.Enum.Ordering.succ: bad argument
+-- FailT "Succ IO e=Prelude.Enum.Ordering.succ: bad argument"
+--
+data Succ p
+
+instance (Show a
+        , Enum a
+        , PP p x ~ a
+        , P p x
+        ) => P (Succ p) x where
+  type PP (Succ p) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Succ"
+    pp <- eval (Proxy @p) opts x
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right p -> do
+        lr <- catchit @_ @E.SomeException (succ p)
+        pure $ case lr of
+          Left e -> mkNode opts (FailT (msg0 <> " " <> e)) [msg0 <> show0 opts " " p] [hh pp]
+          Right n -> mkNode opts (PresentT n) [show01 opts msg0 n p] [hh pp]
+
+
+-- | unbounded 'pred' function
+--
+-- >>> pz @(Pred Id) 13
+-- Present 12
+-- PresentT 12
+--
+-- >>> pz @(Pred Id) LT
+-- Error Pred IO e=Prelude.Enum.Ordering.pred: bad argument
+-- FailT "Pred IO e=Prelude.Enum.Ordering.pred: bad argument"
+--
+
+data Pred p
+
+instance (Show a
+        , Enum a
+        , PP p x ~ a
+        , P p x
+        ) => P (Pred p) x where
+  type PP (Pred p) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Pred"
+    pp <- eval (Proxy @p) opts x
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right p -> do
+        lr <- catchit @_ @E.SomeException (pred p)
+        pure $ case lr of
+          Left e -> mkNode opts (FailT (msg0 <> " " <> e)) [msg0 <> show0 opts " " p] [hh pp]
+          Right n -> mkNode opts (PresentT n) [show01 opts msg0 n p] [hh pp]
+
+
+-- | 'fromEnum' function
+--
+-- >>> pz @(FromEnum Id) 'x'
+-- Present 120
+-- PresentT 120
+--
+data FromEnum p
+
+instance (Show a
+        , Enum a
+        , PP p x ~ a
+        , P p x
+        ) => P (FromEnum p) x where
+  type PP (FromEnum p) x = Int
+  eval _ opts x = do
+    let msg0 = "FromEnum"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let n = fromEnum p
+        in mkNode opts (PresentT n) [show01 opts msg0 n p] [hh pp]
+
+-- | unsafe 'toEnum' function
+--
+-- >>> pz @(ToEnum Char Id) 120
+-- Present 'x'
+-- PresentT 'x'
+data ToEnum' t p
+type ToEnum (t :: Type) p = ToEnum' (Hole t) p
+
+instance (PP p x ~ a
+        , P p x
+        , Show a
+        , Enum (PP t x)
+        , Show (PP t x)
+        , Integral a
+        ) => P (ToEnum' t p) x where
+  type PP (ToEnum' t p) x = PP t x
+  eval _ opts x = do
+    let msg0 = "ToEnum"
+    pp <- eval (Proxy @p) opts x
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right p -> do
+        lr <- catchit @_ @E.SomeException (toEnum $! fromIntegral p)
+        pure $ case lr of
+          Left e -> mkNode opts (FailT (msg0 <> " " <> e)) [msg0 <> show0 opts " " p] [hh pp]
+          Right n -> mkNode opts (PresentT n) [show01 opts msg0 n p] [hh pp]
+
+-- | bounded 'toEnum' function
+--
+-- >>> pz @(ToEnumBDef Ordering LT) 2
+-- Present GT
+-- PresentT GT
+--
+-- >>> pz @(ToEnumBDef Ordering LT) 6
+-- Present LT
+-- PresentT LT
+--
+-- >>> pz @(ToEnumBFail Ordering) 6
+-- Error ToEnum bounded failed
+-- FailT "ToEnum bounded failed"
+--
+data ToEnumBDef' t def
+type ToEnumBDef (t :: Type) def = ToEnumBDef' (Hole t) def
+type ToEnumBFail (t :: Type) = ToEnumBDef' (Hole t) (Failp "ToEnum bounded failed")
+
+instance (P def (Proxy (PP t a))
+        , PP def (Proxy (PP t a)) ~ (PP t a)
+        , Show a
+        , Show (PP t a)
+        , Bounded (PP t a)
+        , Enum (PP t a)
+        , Integral a
+        ) => P (ToEnumBDef' t def) a where
+  type PP (ToEnumBDef' t def) a = PP t a
+  eval _ opts a = do
+    let msg0 = "ToEnumBDef"
+    case toEnumMay $ fromIntegral a of
+      Nothing -> do
+         let msg1 = msg0 <> " out of range"
+         pp <- eval (Proxy @def) opts (Proxy @(PP t a))
+         pure $ case getValueLR opts msg1 pp [] of
+           Left e -> e
+           Right _ -> mkNode opts (_tBool pp) [msg1] [hh pp]
+      Just n -> pure $ mkNode opts (PresentT n) [show01 opts msg0 n a] []
+
+-- | a predicate on prime numbers
+--
+-- >>> pz @(Prime Id) 2
+-- True
+-- TrueT
+--
+-- >>> pz @(Map '(Id,Prime Id) Id) [0..12]
+-- Present [(0,False),(1,False),(2,True),(3,True),(4,False),(5,True),(6,False),(7,True),(8,False),(9,False),(10,False),(11,True),(12,False)]
+-- PresentT [(0,False),(1,False),(2,True),(3,True),(4,False),(5,True),(6,False),(7,True),(8,False),(9,False),(10,False),(11,True),(12,False)]
+--
+data Prime p
+
+instance (PP p x ~ a
+        , P p x
+        , Show a
+        , Integral a
+        ) => P (Prime p) x where
+  type PP (Prime p) x = Bool
+  eval _ opts x = do
+    let msg0 = "Prime"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = isPrime $ fromIntegral p
+        in mkNodeB opts b [msg0 <> show1 opts " | " p] []
+
+isPrime :: Integer -> Bool
+isPrime n = n==2 || n>2 && all ((> 0).rem n) (2:[3,5 .. floor . sqrt @Double . fromIntegral $ n+1])
+
+-- empty lists at the type level wont work here
+
+-- | filters a list \'q\' keeping or removing those elements in \'p\'
+--
+-- >>> pz @(Keep '[5] '[1,5,5,2,5,2]) ()
+-- Present [5,5,5]
+-- PresentT [5,5,5]
+--
+-- >>> pz @(Keep '[0,1,1,5] '[1,5,5,2,5,2]) ()
+-- Present [1,5,5,5]
+-- PresentT [1,5,5,5]
+--
+-- >>> pz @(Remove '[5] '[1,5,5,2,5,2]) ()
+-- Present [1,2,2]
+-- PresentT [1,2,2]
+--
+-- >>> pz @(Remove '[0,1,1,5] '[1,5,5,2,5,2]) ()
+-- Present [2,2]
+-- PresentT [2,2]
+--
+-- >>> pz @(Remove '[99] '[1,5,5,2,5,2]) ()
+-- Present [1,5,5,2,5,2]
+-- PresentT [1,5,5,2,5,2]
+--
+-- >>> pz @(Remove '[99,91] '[1,5,5,2,5,2]) ()
+-- Present [1,5,5,2,5,2]
+-- PresentT [1,5,5,2,5,2]
+--
+-- >>> pz @(Remove Id '[1,5,5,2,5,2]) []
+-- Present [1,5,5,2,5,2]
+-- PresentT [1,5,5,2,5,2]
+--
+-- >>> pz @(Remove '[] '[1,5,5,2,5,2]) 44 -- works if you make this a number!
+-- Present [1,5,5,2,5,2]
+-- PresentT [1,5,5,2,5,2]
+--
+data KeepImpl (keep :: Bool) p q
+type Remove p q = KeepImpl 'False p q
+type Keep p q = KeepImpl 'True p q
+
+instance (GetBool keep
+        , Eq a
+        , Show a
+        , P p x
+        , P q x
+        , PP p x ~ PP q x
+        , PP q x ~ [a]
+        ) => 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"
+        keep = getBool @keep
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let ret = filter (bool not id keep . (`elem` p)) q
+        in mkNode opts (PresentT ret) [show01' opts msg0 ret "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
+
+-- | 'elem' function
+--
+-- >>> pz @(Elem (Fst Id) (Snd Id)) ('x',"abcdxy")
+-- True
+-- TrueT
+--
+-- >>> pz @(Elem (Fst Id) (Snd Id)) ('z',"abcdxy")
+-- False
+-- FalseT
+--
+data Elem p q
+
+instance ([PP p a] ~ PP q a
+         , P p a
+         , P q a
+         , Show (PP p a)
+         , Eq (PP p a)
+         ) => P (Elem p q) a where
+  type PP (Elem p q) a = Bool
+  eval _ opts a = do
+    let msg0 = "Elem"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let b = p `elem` q
+        in mkNodeB opts b [show p <> " `elem` " <> show q] [hh pp, hh qq]
+
+--type Head' p = HeadFail "Head(empty)" p
+--type Tail' p = TailFail "Tail(empty)" p
+--type Last p = LastFail "Last(empty)" p
+--type Init' p = InitFail "Init(empty)" p
+
+-- | similar to fmap fst
+--
+-- >>> pz @FMapFst (Just (13,"Asf"))
+-- Present Just 13
+-- PresentT (Just 13)
+--
+-- to make this work we grab the fst or snd out of the Maybe so it is a head or not/ is a tail or not etc!
+-- we still have access to the whole original list so we dont lose anything!
+data FMapFst
+instance Functor f => P FMapFst (f (a,x)) where
+  type PP FMapFst (f (a,x)) = f a
+  eval _ opts mb = pure $ mkNode opts (PresentT (fst <$> mb)) ["FMapFst"] []
+
+-- | similar to fmap snd
+--
+-- >>> pz @FMapSnd (Just ("asf",13))
+-- Present Just 13
+-- PresentT (Just 13)
+--
+data FMapSnd
+instance Functor f => P FMapSnd (f (x,a)) where
+  type PP FMapSnd (f (x,a)) = f a
+  eval _ opts mb = pure $ mkNode opts (PresentT (snd <$> mb)) ["FMapSnd"] []
+
+-- | takes the head or default of a list-like object
+--
+-- see 'ConsT' for other supported types eg 'Seq.Seq'
+--
+-- >>> pz @(HeadDef 444 Id) []
+-- Present 444
+-- PresentT 444
+--
+-- >>> pz @(HeadDef 444 Id) [1..5]
+-- Present 1
+-- PresentT 1
+--
+-- >>> pz @(HeadDef 444 Id) [1..5]
+-- Present 1
+-- PresentT 1
+--
+-- >>> pz @(HeadDef (Char1 "w") Id) (Seq.fromList "abcdef")
+-- Present 'a'
+-- PresentT 'a'
+--
+-- >>> pz @(HeadDef (Char1 "w") Id) Seq.empty
+-- Present 'w'
+-- PresentT 'w'
+--
+-- >>> pz @(HeadDef (MEmptyT _) Id) ([] @(SG.Sum _))
+-- Present Sum {getSum = 0}
+-- PresentT (Sum {getSum = 0})
+--
+-- >>> pz @(HeadDef (MEmptyT _) '[ "abc","def","asdfadf" ]) ()
+-- Present "abc"
+-- PresentT "abc"
+--
+-- >>> pz @(HeadDef (MEmptyT _) (Snd Id)) (123,[ "abc","def","asdfadf" ])
+-- Present "abc"
+-- PresentT "abc"
+--
+-- >>> pz @(HeadDef (MEmptyT _) (Snd Id)) (123,[])
+-- Present ()
+-- PresentT ()
+--
+type HeadDef p q = JustDef p (q >> Uncons >> FMapFst)
+
+-- | takes the head of a list or fail
+--
+-- see 'ConsT' for other supported types eg 'Seq.Seq'
+--
+-- >>> pz @(HeadFail "dude" Id) [ "abc","def","asdfadf" ]
+-- Present "abc"
+-- PresentT "abc"
+--
+-- >>> pz @(HeadFail "empty list" Id) []
+-- Error empty list
+-- FailT "empty list"
+--
+type HeadFail msg q = JustFail msg (q >> Uncons >> FMapFst)
+
+type TailDef p q = JustDef p (q >> Uncons >> FMapSnd)
+type TailFail msg q = JustFail msg (q >> Uncons >> FMapSnd)
+
+type LastDef p q = JustDef p (q >> Unsnoc >> FMapSnd)
+type LastFail msg q = JustFail msg (q >> Unsnoc >> FMapSnd)
+
+type InitDef p q = JustDef p (q >> Unsnoc >> FMapFst)
+type InitFail msg q = JustFail msg (q >> Unsnoc >> FMapFst)
+
+type LookupDef' x y p q = JustDef p (q >> Lookup x y)
+type LookupFail' msg x y q = JustFail msg (q >> Lookup x y)
+
+type LookupDef x y p    = LookupDef' x y p I
+type LookupFail msg x y = LookupFail' msg x y I
+
+--type Just'  p = JustFail  "expected Just" p
+type Left'  p = LeftFail  "expected Left"  p
+type Right' p = RightFail "expected Right" p
+type This'  p = ThisFail  "expected This"  p
+type That'  p = ThatFail  "expected That"  p
+type These' p = TheseFail "expected These" p
+
+-- | similar to 'Control.Arrow.|||' but additionally gives \'p\' and \'q\' the original input
+--
+-- >>> pz @(EitherX (ShowP (Fst (Fst Id) + Snd Id)) (ShowP Id) (Snd Id)) (9,Left 123)
+-- Present "132"
+-- PresentT "132"
+--
+-- >>> pz @(EitherX (ShowP (Fst (Fst Id) + Snd Id)) (ShowP Id) (Snd Id)) (9,Right 'x')
+-- Present "((9,Right 'x'),'x')"
+-- PresentT "((9,Right 'x'),'x')"
+--
+-- >>> pz @(EitherX (ShowP Id) (ShowP (Second (Succ Id))) (Snd Id)) (9,Right 'x')
+-- Present "((9,Right 'x'),'y')"
+-- PresentT "((9,Right 'x'),'y')"
+--
+data EitherX p q r
+instance (P r x
+        , P p (x,a)
+        , P q (x,b)
+        , PP r x ~ Either a b
+        , PP p (x,a) ~ c
+        , PP q (x,b) ~ c
+        ) => P (EitherX p q r) x where
+  type PP (EitherX p q r) x = EitherXT (PP r x) x p
+  eval _ opts x = do
+    let msg0 = "EitherX"
+    rr <- eval (Proxy @r) opts x
+    case getValueLR opts msg0 rr [] of
+      Left e -> pure e
+      Right (Left a) -> do
+        let msg1 = msg0 <> "(Left)"
+        pp <- eval (Proxy @p) opts (x,a)
+        pure $ case getValueLR opts msg1 pp [hh rr] of
+          Left e -> e
+          Right _ -> mkNode opts (_tBool pp) [msg1] [hh rr, hh pp]
+      Right (Right b) -> do
+        let msg1 = msg0 <> "(Right)"
+        qq <- eval (Proxy @q) opts (x,b)
+        pure $ case getValueLR opts msg1 qq [hh rr] of
+          Left e -> e
+          Right _ -> mkNode opts (_tBool qq) [msg1] [hh rr, hh qq]
+
+type family EitherXT lr x p where
+  EitherXT (Either a b) x p = PP p (x,a)
+  EitherXT o _ _ = GL.TypeError (
+      'GL.Text "EitherXT: expected 'Either a b' "
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
+
+-- | similar to 'Data.These.mergeTheseWith' but additionally provides \'p\', '\q'\ and \'r\' the original input as the first element in the tuple
+--
+-- >>> pz @(TheseX ((Fst (Fst Id) + Snd Id) >> ShowP Id) (ShowP Id) (Snd (Snd Id)) (Snd Id)) (9,This 123)
+-- Present "132"
+-- PresentT "132"
+--
+-- >>> pz @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (This 123)
+-- Present (123,"fromthis")
+-- PresentT (123,"fromthis")
+--
+-- >>> pz @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (That "fromthat")
+-- Present (-99,"fromthat")
+-- PresentT (-99,"fromthat")
+--
+-- >>> pz @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (These 123 "fromthese")
+-- Present (123,"fromthese")
+-- PresentT (123,"fromthese")
+--
+data TheseX p q r s
+
+instance (P s x
+        , P p (x,a)
+        , P q (x,b)
+        , P r (x,(a,b))
+        , PP s x ~ These a b
+        , PP p (x,a) ~ c
+        , PP q (x,b) ~ c
+        , PP r (x,(a,b)) ~ c
+        ) => P (TheseX p q r s) x where
+  type PP (TheseX p q r s) x = TheseXT (PP s x) x p
+  eval _ opts x = do
+    let msg0 = "TheseX"
+    ss <- eval (Proxy @s) opts x
+    case getValueLR opts msg0 ss [] of
+      Left e -> pure e
+      Right (This a) -> do
+        let msg1 = msg0 <> "(This)"
+        pp <- eval (Proxy @p) opts (x,a)
+        pure $ case getValueLR opts msg1 pp [hh ss] of
+          Left e -> e
+          Right _ -> mkNode opts (_tBool pp) [msg1] [hh ss, hh pp]
+      Right (That b) -> do
+        let msg1 = msg0 <> "(That)"
+        qq <- eval (Proxy @q) opts (x,b)
+        pure $ case getValueLR opts msg1 qq [hh ss] of
+          Left e -> e
+          Right _ -> mkNode opts (_tBool qq) [msg1] [hh ss, hh qq]
+      Right (These a b) -> do
+        let msg1 = msg0 <> "(These)"
+        rr <- eval (Proxy @r) opts (x,(a,b))
+        pure $ case getValueLR opts msg1 rr [hh ss] of
+          Left e -> e
+          Right _ -> mkNode opts (_tBool rr) [msg1] [hh ss, hh rr]
+
+type family TheseXT lr x p where
+  TheseXT (These a b) x p = PP p (x,a)
+
+-- | similar to 'maybe'
+--
+-- provides a Proxy to the result of \'q\' but does not provide the surrounding context
+--
+-- >>> pz @(MaybeIn "foundnothing" (ShowP (Pred Id))) (Just 20)
+-- Present "19"
+-- PresentT "19"
+--
+-- >>> pz @(MaybeIn "found nothing" (ShowP (Pred Id))) Nothing
+-- Present "found nothing"
+-- PresentT "found nothing"
+--
+data MaybeIn p q
+type IsNothing = MaybeIn 'True 'False
+type IsJust = MaybeIn 'False 'True
+
+-- tricky: the nothing case is the proxy of PP q a: ie proxy of the final result
+instance (P q a
+        , Show a
+        , Show (PP q a)
+        , PP p (Proxy (PP q a)) ~ PP q a
+        , P p (Proxy (PP q a))
+        ) => P (MaybeIn p q) (Maybe a) where
+  type PP (MaybeIn p q) (Maybe a) = PP q a
+  eval _ opts ma = do
+    let msg0 = "MaybeIn"
+    case ma of
+      Nothing -> do
+        let msg1 = msg0 <> "(Nothing)"
+        pp <- eval (Proxy @p) opts (Proxy @(PP q a))
+        pure $ case getValueLR opts msg1 pp [] of
+          Left e -> e
+          Right b -> mkNode opts (_tBool pp) [msg1 <> show0 opts " " b <> " | Proxy"] [hh pp]
+      Just a -> do
+        let msg1 = msg0 <> "(Nothing)"
+        qq <- eval (Proxy @q) opts a
+        pure $ case getValueLR opts msg1 qq [] of
+          Left e -> e
+          Right b -> mkNode opts (_tBool qq) [show01 opts msg1 b a] [hh qq]
+
+-- | similar to 'SG.stimes'
+--
+-- >>> pz @(STimes 4 Id) (SG.Sum 3)
+-- Present Sum {getSum = 12}
+-- PresentT (Sum {getSum = 12})
+--
+-- >>> pz @(STimes 4 Id) "ab"
+-- Present "abababab"
+-- PresentT "abababab"
+--
+data STimes n p
+instance (P n a
+        , Integral (PP n a)
+        , Semigroup (PP p a)
+        , P p a
+        , Show (PP p a)
+        ) => P (STimes n p) a where
+  type PP (STimes n p) a = PP p a
+  eval _ opts a = do
+    let msg0 = "STimes"
+    lr <- runPQ msg0 (Proxy @n) (Proxy @p) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (fromIntegral -> (n::Int),p,pp,qq) ->
+        let msg1 = msg0 <> show0 opts " " n <> " p=" <> show p
+            b = SG.stimes n p
+            in mkNode opts (PresentT b) [show01' opts msg1 b "n=" n <> show1 opts " | " p] [hh pp, hh qq]
+
+
+-- | similar to 'pure'
+--
+-- >>> pz @(Pure Maybe Id) 4
+-- Present Just 4
+-- PresentT (Just 4)
+--
+-- >>> pz @(Pure [] Id) 4
+-- Present [4]
+-- PresentT [4]
+--
+-- >>> pz @(Pure (Either String) (Fst Id)) (13,True)
+-- Present Right 13
+-- PresentT (Right 13)
+--
+data Pure (t :: Type -> Type) p
+instance (P p x
+        , Show (PP p x)
+        , Show (t (PP p x))
+        , Applicative t
+        ) => P (Pure t p) x where
+  type PP (Pure t p) x = t (PP p x)
+  eval _ opts x = do
+    let msg0 = "Pure"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right a ->
+        let b = pure a
+        in mkNode opts (PresentT b) [show01 opts msg0 b a] [hh pp]
+
+-- type PMEmpty = MEmptyT' 'Proxy  -- lifts 'a' to 'Proxy a' then we can use it with MEmptyP
+
+-- | similar to 'mempty'
+--
+-- >>> pz @(MEmptyT (SG.Sum Int)) ()
+-- Present Sum {getSum = 0}
+-- PresentT (Sum {getSum = 0})
+--
+-- no Monoid for Maybe a unless a is also a monoid but can use empty!
+data MEmptyT' t
+type MEmptyT (t :: Type) = MEmptyT' (Hole t)
+type MEmptyP = MEmptyT' Unproxy -- expects a proxy: so only some things work with this: eg Pad MaybeIn etc
+
+instance (Show (PP t a), Monoid (PP t a)) => P (MEmptyT' t) a where
+  type PP (MEmptyT' t) a = PP t a
+  eval _ opts _ =
+    let msg0 = "MEmptyT"
+        b = mempty @(PP t a)
+    in pure $ mkNode opts (PresentT b) [msg0 <> show0 opts " " b] []
+
+-- | similar to 'empty'
+--
+-- >>> pz @(EmptyT Maybe Id) ()
+-- Present Nothing
+-- PresentT Nothing
+--
+-- >>> pz @(EmptyT [] Id) ()
+-- Present []
+-- PresentT []
+--
+-- >>> pz @(EmptyT [] (Char1 "x")) (13,True)
+-- Present ""
+-- PresentT ""
+--
+-- >>> pz @(EmptyT (Either String) (Fst Id)) (13,True)
+-- Present Left ""
+-- PresentT (Left "")
+--
+
+data EmptyT (t :: Type -> Type) p
+
+instance (P p x
+        , PP p x ~ a
+        , Show (t a)
+        , Show a
+        , Alternative t
+        ) => P (EmptyT t p) x where
+  type PP (EmptyT t p) x = t (PP p x)
+  eval _ opts x = do
+    let msg0 = "EmptyT"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = empty @t
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+data MkNothing' t -- works always! MaybeBool is a good alternative and then dont need the extra 't'
+type MkNothing (t :: Type) = MkNothing' (Hole t)
+
+-- for this to be useful has to have 't' else we end up with tons of problems
+instance P (MkNothing' t) a where
+  type PP (MkNothing' t) a = Maybe (PP t a)
+  eval _ opts _ =
+    let msg0 = "MkNothing"
+    in pure $ mkNode opts (PresentT Nothing) [msg0] []
+
+-- | 'GHC.Maybe.Just' constructor
+--
+-- >>> pz @(MkJust Id) 44
+-- Present Just 44
+-- PresentT (Just 44)
+--
+data MkJust p
+instance (PP p x ~ a, P p x, Show a) => P (MkJust p) x where
+  type PP (MkJust p) x = Maybe (PP p x)
+  eval _ opts x = do
+    let msg0 = "MkJust"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = Just p
+        in mkNode opts (PresentT d) [msg0 <> show0 opts " Just " p] [hh pp]
+
+-- | 'Data.Either.Left' constructor
+--
+-- >>> pz @(MkLeft _ Id) 44
+-- Present Left 44
+-- PresentT (Left 44)
+--
+data MkLeft' t p
+type MkLeft (t :: Type) p = MkLeft' (Hole t) p
+
+instance (Show (PP p x), P p x) => P (MkLeft' t p) x where
+  type PP (MkLeft' t p) x = Either (PP p x) (PP t x)
+  eval _ opts x = do
+    let msg0 = "MkLeft"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = Left p
+        in mkNode opts (PresentT d) [msg0 <> show0 opts " Left " p] [hh pp]
+
+-- | 'Data.Either.Right' constructor
+--
+-- >>> pz @(MkRight _ Id) 44
+-- Present Right 44
+-- PresentT (Right 44)
+--
+data MkRight' t p
+type MkRight (t :: Type) p = MkRight' (Hole t) p
+
+instance (Show (PP p x), P p x) => P (MkRight' t p) x where
+  type PP (MkRight' t p) x = Either (PP t x) (PP p x)
+  eval _ opts x = do
+    let msg0 = "MkRight"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = Right p
+        in mkNode opts (PresentT d) [msg0 <> show0 opts " Right " p] [hh pp]
+
+-- | 'Data.These.This' constructor
+--
+-- >>> pz @(MkThis _ Id) 44
+-- Present This 44
+-- PresentT (This 44)
+--
+-- >>> pz @(Proxy Int >> MkThis' Unproxy 10) []
+-- Present This 10
+-- PresentT (This 10)
+--
+data MkThis' t p
+type MkThis (t :: Type) p = MkThis' (Hole t) p
+
+instance (Show (PP p x), P p x) => P (MkThis' t p) x where
+  type PP (MkThis' t p) x = These (PP p x) (PP t x)
+  eval _ opts x = do
+    let msg0 = "MkThis"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = This p
+        in mkNode opts (PresentT d) [msg0 <> show0 opts " This " p] [hh pp]
+
+-- | 'Data.These.That' constructor
+--
+-- >>> pz @(MkThat _ Id) 44
+-- Present That 44
+-- PresentT (That 44)
+--
+data MkThat' t p
+type MkThat (t :: Type) p = MkThat' (Hole t) p
+
+instance (Show (PP p x), P p x) => P (MkThat' t p) x where
+  type PP (MkThat' t p) x = These (PP t x) (PP p x)
+  eval _ opts x = do
+    let msg0 = "MkThat"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = That p
+        in mkNode opts (PresentT d) [msg0 <> show0 opts " That " p] [hh pp]
+
+--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 Id) (Snd Id)) (44,'x')
+-- Present These 44 'x'
+-- PresentT (These 44 'x')
+--
+data MkThese p q
+instance (P p a
+        , P q a
+        , Show (PP p a)
+        , Show (PP q a)
+        ) => P (MkThese p q) a where
+  type PP (MkThese p q) a = These (PP p a) (PP q a)
+  eval _ opts a = do
+    let msg0 = "MkThese"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let d = These p q
+        in mkNode opts (PresentT d) [msg0 <> show0 opts " " d] [hh pp, hh qq]
+
+-- | similar to 'mconcat'
+--
+-- >>> pz @(MConcat Id) [SG.Sum 44, SG.Sum 12, SG.Sum 3]
+-- Present Sum {getSum = 59}
+-- PresentT (Sum {getSum = 59})
+--
+data MConcat p
+
+
+-- | similar to a limited form of 'foldMap'
+--
+-- >>> pz @(FoldMap (SG.Sum _) Id) [44, 12, 3]
+-- Present 59
+-- PresentT 59
+--
+-- >>> pz @(FoldMap (SG.Product _) Id) [44, 12, 3]
+-- Present 1584
+-- PresentT 1584
+--
+-- >>> type Ands' p = FoldMap SG.All p
+-- >>> pz @(Ands' Id) [True,False,True,True]
+-- Present False
+-- PresentT False
+--
+-- >>> pz @(Ands' Id) [True,True,True]
+-- Present True
+-- PresentT True
+--
+-- >>> pz @(Ands' Id) []
+-- Present True
+-- PresentT True
+--
+-- >>> type Ors' p = FoldMap SG.Any p
+-- >>> pz @(Ors' Id) [False,False,False]
+-- Present False
+-- PresentT False
+--
+-- >>> pz @(Ors' Id) []
+-- Present False
+-- PresentT False
+--
+-- >>> pz @(Ors' Id) [False,False,False,True]
+-- Present True
+-- PresentT True
+--
+-- >>> type AllPositive' = FoldMap SG.All (Map Positive Id)
+-- >>> pz @AllPositive' [3,1,-5,10,2,3]
+-- Present False
+-- PresentT False
+--
+-- >>> type AllNegative' = FoldMap SG.All (Map Negative Id)
+-- >>> pz @AllNegative' [-1,-5,-10,-2,-3]
+-- Present True
+-- PresentT True
+--
+-- >>> :set -XKindSignatures
+-- >>> type Max' (t :: Type) = FoldMap (SG.Max t) Id -- requires t be Bounded for monoid instance
+-- >>> pz @(Max' Int) [10,4,5,12,3,4]
+-- Present 12
+-- PresentT 12
+--
+type FoldMap (t :: Type) p = Map (Wrap t Id) p >> Unwrap (MConcat Id)
+
+instance (PP p x ~ [a]
+        , P p x
+        , Show a
+        , Monoid a
+        ) => P (MConcat p) x where
+  type PP (MConcat p) x = ExtractAFromTA (PP p x)
+  eval _ opts x = do
+    let msg0 = "MConcat"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = mconcat p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+-- | similar to 'concat'
+--
+-- >>> pz @(Concat Id) ["abc","D","eF","","G"]
+-- Present "abcDeFG"
+-- PresentT "abcDeFG"
+--
+-- >>> pz @(Concat (Snd Id)) ('x',["abc","D","eF","","G"])
+-- Present "abcDeFG"
+-- PresentT "abcDeFG"
+--
+data Concat p
+
+instance (Show a
+        , Show (t [a])
+        , PP p x ~ (t [a])
+        , P p x
+        , Foldable t
+        ) => P (Concat p) x where
+  type PP (Concat p) x = ExtractAFromTA (PP p x)
+  eval _ opts x = do
+    let msg0 = "Concat"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = concat p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] [hh pp]
+
+-- | similar to 'cycle' but for a fixed number \'n\'
+--
+-- >>> pz @(Cycle 5 Id) [1,2]
+-- Present [1,2,1,2,1]
+-- PresentT [1,2,1,2,1]
+--
+data Cycle n p
+
+instance (Show a
+        , Show (t a)
+        , PP p x ~ (t a)
+        , P p x
+        , Integral (PP n x)
+        , P n x
+        , Foldable t
+        ) => P (Cycle n p) x where
+  type PP (Cycle n p) x = [ExtractAFromTA (PP p x)]
+  eval _ opts x = do
+    let msg0 = "Cycle"
+    lr <- runPQ msg0 (Proxy @n) (Proxy @p) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (fromIntegral -> n,p,nn,pp) ->
+        let hhs = [hh nn, hh pp]
+        in case chkSize opts msg0 p hhs of
+            Left e ->  e
+            Right () ->
+              let msg1 = msg0 <> "("<> show n <> ")"
+                  d = take n (cycle (toList p))
+              in mkNode opts (PresentT d) [show01 opts msg1 d p] hhs
+
+data ProxyT' t
+type ProxyT (t :: Type) = ProxyT' (Hole t)
+
+instance Typeable t => P (ProxyT' (t :: Type)) a where
+  type PP (ProxyT' t) a = Proxy (PP t a)
+  eval _ opts _ =
+    let t = showT @t
+    in pure $ mkNode opts (PresentT Proxy) ["ProxyT(" <> show t ++ ")"] []
+
+-- | similar to 'Data.List.!!'
+--
+-- >>> pz @(Ix 4 "not found") ["abc","D","eF","","G"]
+-- Present "G"
+-- PresentT "G"
+--
+-- >>> pz @(Ix 40 "not found") ["abc","D","eF","","G"]
+-- Present "not found"
+-- PresentT "not found"
+--
+data Ix (n :: Nat) def
+type Ix' (n :: Nat) = Ix n (Failp "Ix index not found")
+
+instance (P def (Proxy a)
+        , PP def (Proxy a) ~ a
+        , KnownNat n
+        , Show a
+        ) => P (Ix n def) [a] where
+  type PP (Ix n def) [a] = a
+  eval _ opts as = do
+    let n = nat @n
+        msg0 = "Ix " <> show n
+    case as ^? ix n of
+         Nothing -> do
+           let msg1 = msg0 <> " not found"
+           pp <- eval (Proxy @def) opts (Proxy @a)
+           pure $ case getValueLR opts msg1 pp [] of
+             Left e -> e
+             Right _ -> mkNode opts (_tBool pp) [msg1] [hh pp]
+         Just a -> pure $ mkNode opts (PresentT a) [msg0 <> show0 opts " " a] []
+
+-- | similar to 'Data.List.!!' leveraging 'Ixed'
+--
+-- >>> import qualified Data.Map.Strict as M
+-- >>> pz @(Id !! 2) ["abc","D","eF","","G"]
+-- Present "eF"
+-- PresentT "eF"
+--
+-- >>> pz @(Id !! 20) ["abc","D","eF","","G"]
+-- Error (!!) index not found
+-- FailT "(!!) index not found"
+--
+-- >>> pz @(Id !! "eF") (M.fromList (flip zip [0..] ["abc","D","eF","","G"]))
+-- Present 2
+-- PresentT 2
+--
+data IxL p q def -- p is the big value and q is the index and def is the default
+type p !! q = IxL p q (Failp "(!!) index not found")
+instance (P q a
+        , P p a
+        , Show (PP p a)
+        , Ixed (PP p a)
+        , PP q a ~ Index (PP p a)
+        , Show (Index (PP p a))
+        , Show (IxValue (PP p a))
+        , P r (Proxy (IxValue (PP p a)))
+        , PP r (Proxy (IxValue (PP p a))) ~ IxValue (PP p a)
+        )
+   => P (IxL p q r) a where
+  type PP (IxL p q r) a = IxValue (PP p a)
+  eval _ opts a = do
+    let msg0 = "IxL"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    case lr of
+      Left e -> pure e
+      Right (p,q,pp,qq) ->
+        let msg1 = msg0 <> "(" <> show q <> ")"
+        in case p ^? ix q of
+             Nothing -> do
+                rr <- eval (Proxy @r) opts (Proxy @(IxValue (PP p a)))
+                pure $ case getValueLR opts msg1 rr [hh pp, hh qq] of
+                  Left e -> e
+                  Right _ -> mkNode opts (_tBool rr) [msg1 <> " index not found"] [hh pp, hh qq]
+             Just ret -> pure $ mkNode opts (PresentT ret) [show01' opts msg1 ret "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
+
+-- | 'lookup' leveraging 'Ixed'
+--
+-- >>> pz @(Lookup Id 2) ["abc","D","eF","","G"]
+-- Present Just "eF"
+-- PresentT (Just "eF")
+--
+-- >>> pz @(Lookup Id 20) ["abc","D","eF","","G"]
+-- Present Nothing
+-- PresentT Nothing
+--
+data Lookup p q
+
+instance (P q a
+        , P p a
+        , Show (PP p a)
+        , Ixed (PP p a)
+        , PP q a ~ Index (PP p a)
+        , Show (Index (PP p a))
+        , Show (IxValue (PP p a))
+        )
+   => P (Lookup p q) a where
+  type PP (Lookup p q) a = Maybe (IxValue (PP p a))
+  eval _ opts a = do
+    let msg0 = "Lookup"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let msg1 = msg0 <> "(" <> show q <> ")"
+            hhs = [hh pp, hh qq]
+        in case p ^? ix q of
+             Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " not found"] hhs
+             Just ret -> mkNode opts (PresentT (Just ret)) [show01' opts msg1 ret "p=" p <> show1 opts " | q=" q] hhs
+
+-- | 'Data.List.ands'
+--
+-- >>> pz @(Ands Id) [True,True,True]
+-- True
+-- TrueT
+--
+-- >>> pl @(Ands Id) [True,True,True,False]
+-- False (Ands(4) i=3 | [True,True,True,False])
+-- FalseT
+--
+-- >>> pz @(Ands Id) []
+-- True
+-- TrueT
+--
+data Ands p
+
+instance (PP p x ~ t a
+        , P p x
+        , Show (t a)
+        , Foldable t
+        , a ~ Bool
+        ) => P (Ands p) x where
+  type PP (Ands p) x = Bool
+  eval _ opts x = do
+    let msg0 = "Ands"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let msg1 = msg0 ++ "(" ++ show (length p) ++ ")"
+            w = case findIndex not (toList p) of
+                  Nothing -> ""
+                  Just i -> " i="++show i
+        in mkNodeB opts (and p) [msg1 <> w <> show1 opts " | " p] [hh pp]
+
+-- | 'Data.List.ors'
+--
+-- >>> pz @(Ors Id) [False,False,False]
+-- False
+-- FalseT
+--
+-- >>> pl @(Ors Id) [True,True,True,False]
+-- True (Ors(4) i=0 | [True,True,True,False])
+-- TrueT
+--
+-- >>> pl @(Ors Id) []
+-- False (Ors(0) | [])
+-- FalseT
+--
+data Ors p
+
+instance (PP p x ~ t a
+        , P p x
+        , Show (t a)
+        , Foldable t
+        , a ~ Bool
+        ) => P (Ors p) x where
+  type PP (Ors p) x = Bool
+  eval _ opts x = do
+    let msg0 = "Ors"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let msg1 = msg0 ++ "(" ++ show (length p) ++ ")"
+            w = case findIndex id (toList p) of
+                  Nothing -> ""
+                  Just i -> " i="++show i
+        in mkNodeB opts (or p) [msg1 <> w <> show1 opts " | " p] [hh pp]
+
+-- cant directly create a singleton type using '[] since the type of '[] is unknown. instead use 'Singleton' or 'EmptyT'
+
+-- | similar to cons
+--
+-- >>> pz @(Fst Id :+ Snd Id) (99,[1,2,3,4])
+-- Present [99,1,2,3,4]
+-- PresentT [99,1,2,3,4]
+--
+-- >>> pz @(Snd Id :+ Fst Id) ([],5)
+-- Present [5]
+-- PresentT [5]
+--
+-- >>> pz @(123 :+ EmptyList _) "somestuff"
+-- Present [123]
+-- PresentT [123]
+--
+data p :+ q
+infixr 5 :+
+instance (P p x
+        , P q x
+        , Show (PP p x)
+        , Show (PP q x)
+        , Cons (PP q x) (PP q x) (PP p x) (PP p x)
+        ) => P (p :+ q) x where
+  type PP (p :+ q) x = PP q x
+  eval _ opts z = do
+    let msg0 = "(:+)"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts z []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let b = p `cons` q
+        in mkNode opts (PresentT b) [show01' opts msg0 b "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
+
+-- | similar to snoc
+--
+-- >>> pz @(Snd Id +: Fst Id) (99,[1,2,3,4])
+-- Present [1,2,3,4,99]
+-- PresentT [1,2,3,4,99]
+--
+-- >>> pz @(Fst Id +: Snd Id) ([],5)
+-- Present [5]
+-- PresentT [5]
+--
+-- >>> pz @(EmptyT [] Id +: 5) 5
+-- Present [5]
+-- PresentT [5]
+--
+data p +: q
+infixl 5 +:
+
+instance (P p x
+        , P q x
+        , Show (PP q x)
+        , Show (PP p x)
+        , Snoc (PP p x) (PP p x) (PP q x) (PP q x)
+        ) => P (p +: q) x where
+  type PP (p +: q) x = PP p x
+  eval _ opts z = do
+    let msg0 = "(+:)"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts z []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let b = p `snoc` q
+        in mkNode opts (PresentT b) [show01' opts msg0 b "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
+
+-- | 'Control.Lens.uncons'
+--
+-- >>> pz @Uncons [1,2,3,4]
+-- Present Just (1,[2,3,4])
+-- PresentT (Just (1,[2,3,4]))
+--
+-- >>> pz @Uncons []
+-- Present Nothing
+-- PresentT Nothing
+--
+-- >>> pz @Uncons (Seq.fromList "abc")
+-- Present Just ('a',fromList "bc")
+-- PresentT (Just ('a',fromList "bc"))
+--
+-- >>> pz @Uncons ("xyz" :: T.Text)
+-- Present Just ('x',"yz")
+-- PresentT (Just ('x',"yz"))
+--
+data Uncons
+
+instance (Show (ConsT s)
+        , Show s
+        , Cons s s (ConsT s) (ConsT s)
+        ) => P Uncons s where
+  type PP Uncons s = Maybe (ConsT s,s)
+  eval _ opts as =
+    let msg0 = "Uncons"
+        b = as ^? _Cons
+    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b as] []
+
+-- | 'Control.Lens.unsnoc'
+--
+-- >>> pz @Unsnoc [1,2,3,4]
+-- Present Just ([1,2,3],4)
+-- PresentT (Just ([1,2,3],4))
+--
+-- >>> pz @Unsnoc []
+-- Present Nothing
+-- PresentT Nothing
+--
+-- >>> pz @Unsnoc ("xyz" :: T.Text)
+-- Present Just ("xy",'z')
+-- PresentT (Just ("xy",'z'))
+--
+data Unsnoc
+
+instance (Show (ConsT s)
+        , Show s
+        , Snoc s s (ConsT s) (ConsT s)
+        ) => P Unsnoc s where
+  type PP Unsnoc s = Maybe (s,ConsT s)
+  eval _ opts as =
+    let msg0 = "Unsnoc"
+        b = as ^? _Snoc
+    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b as] []
+
+-- | similar to 'null' using 'AsEmpty'
+--
+-- >>> pz @IsEmpty [1,2,3,4]
+-- False
+-- FalseT
+--
+-- >>> pz @IsEmpty []
+-- True
+-- TrueT
+--
+-- >>> pz @IsEmpty LT
+-- False
+-- FalseT
+--
+-- >>> pz @IsEmpty EQ
+-- True
+-- TrueT
+--
+data IsEmpty
+
+instance (Show as, AsEmpty as) => P IsEmpty as where
+  type PP IsEmpty as = Bool
+  eval _ opts as =
+    let b = has _Empty as
+    in pure $ mkNodeB opts b ["IsEmpty" <> show1 opts " | " as] []
+
+-- | similar to 'null' using 'Foldable'
+--
+-- >>> pz @Null [1,2,3,4]
+-- False
+-- FalseT
+--
+-- >>> pz @Null []
+-- True
+-- TrueT
+--
+-- >>> pz @Null Nothing
+-- True
+-- TrueT
+--
+data Null
+
+instance (Show (t a)
+        , Foldable t
+        , t a ~ as
+        ) => P Null as where
+  type PP Null as = Bool
+  eval _ opts as =
+    let b = null as
+    in pure $ mkNodeB opts b ["Null" <> show1 opts " | " as] []
+
+-- | similar to 'enumFromTo'
+--
+-- >>> pz @(EnumFromTo 2 5) ()
+-- Present [2,3,4,5]
+-- PresentT [2,3,4,5]
+--
+-- >>> pz @(EnumFromTo 'LT 'GT) ()
+-- Present [LT,EQ,GT]
+-- PresentT [LT,EQ,GT]
+--
+-- >>> pz @(EnumFromTo 'GT 'LT) ()
+-- Present []
+-- PresentT []
+--
+-- >>> pz @(EnumFromTo (Pred Id) (Succ Id)) (SG.Max 10)
+-- Present [Max {getMax = 9},Max {getMax = 10},Max {getMax = 11}]
+-- PresentT [Max {getMax = 9},Max {getMax = 10},Max {getMax = 11}]
+--
+
+data EnumFromTo p q
+instance (P p x
+        , P q x
+        , PP p x ~ a
+        , Show a
+        , PP q x ~ a
+        , Enum a
+        ) => P (EnumFromTo p q) x where
+  type PP (EnumFromTo p q) x = [PP p x]
+  eval _ opts z = do
+    let msg0 = "EnumFromTo"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts z []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) -> mkNode opts (PresentT (enumFromTo p q)) [msg0 <> " [" <> show p <> " .. " <> show q <> "]"] [hh pp, hh qq]
+
+type MapMaybe p q = ConcatMap (p >> MaybeIn MEmptyP '[Id]) q
+type CatMaybes q = MapMaybe Id q
+
+-- | similar to 'partitionEithers'
+--
+-- >>> pz @PartitionEithers [Left 'a',Right 2,Left 'c',Right 4,Right 99]
+-- Present ("ac",[2,4,99])
+-- PresentT ("ac",[2,4,99])
+--
+-- >>> pz @PartitionEithers [Right 2,Right 4,Right 99]
+-- Present ([],[2,4,99])
+-- PresentT ([],[2,4,99])
+--
+-- >>> pz @PartitionEithers [Left 'a',Left 'c']
+-- Present ("ac",[])
+-- PresentT ("ac",[])
+--
+-- >>> pz @PartitionEithers ([] @(Either _ _))
+-- Present ([],[])
+-- PresentT ([],[])
+--
+data PartitionEithers
+
+instance (Show a, Show b) => P PartitionEithers [Either a b] where
+  type PP PartitionEithers [Either a b] = ([a], [b])
+  eval _ opts as =
+    let msg0 = "PartitionEithers"
+        b = partitionEithers as
+    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b as] []
+
+-- | similar to 'partitionThese'. returns a 3-tuple with the results so use 'Fst' 'Snd' 'Thd' to extract
+--
+-- >>> pz @PartitionThese [This 'a', That 2, This 'c', These 'z' 1, That 4, These 'a' 2, That 99]
+-- Present ("ac",[2,4,99],[('z',1),('a',2)])
+-- PresentT ("ac",[2,4,99],[('z',1),('a',2)])
+--
+data PartitionThese
+instance (Show a, Show b) => P PartitionThese [These a b] where
+  type PP PartitionThese [These a b] = ([a], [b], [(a, b)])
+  eval _ opts as =
+    let msg0 = "PartitionThese"
+        b = partitionThese as
+    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b as] []
+
+type Thiss = Fst PartitionThese
+type Thats = Snd PartitionThese
+type Theses = Thd PartitionThese
+
+-- want to pass Proxy b to q but then we have no way to calculate 'b'
+
+-- | similar to 'scanl'
+--
+-- >>> pz @(Scanl (Snd Id :+ Fst Id) (Fst Id) (Snd Id)) ([99],[1..5])
+-- Present [[99],[1,99],[2,1,99],[3,2,1,99],[4,3,2,1,99],[5,4,3,2,1,99]]
+-- PresentT [[99],[1,99],[2,1,99],[3,2,1,99],[4,3,2,1,99],[5,4,3,2,1,99]]
+--
+-- >>> pz @(ScanN 4 Id (Succ Id)) 'c'
+-- Present "cdefg"
+-- PresentT "cdefg"
+--
+-- >>> pz @(FoldN 4 Id (Succ Id)) 'c'
+-- Present 'g'
+-- PresentT 'g'
+--
+
+data Scanl p q r
+-- scanr :: (a -> b -> b) -> b -> [a] -> [b]
+-- result is scanl but signature is flipped ((a,b) -> b) -> b -> [a] -> [b]
+
+type ScanN n p q = Scanl (Fst Id >> q) p (EnumFromTo 1 n) -- n times using q then run p
+type ScanNA q = ScanN (Fst Id) (Snd Id) q
+
+type FoldN n p q = Last (ScanN n p q)
+type Foldl p q r = Last (Scanl p q r)
+
+instance (PP p (b,a) ~ b
+        , PP q x ~ b
+        , PP r x ~ [a]
+        , P p (b,a)
+        , P q x
+        , P r x
+        , Show b
+        , Show a
+        )
+     => P (Scanl p q r) x where
+  type PP (Scanl p q r) x = [PP q x]
+  eval _ opts z = do
+    let msg0 = "Scanl"
+    lr <- runPQ msg0 (Proxy @q) (Proxy @r) opts z []
+    case lr of
+      Left e -> pure e
+      Right (q,r,qq,rr) -> do
+        let msg1 = msg0  -- <> show0 opts " " q <> show0 opts " " r
+            ff i b as' rs
+               | i >= _MX = pure (rs, Left $ mkNode opts (FailT (msg1 <> ":failed at i=" <> showIndex i)) [msg1 <> " i=" <> showIndex i <> " (b,as')=" <> show (b,as')] [])
+               | otherwise =
+                   case as' of
+                     [] -> pure (rs, Right ()) -- ++ [((i,q), mkNode opts (PresentT q) [msg1 <> "(done)"] [])], Right ())
+                     a:as -> do
+                        pp :: TT b <- eval (Proxy @p) opts (b,a)
+                        case getValueLR opts (msg1 <> " i=" <> showIndex i <> " a=" <> show a) pp [] of
+                           Left e  -> pure (rs,Left e)
+                           Right b' -> ff (i+1) b' as (rs ++ [((i,b), pp)])
+        (ts,lrx) :: ([((Int, b), TT b)], Either (TT [b]) ()) <- ff 1 q r []
+        pure $ case splitAndAlign opts [msg1] (((0,q), mkNode opts (PresentT q) [msg1 <> "(initial)"] []) : ts) of
+             Left _e -> error "cant happen!"
+             Right (vals,itts) ->
+               case lrx of
+                 Left e -> mkNode opts (_tBool e) [msg1] (hh qq : hh rr : map (hh . fixit) itts ++ [hh e])
+                 Right () -> mkNode opts (PresentT vals) [show01' opts msg1 vals "b=" q <> show1 opts " | as=" r] (hh qq : hh rr : map (hh . fixit) itts)
+
+type family UnfoldT mbs where
+  UnfoldT (Maybe (b,s)) = b
+
+-- | similar to 'unfoldr'
+--
+-- >>> pz @(Unfoldr (MaybeBool (Not Null) (SplitAt 2 Id)) Id) [1..5]
+-- Present [[1,2],[3,4],[5]]
+-- PresentT [[1,2],[3,4],[5]]
+--
+-- >>> pz @(IterateN 4 (Succ Id)) 4
+-- Present [4,5,6,7]
+-- 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)
+type IterateN n f = Unfoldr (MaybeBool (Fst Id > 0) '(Snd Id, Pred Id *** f)) '(n, Id)
+type IterateUntil p f = IterateWhile (Not p) f
+type IterateWhile p f = Unfoldr (MaybeBool p '(Id, f)) Id
+type IterateNWhile n p f = '(n, Id) >> IterateWhile (Fst Id > 0 && (Snd Id >> p)) (Pred Id *** f) >> Map (Snd Id) Id
+type IterateNUntil n p f = IterateNWhile n (Not p) f
+
+instance (PP q a ~ s
+        , PP p s ~ Maybe (b,s)
+        , P q a
+        , P p s
+        , Show s
+        , Show b
+          )
+     => P (Unfoldr p q) a where
+  type PP (Unfoldr p q) a = [UnfoldT (PP p (PP q a))]
+  eval _ opts z = do
+    let msg0 = "Unfoldr"
+    qq <- eval (Proxy @q) opts z
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        let msg1 = msg0 <> show0 opts " " q
+            ff i s rs | i >= _MX = pure (rs, Left $ mkNode opts (FailT (msg1 <> ":failed at i=" <> showIndex i)) [msg1 <> " i=" <> showIndex i <> " s=" <> show s] [])
+                      | otherwise = do
+                              pp :: TT (PP p s) <- eval (Proxy @p) opts s
+                              case getValueLR opts (msg1 <> " i=" <> showIndex i <> " s=" <> show s) pp [] of
+                                   Left e  -> pure (rs, Left e)
+                                   Right Nothing -> pure (rs, Right ())
+                                   Right w@(Just (_b,s')) -> ff (i+1) s' (rs ++ [((i,w), pp)])
+        (ts,lr) :: ([((Int, PP p s), TT (PP p s))], Either (TT [b]) ()) <- ff 1 q []
+        pure $ case splitAndAlign opts [msg1] ts of
+             Left _e -> error "cant happen"
+             Right (vals, itts) ->
+               case lr of
+                 Left e -> mkNode opts (_tBool e) [msg1] (hh qq : map (hh . fixit) itts ++ [hh e])
+                 Right () ->
+                   let ret = fst <$> catMaybes vals
+                   in mkNode opts (PresentT ret) [show01' opts msg1 ret "s=" q ] (hh qq : map (hh . fixit) itts)
+
+-- | similar to 'map'
+--
+-- >>> pz @(Map (Pred Id) Id) [1..5]
+-- Present [0,1,2,3,4]
+-- PresentT [0,1,2,3,4]
+--
+data Map p q
+type ConcatMap p q = Concat (Map p q)
+
+instance (Show (PP p a)
+        , P p a
+        , PP q x ~ f a
+        , P q x
+        , Show a
+        , Show (f a)
+        , Foldable f
+        ) => P (Map p q) x where
+  type PP (Map p q) x = [PP p (ExtractAFromTA (PP q x))]
+  eval _ opts x = do
+    let msg0 = "Map"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        ts <- zipWithM (\i a -> ((i, a),) <$> eval (Proxy @p) opts a) [0::Int ..] (toList q)
+        pure $ case splitAndAlign opts [msg0] ts of
+             Left e -> e
+             Right (vals, _) -> mkNode opts (PresentT vals) [show01 opts msg0 vals q] (hh qq : map (hh . fixit) ts)
+
+-- | if p then run q else run r
+--
+-- >>> pz @(If (Gt 4) "greater than 4" "less than or equal to 4" ) 10
+-- Present "greater than 4"
+-- PresentT "greater than 4"
+--
+-- >>> pz @(If (Gt 4) "greater than 4" "less than or equal to 4") 0
+-- Present "less than or equal to 4"
+-- PresentT "less than or equal to 4"
+data If p q r
+
+instance (Show (PP r a)
+        , P p a
+        , PP p a ~ Bool
+        , P q a
+        , P r a
+        , PP q a ~ PP r a
+        ) => P (If p q r) a where
+  type PP (If p q r) a = PP q a
+  eval _ opts a = do
+    let msg0 = "If"
+    pp <- evalBool (Proxy @p) opts a
+    case getValueLR opts (msg0 <> " condition failed") pp [] of
+      Left e -> pure e
+      Right b -> do
+        qqrr <- if b
+              then eval (Proxy @q) opts a
+              else eval (Proxy @r) opts a
+        pure $ case getValueLR opts (msg0 <> " [" <> show b <> "]") qqrr [hh pp, hh qqrr] of
+          Left e -> e
+          Right ret -> mkNode opts (_tBool qqrr) [msg0 <> " " <> if b then "(true cond)" else "(false cond)" <> show0 opts " " ret] [hh pp, hh qqrr]
+
+-- | creates a list of overlapping pairs of elements. requires two or more elements
+--
+-- >>> pz @Pairs [1,2,3,4]
+-- Present [(1,2),(2,3),(3,4)]
+-- PresentT [(1,2),(2,3),(3,4)]
+--
+-- >>> pz @Pairs []
+-- Error Pairs no data found
+-- FailT "Pairs no data found"
+--
+-- >>> pz @Pairs [1]
+-- Error Pairs only one element found
+-- FailT "Pairs only one element found"
+--
+data Pairs
+instance Show a => P Pairs [a] where
+  type PP Pairs [a] = [(a,a)]
+  eval _ opts as =
+    let msg0 = "Pairs"
+        lr = case as of
+               [] -> Left (msg0 <> " no data found")
+               [_] -> Left (msg0 <> " only one element found")
+               _:bs@(_:_) -> Right (zip as bs)
+    in pure $ case lr of
+         Left e -> mkNode opts (FailT e) [e] []
+         Right zs -> mkNode opts (PresentT zs) [show01 opts msg0 zs as ] []
+
+
+-- | similar to 'partition'
+--
+-- >>> pz @(Partition (Ge 3) Id) [10,4,1,7,3,1,3,5]
+-- Present ([10,4,7,3,3,5],[1,1])
+-- PresentT ([10,4,7,3,3,5],[1,1])
+--
+-- >>> pz @(Partition (Prime Id) Id) [10,4,1,7,3,1,3,5]
+-- Present ([7,3,3,5],[10,4,1,1])
+-- PresentT ([7,3,3,5],[10,4,1,1])
+--
+-- >>> pz @(Partition (Ge 300) Id) [10,4,1,7,3,1,3,5]
+-- Present ([],[10,4,1,7,3,1,3,5])
+-- PresentT ([],[10,4,1,7,3,1,3,5])
+--
+-- >>> pz @(Partition (Id < 300) Id) [10,4,1,7,3,1,3,5]
+-- Present ([10,4,1,7,3,1,3,5],[])
+-- PresentT ([10,4,1,7,3,1,3,5],[])
+--
+data Partition p q
+
+type Filter p q = Partition p q >> Fst Id
+
+instance (P p x
+        , Show x
+        , PP q a ~ [x]
+        , PP p x ~ Bool
+        , P q a
+        ) => P (Partition p q) a where
+  type PP (Partition p q) a = (PP q a, PP q a)
+  eval _ opts a' = do
+    let msg0 = "Partition"
+    qq <- eval (Proxy @q) opts a'
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case chkSize opts msg0 q [hh qq] of
+          Left e -> pure e
+          Right () -> do
+             ts <- zipWithM (\i a -> ((i, a),) <$> evalBool (Proxy @p) opts a) [0::Int ..] q
+             pure $ case splitAndAlign opts [msg0] ts of
+               Left e -> e
+               Right (vals, tfs) ->
+                 let w0 = partition fst $ zip vals tfs
+                     zz1 = (map (snd . fst . snd) *** map (snd . fst . snd)) w0
+                 in mkNode opts (PresentT zz1) [show01' opts msg0 zz1 "s=" q] (hh qq : map (hh . fixit) tfs)
+
+
+-- | similar to 'break'
+--
+-- >>> pz @(Break (Ge 3) Id) [10,4,1,7,3,1,3,5]
+-- Present ([],[10,4,1,7,3,1,3,5])
+-- PresentT ([],[10,4,1,7,3,1,3,5])
+--
+-- >>> pz @(Break (Lt 3) Id) [10,4,1,7,3,1,3,5]
+-- Present ([10,4],[1,7,3,1,3,5])
+-- PresentT ([10,4],[1,7,3,1,3,5])
+--
+data Break p q
+type Span p q = Break (Not p) q
+-- only process up to the pivot! only process while Right False
+-- a predicate can return PresentP not just TrueP
+instance (P p x
+        , PP q a ~ [x]
+        , PP p x ~ Bool
+        , P q a
+        ) => P (Break p q) a where
+  type PP (Break p q) a = (PP q a, PP q a)
+  eval _ opts a' = do
+    let msg0 = "Break"
+    qq <- eval (Proxy @q) opts a'
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case chkSize opts msg0 q [hh qq] of
+          Left e -> pure e
+          Right () -> do
+            let ff [] zs = pure (zs, [], Nothing) -- [(ia,qq)] extras | the rest of the data | optional last pivot or error
+                ff ((i,a):ias) zs = do
+                   pp <- evalBool (Proxy @p) opts a
+                   let v = ((i,a), pp)
+                   case getValueLR opts msg0 pp [hh qq] of
+                     Right False -> ff ias (zs Seq.|> v)
+                     Right True -> pure (zs,map snd ias,Just v)
+                     Left _ -> pure (zs,map snd ias,Just v)
+            (ialls,rhs,mpivot) <- ff (zip [0::Int ..] q) Seq.empty
+            pure $ case mpivot of
+                 Nothing ->
+                   mkNode opts (PresentT (map (snd . fst) (toList ialls), rhs))
+                           ([msg0] <> ["cnt=" <> show (length ialls, length rhs)])
+                           (map (hh . fixit) (toList ialls))
+                 Just iall@(ia, tt) ->
+                   case getValueLR opts (msg0 <> " predicate failed") tt (hh qq : map (hh . fixit) (toList (ialls Seq.|> iall))) of
+                     Right True ->
+                       mkNode opts (PresentT (map (snd . fst) (toList ialls), snd ia : rhs))
+                               ([msg0] <> ["cnt=" <> show (length ialls, 1+length rhs)])
+                               (hh qq : hh tt : map (hh . fixit) (toList (ialls Seq.|> iall)))
+
+                     Right False -> error "shouldnt happen"
+                     Left e -> e
+
+-- | Fails the computation with a message
+--
+-- >>> pz @(Failt Int (PrintF "value=%03d" Id)) 99
+-- Error value=099
+-- FailT "value=099"
+--
+-- >>> pz @(FailS (PrintT "value=%03d string=%s" Id)) (99,"somedata")
+-- Error value=099 string=somedata
+-- FailT "value=099 string=somedata"
+--
+data Fail t prt
+type Failp s = Fail Unproxy s
+type Failt (t :: Type) prt = Fail (Hole t) prt
+type FailS s = Fail I s
+
+instance (P prt a
+        , PP prt a ~ String
+        ) => P (Fail t prt) a where
+  type PP (Fail t prt) a = PP t a
+  eval _ opts a = do
+    let msg0 = "Fail"
+    pp <- eval (Proxy @prt) opts a
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right s -> mkNode opts (FailT s) [msg0 <> " " <> s] (if isVerbose opts then [hh pp] else [])
+
+data Hole (t :: Type)
+
+-- | Acts as a proxy in this dsl where you can explicitly set the Type.
+--
+--  It is passed around as an argument to help the type checker when needed.
+--  see 'ReadP, 'ParseTimeP', 'ShowP'
+--
+instance Typeable t => P (Hole t) a where
+  type PP (Hole t) a = t -- can only be Type not Type -> Type (can use Proxy but then we go down the rabbithole)
+  eval _ opts _a =
+    let msg0 = "Hole(" <> showT @t <> ")"
+    in pure $ mkNode opts (FailT msg0) [msg0 <> " you probably meant to get access to the type of PP only and not evaluate"] []
+
+data Unproxy
+
+instance Typeable a => P Unproxy (Proxy (a :: Type)) where
+  type PP Unproxy (Proxy a) = a
+  eval _ opts _a =
+    let msg0 = "Unproxy(" <> showT @a <> ")"
+    in pure $ mkNode opts (FailT msg0) [msg0 <> " you probably meant to get access to the type of PP only and not evaluate"] []
+
+-- | catch a failure
+--
+-- >>> pz @(Catch (Succ Id) (Fst Id >> Second (ShowP Id) >> PrintT "%s %s" Id >> 'LT)) GT
+-- Present LT
+-- PresentT LT
+--
+-- >>> pz @(Catch' (Succ Id) (Second (ShowP Id) >> PrintT "%s %s" Id)) GT
+-- Error Succ IO e=Prelude.Enum.Ordering.succ: bad argument GT
+-- FailT "Succ IO e=Prelude.Enum.Ordering.succ: bad argument GT"
+--
+-- >>> pz @(Catch' (Succ Id) (Second (ShowP Id) >> PrintT "%s %s" Id)) LT
+-- Present EQ
+-- PresentT EQ
+--
+-- 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
+data Catch p q -- catch p and if fails runs q only on failt
+type Catch' p s = Catch p (FailCatch s) -- eg set eg s=PrintF "%d" Id or PrintF "%s" (ShowP Id)
+type FailCatch s = Fail (Snd Id >> Unproxy) (Fst Id >> s)
+
+instance (P p x
+        , P q ((String, x)
+        , Proxy (PP p x))
+        , PP p x ~ PP q ((String, x), Proxy (PP p x))
+        ) => P (Catch p q) x where
+  type PP (Catch p q) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Catch"
+    pp <- eval (Proxy @p) opts x
+    case getValueLR opts msg0 pp [] of
+      Left e -> do
+         let emsg = e ^?! tBool . _FailT -- extract the failt string a push back into the fail case
+         qq <- eval (Proxy @q) opts ((emsg, x), Proxy @(PP p x))
+         pure $ case getValueLR opts (msg0 <> " default condition failed") qq [hh pp] of
+            Left e1 -> e1
+            Right _ -> mkNode opts (_tBool qq) [msg0 <> " caught exception[" <> emsg <> "]"] [hh pp, hh qq]
+      Right _ -> pure $ mkNode opts (_tBool pp) [msg0 <> " did not fire"] [hh pp]
+
+-- | similar to 'even'
+--
+-- >>> pz @(Map Even Id) [9,-4,12,1,2,3]
+-- Present [False,True,True,False,True,False]
+-- PresentT [False,True,True,False,True,False]
+--
+-- >>> pz @(Map '(Even,Odd) Id) [9,-4,12,1,2,3]
+-- Present [(False,True),(True,False),(True,False),(False,True),(True,False),(False,True)]
+-- PresentT [(False,True),(True,False),(True,False),(False,True),(True,False),(False,True)]
+--
+type Even = Mod I 2 == 0
+type Odd = Mod I 2  == 1
+--type Div' p q = Fst (DivMod p q)
+--type Mod' p q = Snd (DivMod p q)
+
+-- | similar to 'div'
+--
+-- >>> pz @(Div (Fst Id) (Snd Id)) (10,4)
+-- Present 2
+-- PresentT 2
+--
+-- >>> pz @(Div (Fst Id) (Snd Id)) (10,0)
+-- Error Div zero denominator
+-- FailT "Div zero denominator"
+--
+data Div p q
+instance (PP p a ~ PP q a
+        , P p a
+        , P q a
+        , Show (PP p a)
+        , Integral (PP p a)
+        ) => P (Div p q) a where
+  type PP (Div p q) a = PP p a
+  eval _ opts a = do
+    let msg0 = "Div"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+         let hhs = [hh pp, hh qq]
+         in case q of
+              0 -> mkNode opts (FailT (msg0 <> " zero denominator")) [msg0 <> " zero denominator"] hhs
+              _ -> let d = p `div` q
+                   in mkNode opts (PresentT d) [show p <> " `div` " <> show q <> " = " <> show d] hhs
+
+
+-- | similar to 'mod'
+--
+-- >>> pz @(Mod (Fst Id) (Snd Id)) (10,3)
+-- Present 1
+-- PresentT 1
+--
+-- >>> pz @(Mod (Fst Id) (Snd Id)) (10,0)
+-- Error Mod zero denominator
+-- FailT "Mod zero denominator"
+--
+data Mod p q
+instance (PP p a ~ PP q a
+        , P p a
+        , P q a
+        , Show (PP p a)
+        , Integral (PP p a)
+        ) => P (Mod p q) a where
+  type PP (Mod p q) a = PP p a
+  eval _ opts a = do
+    let msg0 = "Mod"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+         let hhs = [hh pp, hh qq]
+         in case q of
+              0 -> mkNode opts (FailT (msg0 <> " zero denominator")) [msg0 <> " zero denominator"] hhs
+              _ -> let d = p `mod` q
+                   in mkNode opts (PresentT d) [show p <> " `mod` " <> show q <> " = " <> show d] hhs
+
+-- | similar to 'divMod'
+--
+-- >>> pz @(DivMod (Fst Id) (Snd Id)) (10,3)
+-- Present (3,1)
+-- PresentT (3,1)
+--
+-- >>> pz @(DivMod (Fst Id) (Snd Id)) (10,-3)
+-- Present (-4,-2)
+-- PresentT (-4,-2)
+--
+-- >>> pz @(DivMod (Fst Id) (Snd Id)) (-10,3)
+-- Present (-4,2)
+-- PresentT (-4,2)
+--
+-- >>> pz @(DivMod (Fst Id) (Snd Id)) (-10,-3)
+-- Present (3,-1)
+-- PresentT (3,-1)
+--
+-- >>> pz @(DivMod (Fst Id) (Snd Id)) (10,0)
+-- Error DivMod zero denominator
+-- FailT "DivMod zero denominator"
+--
+data DivMod p q
+
+instance (PP p a ~ PP q a
+        , P p a
+        , P q a
+        , Show (PP p a)
+        , Integral (PP p a)
+        ) => P (DivMod p q) a where
+  type PP (DivMod p q) a = (PP p a, PP p a)
+  eval _ opts a = do
+    let msg0 = "DivMod"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let hhs = [hh pp, hh qq]
+        in case q of
+             0 -> mkNode opts (FailT (msg0 <> " zero denominator")) [msg0 <> " zero denominator"] hhs
+             _ -> let d = p `divMod` q
+                  in mkNode opts (PresentT d) [show p <> " `divMod` " <> show q <> " = " <> show d] hhs
+
+-- | similar to 'quotRem'
+--
+-- >>> pz @(QuotRem (Fst Id) (Snd Id)) (10,3)
+-- Present (3,1)
+-- PresentT (3,1)
+--
+-- >>> pz @(QuotRem (Fst Id) (Snd Id)) (10,-3)
+-- Present (-3,1)
+-- PresentT (-3,1)
+--
+-- >>> pz @(QuotRem (Fst Id) (Snd Id)) (-10,-3)
+-- Present (3,-1)
+-- PresentT (3,-1)
+--
+-- >>> pz @(QuotRem (Fst Id) (Snd Id)) (-10,3)
+-- Present (-3,-1)
+-- PresentT (-3,-1)
+--
+-- >>> pz @(QuotRem (Fst Id) (Snd Id)) (10,0)
+-- Error QuotRem zero denominator
+-- FailT "QuotRem zero denominator"
+--
+data QuotRem p q
+
+instance (PP p a ~ PP q a
+        , P p a
+        , P q a
+        , Show (PP p a)
+        , Integral (PP p a)
+        ) => P (QuotRem p q) a where
+  type PP (QuotRem p q) a = (PP p a, PP p a)
+  eval _ opts a = do
+    let msg0 = "QuotRem"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let hhs = [hh pp, hh qq]
+        in case q of
+             0 -> mkNode opts (FailT (msg0 <> " zero denominator")) [msg0 <> " zero denominator"] hhs
+             _ -> let d = p `quotRem` q
+                  in mkNode opts (PresentT d) [show p <> " `quotRem` " <> show q <> " = " <> show d] hhs
+
+type Quot p q = Fst (QuotRem p q)
+type Rem p q = Snd (QuotRem p q)
+
+--type OneP = Guard "expected list of length 1" (Len == 1) >> Head Id
+type OneP = Guard (PrintF "expected list of length 1 but found length=%d" Len) (Len == 1) >> Head Id
+
+-- k or prt has access to (Int,a) where Int is the current guard position: hence need to use PrintT
+-- todo: better explanation of how this works
+-- passthru but adds the length of ps (replaces LenT in the type synonym to avoid type synonyms being expanded out)
+
+-- | Guards contain a type level list of tuples the action to run on failure of the predicate and the predicate itself
+-- Each tuple validating against the corresponding value in a value list
+--
+-- \'prt\' receives (Int,a) as input which is the position and value if there is a failure
+--
+-- >>> pz @(Guards '[ '("arg1 failed",Gt 4), '("arg2 failed", Same 4)]) [17,4]
+-- Present [17,4]
+-- PresentT [17,4]
+--
+-- >>> pz @(Guards '[ '("arg1 failed",Gt 4), '("arg2 failed", Same 5)]) [17,4]
+-- Error arg2 failed
+-- FailT "arg2 failed"
+--
+-- >>> pz @(Guards '[ '("arg1 failed",Gt 99), '("arg2 failed", Same 4)]) [17,4]
+-- Error arg1 failed
+-- FailT "arg1 failed"
+--
+-- >>> pz @(Guards '[ '(PrintT "arg %d failed with value %d" Id,Gt 4), '(PrintT "%d %d" Id, Same 4)]) [17,3]
+-- Error 2 3
+-- FailT "2 3"
+--
+-- >>> pz @(GuardsQuick (PrintT "arg %d failed with value %d" Id) '[Gt 4, Ge 3, Same 4]) [17,3,5]
+-- Error arg 3 failed with value 5
+-- FailT "arg 3 failed with value 5"
+--
+-- >>> pz @(GuardsQuick (PrintT "arg %d failed with value %d" Id) '[Gt 4, Ge 3, Same 4]) [17,3,5,99]
+-- Error Guards: data elements(4) /= predicates(3)
+-- FailT "Guards: data elements(4) /= predicates(3)"
+--
+data GuardsImpl (n :: Nat) (os :: [(k,k1)])
+type GuardsQuick (prt :: k) (os :: [k1]) = Guards (ToGuardsT prt os)
+
+data Guards (ps :: [(k,k1)])
+
+instance (GetLen ps, P (GuardsImpl (LenT ps) ps) [a]) => P (Guards ps) [a] where
+  type PP (Guards ps) [a] = PP (GuardsImpl (LenT ps) ps) [a]
+  eval _ opts as = do
+    let msgbase0 = "Guards"
+        n = getLen @ps
+    if n /= length as then
+       let xx = msgbase0 <> ": data elements(" <> show (length as) <> ") /= predicates(" <> show n <> ")"
+       in pure $ mkNode opts (FailT xx) [xx] []
+    else eval (Proxy @(GuardsImpl (LenT ps) ps)) opts as
+
+instance (KnownNat n
+        , Show a
+        ) => P (GuardsImpl n ('[] :: [(k,k1)])) [a] where
+  type PP (GuardsImpl n ('[] :: [(k,k1)])) [a] = [a]
+  eval _ opts as =
+    let msg0 = "Guards" <> "(" <> show n <> ")"
+        n :: Int = nat @n
+    in if not (null as) then error $ "programmer error: GuardsImpl base case has extra data " ++ show as
+       else pure $ mkNode opts (PresentT as) [msg0 <> " done!"] []
+
+instance (PP prt (Int, a) ~ String
+        , P prt (Int, a)
+        , KnownNat n
+        , GetLen ps
+        , P p a
+        , PP p a ~ Bool
+        , P (GuardsImpl n ps) [a]
+        , PP (GuardsImpl n ps) [a] ~ [a]
+        , Show a
+        ) => P (GuardsImpl n ('(prt,p) ': ps)) [a] where
+  type PP (GuardsImpl n ('(prt,p) ': ps)) [a] = [a]
+  eval _ opts as' = do
+     let msgbase1 = "Guard" <> "(" <> show (n-pos) <> ")"
+         msgbase2 = "Guards"
+         n :: Int = nat @n
+         pos = getLen @ps
+     case as' of
+         a:as -> do
+                    pp <- evalBool (Proxy @p) opts a
+                    case getValueLR opts (msgbase1 <> " p failed") pp [] of
+                         Left e -> pure e
+                         Right False -> do
+                           qq <- eval (Proxy @prt) opts (n-pos,a) -- only run prt when predicate is False
+                           pure $ case getValueLR opts (msgbase2 <> " False predicate and prt failed") qq [hh pp] of
+                              Left e -> e
+                              Right msgx -> mkNode opts (FailT msgx) [msgbase1 <> " failed [" <> msgx <> "]" <> show0 opts " " a] (hh pp : if isVerbose opts then [hh qq] else [])
+                         Right True -> do
+                           ss <- eval (Proxy @(GuardsImpl n ps)) opts as
+                           pure $ case getValueLRHide opts (msgbase1 <> " ok | rhs failed") ss [hh pp] of
+                             Left e -> e -- shortcut else we get too compounding errors with the pp tree being added each time!
+                             Right zs -> mkNode opts (PresentT (a:zs)) [msgbase1 <> show0 opts " " a] [hh pp, hh ss]
+         _ -> error $ "programmer error: GuardsImpl n+1 case has no data"
+
+-- | boolean guard which checks a given a list of predicates against the list of values
+--
+-- pulls the top message from the tree if a predicate is false
+--
+-- >>> pl @(Bools '[ '(W "hh",Between 0 23), '(W "mm",Between 0 59), '(PrintT "<<<%d %d>>>" Id,Between 0 59) ] ) [12,93,14]
+-- False (GuardBool(1) [mm] (93 <= 59))
+-- FalseT
+--
+-- >>> pl @(Bools '[ '(W "hh",Between 0 23), '(W "mm",Between 0 59), '(PrintT "<<<%d %d>>>" Id,Between 0 59) ] ) [12,13,94]
+-- False (GuardBool(2) [<<<2 94>>>] (94 <= 59))
+-- FalseT
+--
+-- >>> pl @(Bools '[ '(W "hh",Between 0 23), '(W "mm",Between 0 59), '(PrintT "<<<%d %d>>>" Id,Between 0 59) ] ) [12,13,14]
+-- True (GuardBool(0) 12)
+-- TrueT
+--
+-- >>> pl @(BoolsQuick "abc" '[Between 0 23, Between 0 59, Between 0 59]) [12,13,14]
+-- True (GuardBool(0) 12)
+-- TrueT
+--
+-- >>> pl @(BoolsQuick (PrintT "id=%d val=%d" Id) '[Between 0 23, Between 0 59, Between 0 59]) [12,13,14]
+-- True (GuardBool(0) 12)
+-- TrueT
+--
+-- >>> pl @(BoolsQuick (PrintT "id=%d val=%d" Id) '[Between 0 23, Between 0 59, Between 0 59]) [12,13,99]
+-- False (GuardBool(2) [id=2 val=99] (99 <= 59))
+-- FalseT
+--
+data Bools (ps :: [(k,k1)])
+type BoolsQuick (prt :: k) (ps :: [k1]) = Bools (ToGuardsT prt ps)
+
+instance (GetLen ps
+        , P (BoolsImpl (LenT ps) ps) [a]
+        , PP (BoolsImpl (LenT ps) ps) [a] ~ Bool
+        ) => P (Bools ps) [a] where
+  type PP (Bools ps) [a] = Bool
+  eval _ opts as = do
+    let msgbase0 = "Bools("++show n++")"
+        n = getLen @ps
+    if n /= length as then
+       let xx = msgbase0 <> ": data elements(" <> show (length as) <> ") /= predicates(" <> show n <> ")"
+       in pure $ mkNode opts (FailT xx) [xx] []
+    else evalBool (Proxy @(BoolsImpl (LenT ps) ps)) opts as
+
+data BoolsImpl (n :: Nat) (os :: [(k,k1)])
+
+instance (KnownNat n
+        , Show a
+        ) => P (BoolsImpl n ('[] :: [(k,k1)])) [a] where
+  type PP (BoolsImpl n ('[] :: [(k,k1)])) [a] = Bool
+  eval _ opts as =
+    let msg0 = "Bools" <> "(" <> show n <> ")"
+        n :: Int = nat @n
+    in if not (null as) then error $ "programmer error: BoolsImpl base case has extra data " ++ show as
+       else pure $ mkNodeB opts True [msg0 <> " done!"] []
+
+instance (PP prt (Int, a) ~ String
+        , P prt (Int, a)
+        , KnownNat n
+        , GetLen ps
+        , P p a
+        , PP p a ~ Bool
+        , P (BoolsImpl n ps) [a]
+        , PP (BoolsImpl n ps) [a] ~ Bool
+        , Show a
+        ) => P (BoolsImpl n ('(prt,p) ': ps)) [a] where
+  type PP (BoolsImpl n ('(prt,p) ': ps)) [a] = Bool
+  eval _ opts as' = do
+     let cpos = n-pos-1
+         msgbase1 = "GuardBool" <> "(" <> showIndex cpos <> ")"
+         msgbase2 = "Bools"
+         n :: Int = nat @n
+         pos = getLen @ps
+     case as' of
+         a:as -> do
+                    pp <- evalBool (Proxy @p) opts a
+                    case getValueLR opts (msgbase1 <> " p failed") pp [] of
+                         Left e -> pure e
+                         Right False -> do
+                           qq <- eval (Proxy @prt) opts (cpos,a) -- only run prt when predicate is False
+                           pure $ case getValueLR opts (msgbase2 <> " False predicate and prt failed") qq [hh pp] of
+                              Left e -> e
+                              Right msgx -> mkNodeB opts False [msgbase1 <> " [" <> msgx <> "] " <> topMessage pp] (hh pp : if isVerbose opts then [hh qq] else [])
+                         Right True -> do
+                           ss <- evalBool (Proxy @(BoolsImpl n ps)) opts as
+                           pure $ case getValueLRHide opts (msgbase1 <> " ok | rhs failed") ss [hh pp] of
+                             Left e -> e -- shortcut else we get too compounding errors with the pp tree being added each time!
+                             Right True -> mkNodeB opts True [msgbase1 <> show0 opts " " a] [hh pp, hh ss]
+                             Right False -> ss & tForest %~ \x -> fromTT pp : x
+         _ -> error $ "programmer error: BoolsImpl n+1 case has no data"
+
+-- | leverages 'RepeatT' for repeating predicates (passthrough method)
+--
+-- >>> pl @(BoolsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255)) [121,33,7,256]
+-- False (GuardBool(3) [id=3 must be between 0 and 255, found 256] (256 <= 255))
+-- FalseT
+--
+-- >>> pz @(GuardsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255)) [121,33,7,44]
+-- Present [121,33,7,44]
+-- PresentT [121,33,7,44]
+--
+data BoolsN prt (n :: Nat) p
+
+instance ( GetLen (ToGuardsT prt (RepeatT n p))
+  , PP (BoolsImpl (LenT (ToGuardsT prt (RepeatT n p))) (ToGuardsT prt (RepeatT n p))) [a] ~ Bool
+  , P (BoolsImpl (LenT (ToGuardsT prt (RepeatT n p))) (ToGuardsT prt (RepeatT n p))) [a]
+
+         ) => P (BoolsN prt n p) [a] where
+  type PP (BoolsN prt n p) [a] = PP (Bools (ToGuardsT prt (RepeatT n p))) [a]
+  eval _ opts as =
+    eval (Proxy @(Bools (ToGuardsT prt (RepeatT n p)))) opts as
+
+
+
+-- | if a predicate fails then then the corresponding symbol and value will be passed to the print function
+--
+-- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)]) [13,59,61]
+-- Error seconds invalid: found 61
+-- FailT "seconds invalid: found 61"
+--
+-- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)]) [27,59,12]
+-- Error hours invalid: found 27
+-- FailT "hours invalid: found 27"
+--
+-- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)]) [23,59,12]
+-- Present [23,59,12]
+-- PresentT [23,59,12]
+--
+data GuardsImplX (n :: Nat) (os :: [(k,k1)])
+
+type GuardsDetail (prt :: Symbol) (os :: [(k0,k1)]) = GuardsImplXX (ToGuardsDetailT prt os)
+
+type family ToGuardsDetailT (prt :: k1) (os :: [(k2,k3)]) :: [(Type,k3)] where
+  ToGuardsDetailT prt '[ '(s,p) ] = '(PrintT prt '(s,Id), p) : '[]
+  ToGuardsDetailT prt ( '(s,p) ': ps) = '(PrintT prt '(s,Id), p) ': ToGuardsDetailT prt ps
+  ToGuardsDetailT prt '[] = GL.TypeError ('GL.Text "ToGuardsDetailT cannot be empty")
+
+data GuardsImplXX (ps :: [(k,k1)])
+
+instance (GetLen ps
+        , P (GuardsImplX (LenT ps) ps) [a]
+        ) => P (GuardsImplXX ps) [a] where
+  type PP (GuardsImplXX ps) [a] = PP (GuardsImplX (LenT ps) ps) [a]
+  eval _ opts as = do
+    let msgbase0 = "Guards"
+        n = getLen @ps
+    if n /= length as then
+       let xx = msgbase0 <> ": data elements(" <> show (length as) <> ") /= predicates(" <> show n <> ")"
+       in pure $ mkNode opts (FailT xx) [xx] []
+    else eval (Proxy @(GuardsImplX (LenT ps) ps)) opts as
+
+instance (KnownNat n
+        , Show a
+        ) => P (GuardsImplX n ('[] :: [(k,k1)])) [a] where
+  type PP (GuardsImplX n ('[] :: [(k,k1)])) [a] = [a]
+  eval _ opts as =
+    let msg0 = "Guards" <> "(" <> show n <> ")"
+        n :: Int = nat @n
+    in if not (null as) then error $ "programmer error: GuardsImplX base case has extra data " ++ show as
+       else pure $ mkNode opts (PresentT as) [msg0 <> " done!"] []
+
+instance (PP prt a ~ String
+        , P prt a
+        , KnownNat n
+        , GetLen ps
+        , P p a
+        , PP p a ~ Bool
+        , P (GuardsImplX n ps) [a]
+        , PP (GuardsImplX n ps) [a] ~ [a]
+        , Show a
+        ) => P (GuardsImplX n ('(prt,p) ': ps)) [a] where
+  type PP (GuardsImplX n ('(prt,p) ': ps)) [a] = [a]
+  eval _ opts as' = do
+     let cpos = n-pos-1
+         msgbase1 = "Guard" <> "(" <> showIndex cpos <> ")"
+         msgbase2 = "Guards"
+         n :: Int = nat @n
+         pos = getLen @ps
+     case as' of
+         a:as -> do
+                    pp <- evalBool (Proxy @p) opts a
+                    case getValueLR opts (msgbase1 <> " p failed") pp [] of
+                         Left e -> pure e
+                         Right False -> do
+                           qq <- eval (Proxy @prt) opts a -- only run prt when predicate is False
+                           pure $ case getValueLR opts (msgbase2 <> " False predicate and prt failed") qq [hh pp] of
+                              Left e -> e
+                              Right msgx -> mkNode opts (FailT msgx) [msgbase1 <> " failed [" <> msgx <> "]" <> show0 opts " " a] (hh pp : if isVerbose opts then [hh qq] else [])
+                         Right True -> do
+                           ss <- eval (Proxy @(GuardsImplX n ps)) opts as
+                           pure $ case getValueLRHide opts (msgbase1 <> " ok | rhs failed") ss [hh pp] of
+                             Left e -> e -- shortcut else we get too compounding errors with the pp tree being added each time!
+                             Right zs -> mkNode opts (PresentT (a:zs)) [msgbase1 <> show0 opts " " a] [hh pp, hh ss]
+         _ -> error $ "programmer error: GuardsImplX n+1 case has no data"
+
+-- | leverages 'RepeatT' for repeating predicates (passthrough method)
+--
+-- >>> pz @(GuardsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255)) [121,33,7,256]
+-- Error id=4 must be between 0 and 255, found 256
+-- FailT "id=4 must be between 0 and 255, found 256"
+--
+-- >>> pz @(GuardsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255)) [121,33,7,44]
+-- Present [121,33,7,44]
+-- PresentT [121,33,7,44]
+--
+data GuardsN prt (n :: Nat) p
+
+instance ( GetLen (ToGuardsT prt (RepeatT n p))
+         , P (GuardsImpl
+             (LenT (ToGuardsT prt (RepeatT n p)))
+             (ToGuardsT prt (RepeatT n p)))
+             [a]
+         ) => P (GuardsN prt n p) [a] where
+  type PP (GuardsN prt n p) [a] = PP (Guards (ToGuardsT prt (RepeatT n p))) [a]
+  eval _ opts as =
+    eval (Proxy @(Guards (ToGuardsT prt (RepeatT n p)))) opts as
+
+
+-- | \'p\' is the predicate and on failure of the predicate runs \'prt\'
+--
+-- >>> pz @(Guard "expected > 3" (Gt 3)) 17
+-- Present 17
+-- PresentT 17
+--
+-- >>> pz @(Guard "expected > 3" (Gt 3)) 1
+-- Error expected > 3
+-- FailT "expected > 3"
+--
+-- >>> pz @(Guard (PrintF "%d not > 3" Id) (Gt 3)) (-99)
+-- Error -99 not > 3
+-- FailT "-99 not > 3"
+--
+data Guard prt p
+
+type ExitWhen prt p = Guard prt (Not p)
+
+instance (Show a
+        , P prt a
+        , PP prt a ~ String
+        , P p a
+        , PP p a ~ Bool
+        ) => P (Guard prt p) a where
+  type PP (Guard prt p) a = a
+  eval _ opts a = do
+    let msg0 = "Guard"
+    pp <- evalBool (Proxy @p) opts a
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right False -> do
+        qq <- eval (Proxy @prt) opts a
+        pure $ case getValueLR opts (msg0 <> " Msg") qq [hh pp] of
+          Left e -> e
+          Right msgx -> mkNode opts (FailT msgx) [msg0 <> "(failed) [" <> msgx <> "]" <> show0 opts " | " a] (hh pp : if isVerbose opts then [hh qq] else [])
+      Right True -> pure $ mkNode opts (PresentT a) [msg0 <> "(ok)" <> show0 opts " | " a] [hh pp]  -- dont show the guard message if successful
+
+
+-- | similar to 'Guard' but uses the root message of the False predicate case as the failure message
+--
+-- most uses of GuardSimple can be replaced by using 'ol' and a boolean predicate unless you require failure on error
+--
+-- >>> pz @(GuardSimple (Luhn Id)) [1..4]
+-- Error (Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])
+-- FailT "(Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])"
+--
+-- >>> pl @(Luhn Id) [1..4]
+-- False (Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])
+-- FalseT
+--
+-- >>> pz @(GuardSimple (Luhn Id)) [1,2,3,0]
+-- Present [1,2,3,0]
+-- PresentT [1,2,3,0]
+--
+-- >>> pz @(GuardSimple (Len > 30)) [1,2,3,0]
+-- Error (4 > 30)
+-- FailT "(4 > 30)"
+--
+data GuardSimple p
+
+instance (Show a
+        , P p a
+        , PP p a ~ Bool
+        ) => P (GuardSimple p) a where
+  type PP (GuardSimple p) a = a
+  eval _ opts a = do
+    let msg0 = "GuardSimple"
+    pp <- evalBool (Proxy @p) (if hasNoTree opts then o0 else opts) a -- to not lose the message in oLite mode we use non lite and then fix it up after
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right False ->
+        let msgx = topMessage pp
+        in mkNode opts (FailT msgx) [msg0 <> "(failed) " <> msgx <> show0 opts " | " a] [hh pp]
+      Right True ->
+        mkNode opts (PresentT a) [msg0 <> "(ok)" <> show0 opts " | " a] [hh pp]
+
+
+-- | just run the effect but skip the value
+-- for example for use with Stdout so it doesnt interfere with the \'a\' on the rhs unless there is an error
+data Skip p
+type p |> q = Skip p >> q
+infixr 1 |>
+type p >| q = p >> Skip q
+infixr 1 >|
+type p >|> q = Skip p >> Skip q
+infixr 1 >|>
+
+instance (Show (PP p a), P p a) => P (Skip p) a where
+  type PP (Skip p) a = a
+  eval _ opts a = do
+    let msg0 = "Skip"
+    pp <- eval (Proxy @p) opts a
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p -> mkNode opts (PresentT a) [msg0 <> show0 opts " " p] [hh pp]
+
+-- advantage of (>>) over 'Do [k] is we can use different kinds for (>>) without having to wrap with 'W'
+
+-- | This is composition for predicates
+--
+-- >>> pz @(Fst Id >> Succ (Id !! 0)) ([11,12],'x')
+-- Present 12
+-- PresentT 12
+--
+-- >>> pz @(Len *** Succ Id >> ShowP (First (Pred Id))) ([11,12],'x')
+-- Present "(1,'y')"
+-- PresentT "(1,'y')"
+--
+data p >> q
+infixr 1 >>
+
+type (<<) p q = q >> p
+infixr 1 <<
+
+type p >>> q = p >> q
+infixl 1 >>>
+
+instance (Show (PP p a)
+        , Show (PP q (PP p a))
+        , P p a
+        , P q (PP p a)
+        ) => P (p >> q) a where
+  type PP (p >> q) a = PP q (PP p a)
+  eval _ opts a = do
+    let msg0 = "(>>)"
+    pp <- eval (Proxy @p) opts a
+    case getValueLRHide opts ("(>>) lhs failed") pp [] of
+      Left e -> pure e
+      Right p -> do
+        qq <- eval (Proxy @q) opts p
+        pure $ case getValueLRHide opts (show p <> " (>>) rhs failed") qq [hh pp] of
+          Left e -> e
+          Right q -> mkNode opts (_tBool qq) [lit01 opts msg0 q (topMessage' qq)] [hh pp, hh qq]
+
+-- | similar to 'Prelude.&&'
+--
+-- >>> pz @(Fst Id && Snd Id) (True, True)
+-- True
+-- TrueT
+--
+-- >>> pz @(Id > 15 && Id < 17) 16
+-- True
+-- TrueT
+--
+-- >>> pz @(Id > 15 && Id < 17) 30
+-- False
+-- FalseT
+--
+-- >>> pz @(Fst Id && (Length (Snd Id) >= 4)) (True,[11,12,13,14])
+-- True
+-- TrueT
+--
+-- >>> pz @(Fst Id && (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
+-- False
+-- FalseT
+--
+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 = "&&"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let zz = case (p,q) of
+                  (True,True) -> ""
+                  (False,True) -> topMessage pp
+                  (True,False) -> 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]
+
+-- | similar to 'Prelude.||'
+--
+-- >>> pz @(Fst Id || (Length (Snd Id) >= 4)) (False,[11,12,13,14])
+-- True
+-- TrueT
+--
+-- >>> pz @(Not (Fst Id) || (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
+-- False
+-- 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 = "||"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let zz = case (p,q) of
+                  (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]
+
+-- | implication
+--
+-- >>> pz @(Fst Id ~> (Length (Snd Id) >= 4)) (True,[11,12,13,14])
+-- True
+-- TrueT
+--
+-- >>> pz @(Fst Id ~> (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
+-- False
+-- FalseT
+--
+-- >>> pz @(Fst Id ~> (Length (Snd Id) == 4)) (False,[12,11,12,13,14])
+-- True
+-- TrueT
+--
+-- >>> pz @(Fst Id ~> (Length (Snd Id) >= 4)) (False,[11,12,13,14])
+-- True
+-- TrueT
+--
+data p ~> q
+infixr 1 ~>
+
+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 = "~>"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let zz = case (p,q) of
+                  (True,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]
+
+
+-- | 'not' function
+--
+-- >>> pz @(Not Id) False
+-- True
+-- TrueT
+--
+-- >>> pz @(Not Id) True
+-- False
+-- FalseT
+--
+-- >>> pz @(Not (Fst Id)) (True,22)
+-- False
+-- FalseT
+--
+-- >>> pl @(Not (Lt 3)) 13
+-- True (Not (13 < 3))
+-- TrueT
+--
+data Not p
+instance (PP p x ~ Bool, P p x) => P (Not p) x where
+  type PP (Not p) x = Bool
+  eval _ opts x = do
+    let msg0 = "Not"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = not p
+        in mkNodeB opts b [msg0 <> " " <> topMessage pp] [hh pp]
+
+data OrdP p q
+type p ==! q = OrdP p q
+infix 4 ==!
+
+-- | similar to 'compare'
+--
+-- >>> pz @(Fst Id ==! Snd Id) (10,9)
+-- Present GT
+-- PresentT GT
+--
+-- >>> pz @(14 % 3 ==! Fst Id %- Snd Id) (-10,7)
+-- Present GT
+-- PresentT GT
+--
+-- >>> pz @(Fst Id ==! Snd Id) (10,11)
+-- Present LT
+-- PresentT LT
+--
+-- >>> pz @(Snd Id ==! (Fst Id >> Snd Id >> Head Id)) (('x',[10,12,13]),10)
+-- Present EQ
+-- PresentT EQ
+--
+-- >>> pz @(Snd Id ==! Head (Snd (Fst Id))) (('x',[10,12,13]),10)
+-- Present EQ
+-- PresentT EQ
+--
+type OrdA' p q = OrdP (Fst Id >> p) (Snd Id >> q)
+type OrdA p = OrdA' p p
+
+instance (Ord (PP p a)
+        , PP p a ~ PP q a
+        , P p a
+        , Show (PP q a)
+        , P q a
+        ) => P (OrdP p q) a where
+  type PP (OrdP p q) a = Ordering
+  eval _ opts a = do
+    let msg0 = "OrdP"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let d = compare p q
+        in mkNode opts (PresentT d) [msg0 <> " " <> show p <> " " <> prettyOrd d <> show0 opts " " q] [hh pp, hh qq]
+
+-- | compare two strings ignoring case
+--
+-- >>> pz @(Fst Id ===~ Snd Id) ("abC","aBc")
+-- Present EQ
+-- PresentT EQ
+--
+-- >>> pz @(Fst Id ===~ Snd Id) ("abC","DaBc")
+-- Present LT
+-- PresentT LT
+--
+data OrdI p q
+type p ===~ q = OrdI p q
+infix 4 ===~
+
+instance (PP p a ~ String
+        , PP p a ~ PP q a
+        , P p a
+        , P q a
+        ) => P (OrdI p q) a where
+  type PP (OrdI p q) a = Ordering
+  eval _ opts a = do
+    let msg0 = "OrdI"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let d = on compare (map toLower) p q
+        in mkNode opts (PresentT d) [msg0 <> " " <> p <> " " <> prettyOrd d <> " " <> q] [hh pp, hh qq]
+
+-- | compare two values using the given ordering \'o\'
+data Cmp (o :: OrderingP) p q
+
+instance (GetOrd o
+        , Ord (PP p a)
+        , Show (PP p a)
+        , PP p a ~ PP q a
+        , P p a
+        , P q a
+        ) => P (Cmp o p q) a where
+  type PP (Cmp o p q) a = Bool
+  eval _ opts a = do
+    let (sfn, fn) = getOrd @o
+    lr <- runPQ sfn (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let b = fn p q
+        in mkNodeB opts b [show p <> " " <> sfn <> show0 opts " " q] [hh pp, hh qq]
+
+-- | compare two strings ignoring case using the given ordering \'o\'
+data CmpI (o :: OrderingP) p q
+
+instance (PP p a ~ String
+        , GetOrd o
+        , PP p a ~ PP q a
+        , P p a
+        , P q a
+        ) => P (CmpI o p q) a where
+  type PP (CmpI o p q) a = Bool
+  eval _ opts a = do
+    let (sfn, fn) = getOrd @o
+    lr <- runPQ sfn (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let b = on fn (map toLower) p q
+        in mkNodeB opts b ["CmpI " <> p <> " " <> sfn <> " " <> q] [hh pp, hh qq]
+
+
+-- | similar to 'Control.Lens.itoList'
+--
+-- >>> pz @(IToList _) ("aBc" :: String)
+-- Present [(0,'a'),(1,'B'),(2,'c')]
+-- PresentT [(0,'a'),(1,'B'),(2,'c')]
+--
+data IToList' t p
+type IToList (t :: Type) = IToList' (Hole t) Id
+
+instance (Show x
+        , P p x
+        , Typeable (PP t (PP p x))
+        , Show (PP t (PP p x))
+        , FoldableWithIndex (PP t (PP p x)) f
+        , PP p x ~ f a
+        , Show a
+        ) => P (IToList' t p) x where
+  type PP (IToList' t p) x = [(PP t (PP p x), ExtractAFromTA (PP p x))]
+  eval _ opts x = do
+    let msg0 = "IToList"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = itoList p
+            t = showT @(PP t (PP p x))
+        in mkNode opts (PresentT b) [msg0 <> "(" <> t <> ")" <> show0 opts " " b <> show1 opts " | " x] [hh pp]
+
+-- | similar to 'toList'
+--
+-- >>> pz @ToList ("aBc" :: String)
+-- Present "aBc"
+-- PresentT "aBc"
+--
+-- >>> pz @ToList (Just 14)
+-- Present [14]
+-- PresentT [14]
+--
+-- >>> pz @ToList Nothing
+-- Present []
+-- PresentT []
+--
+-- >>> pz @ToList (Left "xx")
+-- Present []
+-- PresentT []
+--
+-- >>> pz @ToList (These 12 "xx")
+-- Present ["xx"]
+-- PresentT ["xx"]
+--
+data ToList
+instance (Show (t a)
+        , Foldable t
+        , Show a
+        ) => P ToList (t a) where
+  type PP ToList (t a) = [a]
+  eval _ opts as =
+    let msg0 = "ToList"
+        z = toList as
+    in pure $ mkNode opts (PresentT z) [show01 opts msg0 z as] []
+
+-- | similar to 'toList'
+--
+-- >>> pz @(ToList' Id) ("aBc" :: String)
+-- Present "aBc"
+-- PresentT "aBc"
+--
+-- >>> pz @(ToList' Id) (Just 14)
+-- Present [14]
+-- PresentT [14]
+--
+-- >>> pz @(ToList' Id) Nothing
+-- Present []
+-- PresentT []
+--
+-- >>> pz @(ToList' Id) (Left "xx")
+-- Present []
+-- PresentT []
+--
+-- >>> pz @(ToList' Id) (These 12 "xx")
+-- Present ["xx"]
+-- PresentT ["xx"]
+--
+data ToList' p
+
+instance (PP p x ~ t a
+        , P p x
+        , Show (t a)
+        , Foldable t
+        , Show a
+        ) => P (ToList' p) x where
+  type PP (ToList' p) x = [ExtractAFromTA (PP p x)] -- extra layer of indirection means pe (ToList' Id) "abc" won't work without setting the type of "abc" unlike ToList
+  eval _ opts x = do
+    let msg0 = "ToList'"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let hhs = [hh pp]
+            b = toList p
+        in mkNode opts (PresentT b) [show01 opts msg0 b p] hhs
+
+-- | invokes 'GE.toList'
+--
+-- >>> pz @ToListExt (M.fromList [(1,'x'),(4,'y')])
+-- Present [(1,'x'),(4,'y')]
+-- PresentT [(1,'x'),(4,'y')]
+--
+-- >>> pz @ToListExt (T.pack "abc")
+-- Present "abc"
+-- PresentT "abc"
+--
+data ToListExt
+
+instance (Show l
+        , GE.IsList l
+        , Show (GE.Item l)
+        ) => P ToListExt l where
+  type PP ToListExt l = [GE.Item l]
+  eval _ opts as =
+    let msg0 = "ToListExt"
+        z = GE.toList as
+    in pure $ mkNode opts (PresentT z) [show01 opts msg0 z as] []
+
+data FromList (t :: Type) -- doesnt work with OverloadedLists unless you cast to [a] explicitly
+
+instance (a ~ GE.Item t
+        , Show t
+        , GE.IsList t
+        ) => P (FromList t) [a] where
+  type PP (FromList t) [a] = t
+  eval _ opts as =
+    let msg0 = "FromList"
+        z = GE.fromList (as :: [GE.Item t]) :: t
+    in pure $ mkNode opts (PresentT z) [msg0 <> show0 opts " " z] []
+
+-- | invokes 'GE.fromList'
+--
+-- requires the OverloadedLists extension
+--
+-- >>> :set -XOverloadedLists
+-- >>> pz @(FromListExt (M.Map _ _)) [(4,"x"),(5,"dd")]
+-- Present fromList [(4,"x"),(5,"dd")]
+-- PresentT (fromList [(4,"x"),(5,"dd")])
+--
+data FromListExt (t :: Type)
+-- l ~ l' is key
+instance (Show l
+        , GE.IsList l
+        , l ~ l'
+        ) => P (FromListExt l') l where
+  type PP (FromListExt l') l = l'
+  eval _ opts as =
+    let msg0 = "FromListExt"
+        z = GE.fromList (GE.toList @l as)
+    in pure $ mkNode opts (PresentT z) [msg0 <> show0 opts " " z] []
+
+-- | predicate on 'These'
+--
+-- >>> pz @(IsThis Id) (This "aBc")
+-- True
+-- TrueT
+--
+-- >>> pz @(IsThis Id) (These 1 'a')
+-- False
+-- FalseT
+--
+-- >>> pz @(IsThese Id) (These 1 'a')
+-- True
+-- TrueT
+--
+data IsTh (th :: These x y) p -- x y can be anything
+
+type IsThis p = IsTh ('This '()) p
+type IsThat p = IsTh ('That '()) p
+type IsThese p = IsTh ('These '() '()) p
+
+-- trying to avoid show instance cos of ambiguities
+instance (PP p x ~ These a b
+        , P p x
+        , Show a
+        , Show b
+        , GetThese th
+        ) => P (IsTh (th :: These x1 x2) p) x where
+  type PP (IsTh th p) x = Bool
+  eval _ opts x = do
+    let msg0 = "IsTh"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let (t,f) = getThese (Proxy @th)
+            b = f p
+        in mkNodeB opts b [msg0 <> " " <> t <> show1 opts " | " p] []
+
+-- | similar to 'Data.These.these'
+--
+-- >>> pz @(TheseIn Id Len (Fst Id + Length (Snd Id))) (This 13)
+-- Present 13
+-- PresentT 13
+--
+-- >>> pz @(TheseIn Id Len (Fst Id + Length (Snd Id))) (That "this is a long string")
+-- Present 21
+-- PresentT 21
+--
+-- >>> pz @(TheseIn Id Len (Fst Id + Length (Snd Id))) (These 20 "somedata")
+-- Present 28
+-- PresentT 28
+--
+-- >>> pz @(TheseIn (MkLeftAlt _ Id) (MkRightAlt _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (That "this is a long string")
+-- Present Right "this is a long string"
+-- PresentT (Right "this is a long string")
+--
+-- >>> pz @(TheseIn (MkLeftAlt _ Id) (MkRightAlt _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (These 1 "this is a long string")
+-- Present Right "this is a long string"
+-- PresentT (Right "this is a long string")
+--
+-- >>> pz @(TheseIn (MkLeftAlt _ Id) (MkRightAlt _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (These 100 "this is a long string")
+-- Present Left 100
+-- PresentT (Left 100)
+--
+data TheseIn p q r
+type TheseId p q = TheseIn '(I, p) '(q, I) I
+
+instance (Show a
+        , Show b
+        , Show (PP p a)
+        , P p a
+        , P q b
+        , P r (a,b)
+        , PP p a ~ PP q b
+        , PP p a ~ PP r (a,b)
+        , PP q b ~ PP r (a,b)
+         )  => P (TheseIn p q r) (These a b) where
+  type PP (TheseIn p q r) (These a b) = PP p a
+  eval _ opts =
+     \case
+        This a -> do
+          let msg0 = "This"
+          pp <- eval (Proxy @p) opts a
+          pure $ case getValueLR opts (msg0 <> " p failed") pp [] of
+               Left e -> e
+               Right c -> mkNode opts (PresentT c) [show01' opts msg0 c "This " a] [hh pp]
+        That b -> do
+          let msg0 = "That"
+          qq <- eval (Proxy @q) opts b
+          pure $ case getValueLR opts (msg0 <> " q failed") qq [] of
+               Left e -> e
+               Right c -> mkNode opts (PresentT c) [show01' opts msg0 c "That " b] [hh qq]
+        These a b -> do
+          let msg0 = "TheseIn"
+          rr <- eval (Proxy @r) opts (a,b)
+          pure $ case getValueLR opts (msg0 <> " r failed") rr [] of
+               Left e -> e
+               Right c -> mkNode opts (PresentT c) [show01 opts msg0 c (These a b)] [hh rr]
+
+-- | creates an empty list of the given type
+--
+-- >>> pz @(Id :+ EmptyList _) 99
+-- Present [99]
+-- PresentT [99]
+--
+data EmptyList' t
+type EmptyList (t :: Type) = EmptyList' (Hole t)
+
+instance P (EmptyList' t) x where
+  type PP (EmptyList' t) x = [PP t x]
+  eval _ opts _ =
+    pure $ mkNode opts (PresentT []) ["EmptyList"] []
+
+-- | creates a singleton from a value
+--
+-- >>> pz @(Singleton (Char1 "aBc")) ()
+-- Present "a"
+-- PresentT "a"
+--
+-- >>> pz @(Singleton Id) False
+-- Present [False]
+-- PresentT [False]
+--
+-- >>> pz @(Singleton (Snd Id)) (False,"hello")
+-- Present ["hello"]
+-- PresentT ["hello"]
+--
+type Singleton p = p :+ EmptyT [] p
+
+-- | extracts the first character from a non empty 'Symbol'
+--
+-- >>> pz @(Char1 "aBc") ()
+-- Present 'a'
+-- PresentT 'a'
+--
+data Char1 (s :: Symbol)  -- gets the first char from the Symbol [requires that Symbol is not empty]
+instance (KnownSymbol s, NullT s ~ 'False) => P (Char1 s) a where
+  type PP (Char1 s) a = Char
+  eval _ opts _ =
+     let c = head $ symb @s
+     in pure $ mkNode opts (PresentT c) ["Char1" <> show0 opts " " c] []
+
+-- | similar to 'Data.Align.align' thats pads with 'Data.These.This' or 'Data.These.That' if one list is shorter than the other
+--
+-- the key is that all information about both lists are preserved
+--
+-- >>> pz @(ZipThese (Fst Id) (Snd Id)) ("aBc", [1..5])
+-- Present [These 'a' 1,These 'B' 2,These 'c' 3,That 4,That 5]
+-- PresentT [These 'a' 1,These 'B' 2,These 'c' 3,That 4,That 5]
+--
+-- >>> pz @(ZipThese (Fst Id) (Snd Id)) ("aBcDeF", [1..3])
+-- Present [These 'a' 1,These 'B' 2,These 'c' 3,This 'D',This 'e',This 'F']
+-- PresentT [These 'a' 1,These 'B' 2,These 'c' 3,This 'D',This 'e',This 'F']
+--
+-- >>> pz @(ZipThese Id Reverse) "aBcDeF"
+-- Present [These 'a' 'F',These 'B' 'e',These 'c' 'D',These 'D' 'c',These 'e' 'B',These 'F' 'a']
+-- PresentT [These 'a' 'F',These 'B' 'e',These 'c' 'D',These 'D' 'c',These 'e' 'B',These 'F' 'a']
+--
+-- >>> pz @(ZipThese Id '[]) "aBcDeF"
+-- Present [This 'a',This 'B',This 'c',This 'D',This 'e',This 'F']
+-- PresentT [This 'a',This 'B',This 'c',This 'D',This 'e',This 'F']
+--
+-- >>> pz @(ZipThese '[] Id) "aBcDeF"
+-- Present [That 'a',That 'B',That 'c',That 'D',That 'e',That 'F']
+-- PresentT [That 'a',That 'B',That 'c',That 'D',That 'e',That 'F']
+--
+data ZipThese p q
+
+instance (PP p a ~ [x]
+        , PP q a ~ [y]
+        , P p a
+        , P q a
+        , Show x
+        , Show y
+        ) => P (ZipThese p q) a where
+  type PP (ZipThese p q) a = [These (ExtractAFromList (PP p a)) (ExtractAFromList (PP q a))]
+  eval _ opts a = do
+    let msg0 = "ZipThese"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let d = simpleAlign p q
+        in mkNode opts (PresentT d) [show01' opts msg0 d "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
+
+simpleAlign :: [a] -> [b] -> [These a b]
+simpleAlign as [] = map This as
+simpleAlign [] bs = map That bs
+simpleAlign (a:as) (b:bs) = These a b : simpleAlign as bs
+
+type family ExtractAFromTA (ta :: Type) :: Type where
+  ExtractAFromTA (t a) = a
+  ExtractAFromTA z = GL.TypeError (
+      'GL.Text "ExtractAFromTA: expected (t a) but found something else"
+      ':$$: 'GL.Text "t a = "
+      ':<>: 'GL.ShowType z)
+
+-- todo: get ExtractAFromList error to fire if wrong Type
+-- | extract \'a\' from \'[a]\' which I need for type PP
+type family ExtractAFromList (as :: Type) :: Type where
+  ExtractAFromList [a] = a
+  ExtractAFromList z = GL.TypeError (
+      'GL.Text "ExtractAFromList: expected [a] but found something else"
+      ':$$: 'GL.Text "as = "
+      ':<>: 'GL.ShowType z)
+
+
+-- | Zip two lists to their maximum length using padding if needed
+--
+-- >>> pz @(ZipPad (Char1 "Z") 99 (Fst Id) (Snd Id)) ("abc", [1..5])
+-- Present [('a',1),('b',2),('c',3),('Z',4),('Z',5)]
+-- PresentT [('a',1),('b',2),('c',3),('Z',4),('Z',5)]
+--
+-- >>> pz @(ZipPad (Char1 "Z") 99 (Fst Id) (Snd Id)) ("abcdefg", [1..5])
+-- Present [('a',1),('b',2),('c',3),('d',4),('e',5),('f',99),('g',99)]
+-- PresentT [('a',1),('b',2),('c',3),('d',4),('e',5),('f',99),('g',99)]
+--
+-- >>> pz @(ZipPad (Char1 "Z") 99 (Fst Id) (Snd Id)) ("abcde", [1..5])
+-- Present [('a',1),('b',2),('c',3),('d',4),('e',5)]
+-- PresentT [('a',1),('b',2),('c',3),('d',4),('e',5)]
+--
+-- >>> pz @(ZipPad (Char1 "Z") 99 (Fst Id) (Snd Id)) ("", [1..5])
+-- Present [('Z',1),('Z',2),('Z',3),('Z',4),('Z',5)]
+-- PresentT [('Z',1),('Z',2),('Z',3),('Z',4),('Z',5)]
+--
+-- >>> pz @(ZipPad (Char1 "Z") 99 (Fst Id) (Snd Id)) ("abcde", [])
+-- Present [('a',99),('b',99),('c',99),('d',99),('e',99)]
+-- PresentT [('a',99),('b',99),('c',99),('d',99),('e',99)]
+--
+data ZipPad l r p q
+
+instance (PP l a ~ x
+        , PP r a ~ y
+        , P l a
+        , P r a
+        , PP p a ~ [x]
+        , PP q a ~ [y]
+        , P p a
+        , P q a
+        , Show x
+        , Show y
+        ) => P (ZipPad l r p q) a where
+  type PP (ZipPad l r p q) a = [(PP l a, PP r a)]
+  eval _ opts a = do
+    let msg0 = "ZipPad"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    case lr of
+      Left e -> pure e
+      Right (p,q,pp,qq) -> do
+        let hhs = [hh pp, hh qq]
+        case chkSize opts msg0 p hhs <* chkSize opts msg0 q hhs of
+          Left e -> pure e
+          Right () -> do
+            let lls = (length p,length q)
+            case uncurry compare lls of
+              LT -> do
+                ll <- eval (Proxy @l) opts a
+                pure $ case getValueLR opts (msg0 <> " l failed") ll hhs of
+                  Left e -> e
+                  Right l ->
+                    let d = zip (p ++ repeat l) q
+                    in mkNode opts (PresentT d) [show01' opts (msg0 <> " Left pad") d "p=" p <> show1 opts " | q=" q] (hhs ++ [hh ll])
+              GT -> do
+                rr <- eval (Proxy @r) opts a
+                pure $ case getValueLR opts (msg0 <> " r failed") rr hhs of
+                  Left e -> e
+                  Right r ->
+                    let d =zip p (q ++ repeat r)
+                    in mkNode opts (PresentT d) [show01' opts (msg0 <> " Right pad") d "p=" p <> show1 opts " | q=" q] (hhs ++ [hh rr])
+              EQ ->
+                let d = zip p q
+                in pure $ mkNode opts (PresentT d) [show01' opts (msg0 <> " No pad") d "p=" p <> show1 opts " | q=" q] hhs
+
+
+-- | zip two lists padding the left hand side if needed
+--
+-- >>> pl @(ZipL 99 '[1,2,3] "abc") ()
+-- Present [(1,'a'),(2,'b'),(3,'c')] (ZipL [(1,'a'),(2,'b'),(3,'c')] | p=[1,2,3] | q="abc")
+-- PresentT [(1,'a'),(2,'b'),(3,'c')]
+--
+-- >>> pl @(ZipL 99 '[1,2] "abc") ()
+-- Present [(1,'a'),(2,'b'),(99,'c')] (ZipL [(1,'a'),(2,'b'),(99,'c')] | p=[1,2] | q="abc")
+-- PresentT [(1,'a'),(2,'b'),(99,'c')]
+--
+-- >>> pl @(ZipL 99 '[1] "abc") ()
+-- Present [(1,'a'),(99,'b'),(99,'c')] (ZipL [(1,'a'),(99,'b'),(99,'c')] | p=[1] | q="abc")
+-- PresentT [(1,'a'),(99,'b'),(99,'c')]
+--
+-- >>> pl @(ZipL 99 '[1,2,3] "ab") ()
+-- Error ZipL(3,2) rhs would be truncated
+-- FailT "ZipL(3,2) rhs would be truncated"
+--
+data ZipL l p q
+instance (PP l a ~ x
+        , P l a
+        , PP p a ~ [x]
+        , PP q a ~ [y]
+        , P p a
+        , P q a
+        , Show x
+        , Show y
+        ) => P (ZipL l p q) a where
+  type PP (ZipL l p q) a = [(ExtractAFromList (PP p a), ExtractAFromList (PP q a))]
+  eval _ opts a = do
+    let msg0 = "ZipL"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    case lr of
+      Left e -> pure e
+      Right (p,q,pp,qq) -> do
+        let hhs = [hh pp, hh qq]
+        case chkSize opts msg0 p hhs <* chkSize opts msg0 q hhs of
+          Left e -> pure e
+          Right () -> do
+            let lls = (length p,length q)
+            case uncurry compare lls of
+              GT -> let msg1 = msg0 ++ show lls
+                    in pure $ mkNode opts (FailT (msg1 ++ " rhs would be truncated")) [msg1 <> "rhs would be truncated " <> show1 opts " | p=" p <> show1 opts " | q=" q] hhs
+              _ -> do
+                     ll <- eval (Proxy @l) opts a
+                     pure $ case getValueLR opts (msg0 <> " l failed") ll hhs of
+                             Left e -> e
+                             Right l ->
+                               let d = zip (p ++ repeat l) q
+                               in mkNode opts (PresentT d) [show01' opts msg0 d "p=" p <> show1 opts " | q=" q] (hhs ++ [hh ll])
+
+-- | zip two lists padding the right hand side if needed
+--
+-- >>> pl @(ZipR (Char1 "Z") '[1,2,3] "abc") ()
+-- Present [(1,'a'),(2,'b'),(3,'c')] (ZipR [(1,'a'),(2,'b'),(3,'c')] | p=[1,2,3] | q="abc")
+-- PresentT [(1,'a'),(2,'b'),(3,'c')]
+--
+-- >>> pl @(ZipR (Char1 "Z") '[1,2,3] "ab") ()
+-- Present [(1,'a'),(2,'b'),(3,'Z')] (ZipR [(1,'a'),(2,'b'),(3,'Z')] | p=[1,2,3] | q="ab")
+-- PresentT [(1,'a'),(2,'b'),(3,'Z')]
+--
+-- >>> pl @(ZipR (Char1 "Z") '[1,2,3] "a") ()
+-- Present [(1,'a'),(2,'Z'),(3,'Z')] (ZipR [(1,'a'),(2,'Z'),(3,'Z')] | p=[1,2,3] | q="a")
+-- PresentT [(1,'a'),(2,'Z'),(3,'Z')]
+--
+-- >>> pl @(ZipR (Char1 "Z") '[1,2] "abc") ()
+-- Error ZipR(2,3) rhs would be truncated
+-- FailT "ZipR(2,3) rhs would be truncated"
+--
+data ZipR r p q
+instance (PP r a ~ y
+        , P r a
+        , PP p a ~ [x]
+        , PP q a ~ [y]
+        , P p a
+        , P q a
+        , Show x
+        , Show y
+        ) => P (ZipR r p q) a where
+  type PP (ZipR r p q) a = [(ExtractAFromList (PP p a), ExtractAFromList (PP q a))]
+  eval _ opts a = do
+    let msg0 = "ZipR"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    case lr of
+      Left e -> pure e
+      Right (p,q,pp,qq) -> do
+        let hhs = [hh pp, hh qq]
+        case chkSize opts msg0 p hhs <* chkSize opts msg0 q hhs of
+          Left e -> pure e
+          Right () -> do
+            let lls = (length p,length q)
+            case uncurry compare lls of
+              LT -> let msg1 = msg0 ++ show lls
+                    in pure $ mkNode opts (FailT (msg1 ++ " rhs would be truncated")) [msg1 <> "rhs would be truncated " <> show1 opts " | p=" p <> show1 opts " | q=" q] hhs
+              _ -> do
+                     rr <- eval (Proxy @r) opts a
+                     pure $ case getValueLR opts (msg0 <> " l failed") rr hhs of
+                             Left e -> e
+                             Right r ->
+                               let d = zip p (q ++ repeat r)
+                               in mkNode opts (PresentT d) [show01' opts msg0 d "p=" p <> show1 opts " | q=" q] (hhs ++ [hh rr])
+
+-- | zip two lists with the same length
+--
+-- >>> pl @(Zip '[1,2,3] "abc") ()
+-- Present [(1,'a'),(2,'b'),(3,'c')] (Zip [(1,'a'),(2,'b'),(3,'c')] | p=[1,2,3] | q="abc")
+-- PresentT [(1,'a'),(2,'b'),(3,'c')]
+--
+-- >>> pl @(Zip '[1,2,3] "ab") ()
+-- Error Zip(3,2) length mismatch
+-- FailT "Zip(3,2) length mismatch"
+--
+-- >>> pl @(Zip '[1,2] "abc") ()
+-- Error Zip(2,3) length mismatch
+-- FailT "Zip(2,3) length mismatch"
+--
+data Zip p q
+instance (PP p a ~ [x]
+        , PP q a ~ [y]
+        , P p a
+        , P q a
+        , Show x
+        , Show y
+        ) => P (Zip p q) a where
+  type PP (Zip p q) a = [(ExtractAFromList (PP p a), ExtractAFromList (PP q a))]
+  eval _ opts a = do
+    let msg0 = "Zip"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let hhs = [hh pp, hh qq]
+        in case chkSize opts msg0 p hhs <* chkSize opts msg0 q hhs of
+          Left e -> e
+          Right () ->
+            let lls = (length p, length q)
+            in case uncurry compare lls of
+                 EQ -> let d = zip p q
+                       in mkNode opts (PresentT d) [show01' opts msg0 d "p=" p <> show1 opts " | q=" q] hhs
+                 _ -> let msg1 = msg0 ++ show lls
+                      in mkNode opts (FailT (msg1 <> " length mismatch")) [msg1 <> " length mismatch" ++ show1 opts " | p=" p <> show1 opts " | q=" q] hhs
+
+-- | Luhn predicate check on last digit
+--
+-- >>> pz @(Luhn Id) [1,2,3,0]
+-- True
+-- TrueT
+--
+-- >>> pz @(Luhn Id) [1,2,3,4]
+-- False
+-- FalseT
+--
+-- >>> pz @(GuardSimple (Luhn Id)) [15,4,3,1,99]
+-- Error (Luhn map=[90,2,3,8,6] sum=109 ret=9 | [15,4,3,1,99])
+-- FailT "(Luhn map=[90,2,3,8,6] sum=109 ret=9 | [15,4,3,1,99])"
+--
+-- >>> pl @(Luhn Id) [15,4,3,1,99]
+-- False (Luhn map=[90,2,3,8,6] sum=109 ret=9 | [15,4,3,1,99])
+-- FalseT
+--
+data Luhn p
+
+instance (PP p x ~ [Int]
+        , P p x
+        ) => P (Luhn p) x where
+  type PP (Luhn p) x = Bool
+  eval _ opts x = do
+    let msg0 = "Luhn"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let xs = zipWith (*) (reverse p) (cycle [1,2])
+            ys = map (\w -> if w>=10 then w-9 else w) xs
+            z = sum ys
+            ret = z `mod` 10
+            hhs = [hh pp]
+        in if ret == 0 then mkNodeB opts True [msg0 <> show0 opts " | " p] hhs
+           else mkNodeB opts False [msg0 <> " map=" <> show ys <> " sum=" <> show z <> " ret=" <> show ret <> show1 opts " | " p] hhs
+
+-- | Read a number using base 2 through a maximum of 36
+--
+-- >>> pz @(ReadBase Int 16 Id) "00feD"
+-- Present 4077
+-- PresentT 4077
+--
+-- >>> pz @(ReadBase Int 16 Id) "-ff"
+-- Present -255
+-- PresentT (-255)
+--
+-- >>> pz @(ReadBase Int 2 Id) "10010011"
+-- Present 147
+-- PresentT 147
+--
+-- >>> pz @(ReadBase Int 8 Id) "Abff"
+-- Error invalid base 8
+-- FailT "invalid base 8"
+--
+-- supports negative numbers unlike readInt
+data ReadBase' t (n :: Nat) p
+type ReadBase (t :: Type) (n :: Nat) p = ReadBase' (Hole t) n p
+type ReadBaseInt (n :: Nat) p = ReadBase' (Hole Int) n p
+
+instance (Typeable (PP t x)
+        , BetweenT 2 36 n
+        , Show (PP t x)
+        , Num (PP t x)
+        , KnownNat n
+        , PP p x ~ String
+        , P p x
+        ) => 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
+        msg0 = "ReadBase(" <> t <> "," <> show n <> ")"
+        t = showT @(PP t x)
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let (ff,p1) = case p of
+                        '-':q -> (negate,q)
+                        _ -> (id,p)
+        in case readInt (fromIntegral n)
+            ((`elem` xs) . toLower)
+            (fromJust . (`elemIndex` xs) . toLower)
+            p1 of
+             [(b,"")] -> mkNode opts (PresentT (ff b)) [msg0 <> show0 opts " " (ff b) <> show1 opts " | " p] [hh pp]
+             o -> mkNode opts (FailT ("invalid base " <> show n)) [msg0 <> " as=" <> p <> " err=" <> show o] [hh pp]
+
+getValidBase :: Int -> String
+getValidBase n =
+  let xs = ['0'..'9'] <> ['a'..'z']
+      len = length xs
+  in if n > len || n < 2 then error $ "oops invalid base valid is 2 thru " ++ show len ++ " found " ++ show n
+     else take n xs
+
+-- | Display a number at base 2 to 36, similar to 'showIntAtBase' but supports signed numbers
+--
+-- >>> pz @(ShowBase 16 Id) 4077
+-- Present "fed"
+-- PresentT "fed"
+--
+-- >>> pz @(ShowBase 16 Id) (-255)
+-- Present "-ff"
+-- PresentT "-ff"
+--
+-- >>> pz @(ShowBase 2 Id) 147
+-- Present "10010011"
+-- PresentT "10010011"
+--
+-- >>> pz @(ShowBase 2 (Negate 147)) "whatever"
+-- Present "-10010011"
+-- PresentT "-10010011"
+--
+data ShowBase (n :: Nat) p
+
+instance (PP p x ~ a
+        , P p x
+        , Show a
+        , 2 GL.<= n
+        , n GL.<= 36
+        , KnownNat n
+        , Integral a
+        ) => P (ShowBase n p) x where
+  type PP (ShowBase n p) x = String
+  eval _ opts x = do
+    let n = nat @n
+        xs = getValidBase n
+        msg0 = "ShowBase " <> show n
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let (ff,a') = if p < 0 then (('-':), abs p) else (id,p)
+            b = showIntAtBase (fromIntegral n) (xs !!) a' ""
+        in mkNode opts (PresentT (ff b)) [msg0 <> showLit0 opts " " (ff b) <> show1 opts " | " p] []
+
+-- | intercalate two lists
+--
+-- >>> pz @(Intercalate '["aB"] '["xxxx","yz","z","www","xyz"]) ()
+-- Present ["xxxx","aB","yz","aB","z","aB","www","aB","xyz"]
+-- PresentT ["xxxx","aB","yz","aB","z","aB","www","aB","xyz"]
+--
+-- >>> pz @(Intercalate '[W 99,Negate 98] Id) [1..5]
+-- Present [1,99,-98,2,99,-98,3,99,-98,4,99,-98,5]
+-- PresentT [1,99,-98,2,99,-98,3,99,-98,4,99,-98,5]
+--
+-- >>> pz @(Intercalate '[99,100] Id) [1..5]
+-- Present [1,99,100,2,99,100,3,99,100,4,99,100,5]
+--PresentT [1,99,100,2,99,100,3,99,100,4,99,100,5]
+--
+data Intercalate p q
+
+instance (PP p x ~ [a]
+        , PP q x ~ PP p x
+        , P p x
+        , P q x
+        , Show a
+      ) => P (Intercalate p q) x where
+  type PP (Intercalate p q) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Intercalate"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let d = intercalate p (map (:[]) q)
+        in mkNode opts (PresentT d) [show01 opts msg0 d p <> show1 opts " | " q] [hh pp, hh qq]
+
+-- | uses PrintF to format output
+--
+-- >>> pz @(PrintF "value=%03d" Id) 12
+-- Present "value=012"
+-- PresentT "value=012"
+--
+-- >>> pz @(PrintF "%s" (Fst Id)) ("abc",'x')
+-- Present "abc"
+-- PresentT "abc"
+--
+-- >>> pz @(PrintF "%d" (Fst Id)) ("abc",'x')
+-- Error PrintF (IO e=printf: bad formatting char 'd')
+-- FailT "PrintF (IO e=printf: bad formatting char 'd')"
+--
+data PrintF s p
+
+instance (PrintfArg (PP p x)
+        , Show (PP p x)
+        , PP s x ~ String
+        , P s x
+        , P p x
+        ) => P (PrintF s p) x where
+  type PP (PrintF s p) x = String
+  eval _ opts x = do
+    let msg0 = "PrintF"
+    lrx <- runPQ msg0 (Proxy @s) (Proxy @p) opts x []
+    case lrx of
+      Left e -> pure e
+      Right (s,p,ss,pp) -> do
+        let msg1 = msg0
+        lr <- catchitNF @_ @E.SomeException (printf s p)
+        pure $ case lr of
+          Left e -> mkNode opts (FailT (msg1 <> " (" <> e <> ")")) [msg1 <> show0 opts " " p <> " s=" <> s] [hh ss, hh pp]
+          Right ret -> mkNode opts (PresentT ret) [msg1 <> " [" <> showLit0 opts "" ret <> "]" <> show1 opts " | p=" p <> showLit1 opts " | s=" s] [hh ss, hh pp]
+
+type family GuardsT (ps :: [k]) where
+  GuardsT '[] = '[]
+  GuardsT (p ': ps) = Guard "fromGuardsT" p ': GuardsT ps
+
+--type Guards' (ps :: [k]) = Para (GuardsT ps)
+
+--type ToGuards (prt :: k) (os :: [k1]) = Proxy (Guards (ToGuardsT prt os))
+
+type family ToGuardsT (prt :: k) (os :: [k1]) :: [(k,k1)] where
+  ToGuardsT prt '[] = GL.TypeError ('GL.Text "ToGuardsT cannot be empty")
+  ToGuardsT prt '[p] = '(prt,p) : '[]
+  ToGuardsT prt (p ': ps) = '(prt,p) ': ToGuardsT prt ps
+
+-- | runs values in parallel unlike 'Do' which is serial
+--
+-- >>> pz @(Para '[Id,Id + 1,Id * 4]) [10,20,30]
+-- Present [10,21,120]
+-- PresentT [10,21,120]
+--
+-- >>> pz @(Para '[Id,Id + 1,Id * 4]) [10,20,30,40]
+-- Error Para: data elements(4) /= predicates(3)
+-- FailT "Para: data elements(4) /= predicates(3)"
+--
+data ParaImpl (n :: Nat) (os :: [k])
+
+data Para (ps :: [k])
+
+-- passthru but adds the length of ps (replaces LenT in the type synonym to avoid type synonyms being expanded out
+instance (GetLen ps, P (ParaImpl (LenT ps) ps) [a]) => P (Para ps) [a] where
+  type PP (Para ps) [a] = PP (ParaImpl (LenT ps) ps) [a]
+  eval _ opts as = do
+    let msgbase0 = "Para"
+        n = getLen @ps
+    if n /= length as then
+       let xx = msgbase0 <> ": data elements(" <> show (length as) <> ") /= predicates(" <> show n <> ")"
+       in pure $ mkNode opts (FailT xx) [xx] []
+    else eval (Proxy @(ParaImpl (LenT ps) ps)) opts as
+
+-- only allow non empty lists
+instance GL.TypeError ('GL.Text "ParaImpl '[] invalid: requires at least one value in the list")
+   => P (ParaImpl n ('[] :: [k])) [a] where
+  type PP (ParaImpl n ('[] :: [k])) [a] = Void
+  eval _ _ _ = error "should not be called and yet..."
+
+instance (Show (PP p a)
+        , KnownNat n
+        , Show a
+        , P p a
+        ) => P (ParaImpl n '[p]) [a] where
+  type PP (ParaImpl n '[p]) [a] = [PP p a]
+  eval _ opts as' = do
+    let msgbase0 = "Para"
+        msgbase1 = msgbase0 <> "(" <> show n <> ")"
+        n :: Int
+        n = nat @n
+    case as' of
+      [a] -> do
+        pp <- eval (Proxy @p) opts a
+        pure $ case getValueLR opts msgbase1 pp [] of
+          Left e -> e
+          -- show1 opts " " [b]  fails but using 'b' is ok and (b : []) also works!
+          -- GE.List error
+          Right b -> mkNode opts (PresentT [b]) [msgbase1 <> show0 opts " " (b : []) <> show1 opts " | " a] [hh pp]
+      _ -> error $ "programmer error: ParaImpl base case should have exactly one element but found " ++ show as'
+
+instance (KnownNat n
+        , GetLen ps
+        , P p a
+        , P (ParaImpl n (p1 ': ps)) [a]
+        , PP (ParaImpl n (p1 ': ps)) [a] ~ [PP p a]
+        , Show a
+        , Show (PP p a)
+        )
+     => P (ParaImpl n (p ': p1 ': ps)) [a] where
+  type PP (ParaImpl n (p ': p1 ': ps)) [a] = [PP p a]
+  eval _ opts as' = do
+     let cpos = n-pos-1
+         msgbase0 = msgbase2 <> "(" <> showIndex cpos <> " of " <> show n <> ")"
+         msgbase1 = msgbase2 <> "(" <> showIndex cpos <> ")"
+         msgbase2 = "Para"
+         n = nat @n
+         pos = 1 + getLen @ps -- cos p1!
+     case as' of
+       a:as -> do
+         pp <- eval (Proxy @p) opts a
+         case getValueLR opts msgbase0 pp [] of
+           Left e -> pure e
+           Right b -> do
+                        qq <- eval (Proxy @(ParaImpl n (p1 ': ps))) opts as
+                        pure $ case getValueLRHide opts (msgbase1 <> " rhs failed " <> show b) qq [hh pp] of
+                          Left e -> e
+                          Right bs -> mkNode opts (PresentT (b:bs)) [msgbase1 <> show0 opts " " (b:bs) <> show1 opts " | " as'] [hh pp, hh qq]
+       _ -> error $ "programmer error: ParaImpl n+1 case has no data left"
+
+-- | leverages 'Para' for repeating predicates (passthrough method)
+--
+-- >>> pz @(ParaN 4 (Succ Id)) [1..4]
+-- Present [2,3,4,5]
+-- PresentT [2,3,4,5]
+--
+-- >>> pz @(ParaN 4 (Succ Id)) "azwxm"
+-- Error Para: data elements(5) /= predicates(4)
+-- FailT "Para: data elements(5) /= predicates(4)"
+--
+-- >>> pz @(ParaN 4 (Succ Id)) "azwx"
+-- Present "b{xy"
+-- PresentT "b{xy"
+--
+data ParaN (n :: Nat) p
+
+instance ( P (ParaImpl (LenT (RepeatT n p)) (RepeatT n p)) [a]
+         , GetLen (RepeatT n p)
+         ) => P (ParaN n p) [a] where
+  type PP (ParaN n p) [a] = PP (Para (RepeatT n p)) [a]
+  eval _ opts as =
+    eval (Proxy @(Para (RepeatT n p))) opts as
+
+-- | tries each predicate ps and on the first match runs the corresponding qs but if there is no match on ps then runs the fail case e
+--
+-- >>> 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) 50
+-- Present "50 is same50"
+-- PresentT "50 is same50"
+--
+-- >>> 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) 9
+-- Present "9 is lt10"
+-- PresentT "9 is lt10"
+--
+-- >>> 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) 3
+-- Present "3 is lt4"
+-- PresentT "3 is lt4"
+--
+-- >>> 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
+-- Error asdf
+-- FailT "asdf"
+--
+data CaseImpl (n :: Nat) (e :: k0) (ps :: [k]) (qs :: [k1]) (r :: k2)
+-- ps = conditions
+-- qs = what to do [one to one
+-- r = the value
+-- e = otherwise  -- leave til later
+data Case (e :: k0) (ps :: [k]) (qs :: [k1]) (r :: k2)
+type Case' (ps :: [k]) (qs :: [k1]) (r :: k2) = Case (Snd Id >> Failp "Case:no match") ps qs r
+type Case'' s (ps :: [k]) (qs :: [k1]) (r :: k2) = Case (FailCase s) ps qs r -- eg s= PrintF "%s" (ShowP Id)
+
+type FailCase p = Fail (Snd Id >> Unproxy) (Fst Id >> p)
+
+-- passthru but adds the length of ps (replaces LenT in the type synonym to avoid type synonyms being expanded out
+instance (FailUnlessT (LenT ps DE.== LenT qs)
+                  ('GL.Text "lengths are not the same "
+                   ':<>: 'GL.ShowType (LenT ps)
+                   ':<>: 'GL.Text " vs "
+                   ':<>: 'GL.ShowType (LenT qs))
+        , P (CaseImpl (LenT ps) e ps qs r) x
+        ) => P (Case e ps qs r) x where
+  type PP (Case e ps qs r) x = PP (CaseImpl (LenT ps) e ps qs r) x
+  eval _ = eval (Proxy @(CaseImpl (LenT ps) e ps qs r))
+
+-- only allow non empty lists!
+instance (GL.TypeError ('GL.Text "CaseImpl '[] invalid: lhs requires at least one value in the list"))
+   => P (CaseImpl n e ('[] :: [k]) (q ': qs) r) x where
+  type PP (CaseImpl n e ('[] :: [k]) (q ': qs) r) x = Void
+  eval _ _ _ = error "should not be called and yet..."
+
+instance (GL.TypeError ('GL.Text "CaseImpl '[] invalid: rhs requires at least one value in the list"))
+   => P (CaseImpl n e (p ': ps) ('[] :: [k1]) r) x where
+  type PP (CaseImpl n e (p ': ps) ('[] :: [k1]) r) x = Void
+  eval _ _ _ = error "should not be called and yet..."
+
+instance (GL.TypeError ('GL.Text "CaseImpl '[] invalid: lists are both empty"))
+   => P (CaseImpl n e ('[] :: [k]) ('[] :: [k1]) r) x where
+  type PP (CaseImpl n e ('[] :: [k]) ('[] :: [k1]) r) x = Void
+  eval _ _ _ = error "should not be called and yet..."
+
+instance (P r x
+        , P q (PP r x)
+        , Show (PP q (PP r x))
+        , P p (PP r x)
+        , PP p (PP r x) ~ Bool
+        , KnownNat n
+        , Show (PP r x)
+        , P e (PP r x, Proxy (PP q (PP r x)))
+        , PP e (PP r x, Proxy (PP q (PP r x))) ~ PP q (PP r x)
+        ) => P (CaseImpl n e '[p] '[q] r) x where
+  type PP (CaseImpl n e '[p] '[q] r) x = PP q (PP r x)
+  eval _ opts z = do
+    let msgbase0 = "Case" <> "(" <> show n <> ")"
+        n :: Int = nat @n
+    rr <- eval (Proxy @r) opts z
+    case getValueLR opts msgbase0 rr [] of
+      Left e -> pure e
+      Right a -> do
+        pp <- evalBool (Proxy @p) opts a
+        case getValueLR opts msgbase0 pp [hh rr] of
+          Left e -> pure e
+          Right True -> do
+            qq <- eval (Proxy @q) opts a
+            pure $ case getValueLR opts msgbase0 qq [hh rr, hh pp] of
+              Left e -> e
+              Right b -> mkNode opts (PresentT b) [show01 opts msgbase0 b a] (hh rr : hh pp : if isVerbose opts then [hh qq] else [])
+          Right False -> do
+            ee <- eval (Proxy @e) opts (a, Proxy @(PP q (PP r x)))
+            pure $ case getValueLR opts (msgbase0 <> "  otherwise failed") ee [hh rr, hh pp] of
+              Left e -> e
+              Right b -> mkNode opts (PresentT b) [show01 opts msgbase0 b a] [hh rr, hh pp, hh ee]
+
+instance (KnownNat n
+        , GetLen ps
+        , P r x
+        , P p (PP r x)
+        , P q (PP r x)
+        , PP p (PP r x) ~ Bool
+        , Show (PP q (PP r x))
+        , Show (PP r x)
+        , P (CaseImpl n e (p1 ': ps) (q1 ': qs) r) x
+        , PP (CaseImpl n e (p1 ': ps) (q1 ': qs) r) x ~ PP q (PP r x)
+        )
+     => P (CaseImpl n e (p ': p1 ': ps) (q ': q1 ': qs) r) x where
+  type PP (CaseImpl n e (p ': p1 ': ps) (q ': q1 ': qs) r) x = PP q (PP r x)
+  eval _ opts z = do
+    let cpos = n-pos-1
+        msgbase0 = msgbase2 <> "(" <> showIndex cpos <> " of " <> show n <> ")"
+        msgbase1 = msgbase2 <> "(" <> showIndex cpos <> ")"
+        msgbase2 = "Case"
+        n = nat @n
+        pos = 1 + getLen @ps -- cos p1!
+    rr <- eval (Proxy @r) opts z
+    case getValueLR opts msgbase0 rr [] of
+      Left e -> pure e
+      Right a -> do
+        pp <- evalBool (Proxy @p) opts a
+        case getValueLR opts msgbase0 pp [hh rr] of
+          Left e -> pure e
+          Right True -> do
+            qq <- eval (Proxy @q) opts a
+            pure $ case getValueLR opts msgbase0 qq [hh pp, hh rr] of
+              Left e -> e
+              Right b -> mkNode opts (PresentT b) [show01 opts msgbase0 b a] (hh rr : hh pp : if isVerbose opts then [hh qq] else [])
+          Right False -> do
+            ww <- eval (Proxy @(CaseImpl n e (p1 ': ps) (q1 ': qs) r)) opts z
+            pure $ case getValueLR opts (msgbase1 <> " failed rhs") ww [hh rr, hh pp] of
+              Left e -> e
+              Right b -> mkNode opts (PresentT b) [show01 opts msgbase1 b a] [hh rr, hh pp, hh ww]
+
+-- | similar to 'sequenceA'
+--
+-- >>> pz @Sequence [Just 10, Just 20, Just 30]
+-- Present Just [10,20,30]
+-- PresentT (Just [10,20,30])
+--
+-- >>> pz @Sequence [Just 10, Just 20, Just 30, Nothing, Just 40]
+-- Present Nothing
+-- PresentT Nothing
+--
+data Sequence
+type Traverse p q = Map p q >> Sequence
+
+instance (Show (f (t a))
+        , Show (t (f a))
+        , Traversable t
+        , Applicative f
+        ) => P Sequence (t (f a)) where
+  type PP Sequence (t (f a)) = f (t a)
+  eval _ opts tfa =
+     let d = sequenceA tfa
+     in pure $ mkNode opts (PresentT d) ["Sequence" <> show0 opts " " d <> show1 opts " | " tfa] []
+
+-- | run the expression \'p\' but remove the subtrees
+data Hide p
+-- 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
+  eval _ opts x = do
+      tt <- eval (Proxy @(Msg "!" p)) opts x
+      pure $ tt & tForest .~ []
+
+-- | similar to 'readFile'
+--
+-- >>> pz @(ReadFile ".ghci" >> 'Just Id >> Len > 0) ()
+-- True
+-- TrueT
+--
+-- >>> pz @(FileExists "xyzzy") ()
+-- False
+-- FalseT
+--
+data ReadFile p
+type FileExists p = ReadFile p >> IsJust
+
+instance (PP p x ~ String, P p x) => P (ReadFile p) x where
+  type PP (ReadFile p) x = Maybe String
+  eval _ opts x = do
+    let msg0 = "ReadFile"
+    pp <- eval (Proxy @p) opts x
+    case getValueLR opts msg0 pp [] of
+      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
+        pure $ case mb of
+          Nothing -> mkNode opts (FailT (msg1 <> " must run in IO")) [msg1 <> " must run in IO"] []
+          Just Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " does not exist"] []
+          Just (Just b) -> mkNode opts (PresentT (Just b)) [msg1 <> " len=" <> show (length b) <> showLit0 opts " Just " b] []
+
+-- | does the directory exists
+--
+-- >>> pz @(DirExists ".") ()
+-- True
+-- TrueT
+--
+data ReadDir p
+type DirExists p = ReadDir p >> IsJust
+
+instance (PP p x ~ String, P p x) => P (ReadDir p) x where
+  type PP (ReadDir p) x = Maybe [FilePath]
+  eval _ opts x = do
+    let msg0 = "ReadDir"
+    pp <- eval (Proxy @p) opts x
+    case getValueLR opts msg0 pp [] of
+      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
+        pure $ case mb of
+          Nothing -> mkNode opts (FailT (msg1 <> " must run in IO")) [msg1 <> " must run in IO"] []
+          Just Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " does not exist"] []
+          Just (Just b) -> mkNode opts (PresentT (Just b)) [msg1 <> " len=" <> show (length b) <> show0 opts " Just " b] []
+
+-- | does the directory exists
+--
+-- >>> pz @(ReadEnv "PATH" >> 'Just Id >> 'True) ()
+-- True
+-- TrueT
+--
+data ReadEnv p
+
+instance (PP p x ~ String, P p x) => P (ReadEnv p) x where
+  type PP (ReadEnv p) x = Maybe String
+  eval _ opts x = do
+    let msg0 = "ReadEnv"
+    pp <- eval (Proxy @p) opts x
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right p -> do
+        let msg1 = msg0 <> "[" <> p <> "]"
+        mb <- runIO $ lookupEnv p
+        pure $ case mb of
+          Nothing -> mkNode opts (FailT (msg1 <> " must run in IO")) [msg1 <> " must run in IO"] []
+          Just Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " does not exist"] []
+          Just (Just v) -> mkNode opts (PresentT (Just v)) [msg1 <> showLit0 opts " " v] []
+
+data ReadEnvAll
+
+instance P ReadEnvAll a where
+  type PP ReadEnvAll a = [(String,String)]
+  eval _ opts _ = do
+    let msg0 = "ReadEnvAll"
+    mb <- runIO $ getEnvironment
+    pure $ case mb of
+      Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] []
+      Just v -> mkNode opts (PresentT v) [msg0 <> " count=" <> show (length v)] []
+
+data TimeUtc
+
+instance P TimeUtc a where
+  type PP TimeUtc a = UTCTime
+  eval _ opts _a = do
+    let msg0 = "TimeUtc"
+    mb <- runIO $ getCurrentTime
+    pure $ case mb of
+      Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] []
+      Just v -> mkNode opts (PresentT v) [msg0 <> show0 opts " " v] []
+
+data TimeZt
+
+instance P TimeZt a where
+  type PP TimeZt a = ZonedTime
+  eval _ opts _a = do
+    let msg0 = "TimeZt"
+    mb <- runIO $ getZonedTime
+    pure $ case mb of
+      Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] []
+      Just v -> mkNode opts (PresentT v) [msg0 <> show0 opts " " v] []
+
+data FHandle s = FStdout | FStderr | FOther s WFMode deriving Show
+
+class GetFHandle (x :: FHandle Symbol) where getFHandle :: FHandle String
+instance GetFHandle 'FStdout where getFHandle = FStdout
+instance GetFHandle 'FStderr where getFHandle = FStderr
+instance (GetMode w, KnownSymbol s) => GetFHandle ('FOther s w) where getFHandle = FOther (symb @s) (getMode @w)
+
+data WFMode = WFAppend | WFWrite | WFWriteForce deriving (Show,Eq)
+
+class GetMode (x :: WFMode) where getMode :: WFMode
+instance GetMode 'WFAppend where getMode = WFAppend
+instance GetMode 'WFWriteForce where getMode = WFWriteForce
+instance GetMode 'WFWrite where getMode = WFWrite
+
+data WriteFileImpl (hh :: FHandle Symbol) p
+type AppendFile (s :: Symbol) p = WriteFileImpl ('FOther s 'WFAppend) p
+type WriteFile' (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWriteForce) p
+type WriteFile (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWrite) p
+type Stdout p = WriteFileImpl 'FStdout p
+type Stderr p = WriteFileImpl 'FStderr p
+
+instance (GetFHandle fh
+        , P p a
+        , PP p a ~ String
+        ) => P (WriteFileImpl fh p) a where
+  type PP (WriteFileImpl fh p) a = ()
+  eval _ opts a = do
+    let fh = getFHandle @fh
+        msg0 = case fh of
+                      FStdout -> "Stdout"
+                      FStderr -> "Stderr"
+                      FOther s w -> (<>("[" <> s <> "]")) $ case w of
+                         WFAppend -> "AppendFile"
+                         WFWrite -> "WriteFile"
+                         WFWriteForce -> "WriteFile'"
+    pp <- eval (Proxy @p) opts a
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right ss -> do
+          mb <- runIO $ do
+                          case fh of
+                            FStdout -> fmap (left show) $ E.try @E.SomeException $ hPutStr stdout ss
+                            FStderr -> fmap (left show) $ 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"
+                               else do
+                                      let md = case w of
+                                             WFAppend -> AppendMode
+                                             _ -> WriteMode
+                                      fmap (left show) $ E.try @E.SomeException $ withFile s md (flip hPutStr ss)
+          pure $ case mb of
+            Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] [hh pp]
+            Just (Left e) -> mkNode opts (FailT e) [msg0 <> " " <> e] [hh pp]
+            Just (Right ()) -> mkNode opts (PresentT ()) [msg0] [hh pp]
+
+data Stdin
+
+instance P Stdin a where
+  type PP Stdin a = String
+  eval _ opts _a = do
+    let msg0 = "Stdin"
+    mb <- runIO $ do
+                      lr <- E.try $ hGetContents stdin
+                      pure $ case lr of
+                        Left (e :: E.SomeException) -> Left $ show e
+                        Right ss -> Right ss
+    pure $ case mb of
+      Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] []
+      Just (Left e) -> mkNode opts (FailT e) [msg0 <> " " <> e] []
+      Just (Right ss) -> mkNode opts (PresentT ss) [msg0 <> "[" <> showLit1 opts "" ss <> "]"] []
+
+--type Just' = JustFail "expected Just" Id
+--type Nothing' = Guard "expected Nothing" IsNothing
+
+-- | similar to 'isInfixOf' 'isPrefixOf' 'isSuffixOf' for strings only.
+--
+-- The \'I\' suffixed versions work are case insensitive.
+--
+-- >>> pz @(IsInfixI "abc" "axAbCd") ()
+-- True
+-- TrueT
+--
+-- >>> pz @(IsPrefixI "abc" "aBcbCd") ()
+-- True
+-- TrueT
+--
+-- >>> pz @(IsPrefix "abc" "aBcbCd") ()
+-- False
+-- FalseT
+--
+-- >>> pz @(IsSuffix "bCd" "aBcbCd") ()
+-- True
+-- TrueT
+--
+data IsFixImpl (cmp :: Ordering) (ignore :: Bool) p q
+
+type IsPrefix p q = IsFixImpl 'LT 'False p q
+type IsInfix p q = IsFixImpl 'EQ 'False p q
+type IsSuffix p q = IsFixImpl 'GT 'False p q
+
+type IsPrefixI p q = IsFixImpl 'LT 'True p q
+type IsInfixI p q = IsFixImpl 'EQ 'True p q
+type IsSuffixI p q = IsFixImpl 'GT 'True p q
+
+instance (GetBool ignore
+        , P p x
+        , P q x
+        , PP p x ~ String
+        , PP q x ~ String
+        , GetOrdering cmp
+        ) => P (IsFixImpl cmp ignore p q) x where
+  type PP (IsFixImpl cmp ignore 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) = case cmp of
+                    LT -> (isPrefixOf, "IsPrefix")
+                    EQ -> (isInfixOf, "IsInfix")
+                    GT -> (isSuffixOf, "IsSuffix")
+    pp <- eval (Proxy @p) opts x
+    case getValueLR opts msg0 pp [] of
+        Left e -> pure e
+        Right s0 -> do
+          let msg1 = msg0 <> (if ignore then "I" else "") <> "(" <> s0 <> ")"
+          qq <- eval (Proxy @q) opts x
+          pure $ case getValueLR opts (msg1 <> " q failed") qq [hh pp] of
+            Left e -> e
+            Right s1 -> mkNodeB opts (on ff lwr s0 s1) [msg1 <> showLit0 opts " " s1] [hh pp, hh qq]
+
+-- | similar to 'SG.<>'
+--
+-- >>> pz @(Fst Id <> Snd Id) ("abc","def")
+-- Present "abcdef"
+-- PresentT "abcdef"
+--
+-- >>> pz @("abcd" <> "ef" <> Id) "ghi"
+-- Present "abcdefghi"
+-- PresentT "abcdefghi"
+--
+-- >>> pz @("abcd" <> "ef" <> Id) "ghi"
+-- Present "abcdefghi"
+-- PresentT "abcdefghi"
+--
+-- >>> pz @(Wrap (SG.Sum _) Id <> FromInteger _ 10) 13
+-- Present Sum {getSum = 23}
+-- PresentT (Sum {getSum = 23})
+--
+-- >>> pz @(Wrap (SG.Product _) Id <> FromInteger _ 10) 13
+-- Present Product {getProduct = 130}
+-- PresentT (Product {getProduct = 130})
+--
+-- >>> pz @('(FromInteger _ 10,"def") <> Id) (SG.Sum 12, "_XYZ")
+-- Present (Sum {getSum = 22},"def_XYZ")
+-- PresentT (Sum {getSum = 22},"def_XYZ")
+--
+-- >>> pz @(Sapa' (SG.Max _)) (10,12)
+-- Present Max {getMax = 12}
+-- PresentT (Max {getMax = 12})
+--
+-- >>> pz @(Sapa' (SG.Sum _)) (10,12)
+-- Present Sum {getSum = 22}
+-- PresentT (Sum {getSum = 22})
+--
+data p <> q
+infixr 6 <>
+type Sapa' (t :: Type) = Wrap t (Fst Id) <> Wrap t (Snd Id)
+type Sapa = Fst Id <> Snd Id
+
+instance (Semigroup (PP p x)
+        , PP p x ~ PP q x
+        , P p x
+        , Show (PP q x)
+        ,P q x
+        ) => P (p <> q) x where
+  type PP (p <> q) x = PP p x
+  eval _ opts x = do
+    let msg0 = "<>"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let d = p <> q
+        in mkNode opts (PresentT d) [show p <> " <> " <> show q <> " = " <> show d] [hh pp, hh qq]
+
+
+-- | uses inductive tuples to replace variable arguments
+--
+class PrintC x where
+  prtC :: (PrintfArg a, PrintfType r) => String -> (a,x) -> r
+instance PrintC () where
+  prtC s (a,()) = printf s a
+instance (PrintfArg a, PrintC rs) => PrintC (a,rs) where
+  prtC s (a,rs) = prtC s rs a
+
+-- | print for flat n-tuples
+--
+-- >>> pl @(PrintT "%d %s %s %s" '(Fst Id, Snd Id, Snd Id,Snd Id)) (10,"Asdf")
+-- Present "10 Asdf Asdf Asdf" (PrintT [10 Asdf Asdf Asdf] | s=%d %s %s %s)
+-- PresentT "10 Asdf Asdf Asdf"
+--
+-- >>> pl @(PrintT "%c %d %s" Id) ('x', 10,"Asdf")
+-- Present "x 10 Asdf" (PrintT [x 10 Asdf] | s=%c %d %s)
+-- PresentT "x 10 Asdf"
+--
+-- >>> pz @(PrintT "fst=%s snd=%03d" Id) ("ab",123)
+-- Present "fst=ab snd=123"
+-- PresentT "fst=ab snd=123"
+--
+-- >>> pz @(PrintT "fst=%s snd=%03d thd=%s" Id) ("ab",123,"xx")
+-- Present "fst=ab snd=123 thd=xx"
+-- PresentT "fst=ab snd=123 thd=xx"
+--
+-- >>> pl @(PrintT "%s %d %c %s" '(W "xyz", Fst Id, Snd Id, Thd Id)) (123,'x',"ab")
+-- Present "xyz 123 x ab" (PrintT [xyz 123 x ab] | s=%s %d %c %s)
+-- PresentT "xyz 123 x ab"
+--
+-- >>> pl @(PrintT "%d %c %s" Id) (123,'x')
+-- Error PrintT(IO e=printf: argument list ended prematurely)
+-- FailT "PrintT(IO e=printf: argument list ended prematurely)"
+--
+-- >>> pl @(PrintT "%d %c %s" Id) (123,'x',"abc",11)
+-- Error PrintT(IO e=printf: formatting string ended prematurely)
+-- FailT "PrintT(IO e=printf: formatting string ended prematurely)"
+--
+data PrintT s p
+instance (PrintC bs
+        , (b,bs) ~ InductTupleP y
+        , InductTupleC y
+        , PrintfArg b
+        , PP s x ~ String
+        , PP p x ~ y
+        , P s x
+        , P p x
+        , CheckT (PP p x) ~ 'True
+        ) => P (PrintT s p) x where
+  type PP (PrintT s p) x = String
+  eval _ opts x = do
+    let msg0 = "PrintT"
+    lrx <- runPQ msg0 (Proxy @s) (Proxy @p) opts x []
+    case lrx of
+      Left e -> pure e
+      Right (s,y,ss,pp) -> do
+        let msg1 = msg0
+            hhs = [hh ss, hh pp]
+        lr <- catchitNF @_ @E.SomeException (prtC @bs s (inductTupleC y))
+        pure $ case lr of
+          Left e -> mkNode opts (FailT (msg1 <> "(" <> e <> ")")) [msg1 <> " s=" <> s] hhs
+          Right ret -> mkNode opts (PresentT ret) [msg1 <> " [" <> showLit0 opts "" ret <> "]" <> showLit0 opts " | s=" s] hhs
+
+-- | print for lists  -- if you can use 'PrintT'
+--
+-- >>> pl @(PrintL 4 "%s %s %s %s" '[W "xyz", ShowP (Fst Id), ShowP (Snd Id), Thd Id]) (123,'x',"ab")
+-- Present "xyz 123 'x' ab" (PrintL(4) [xyz 123 'x' ab] | s=%s %s %s %s)
+-- PresentT "xyz 123 'x' ab"
+--
+-- >>> pl @(PrintL 3 "first=%d second=%d third=%d" Id) [10,11,12]
+-- Present "first=10 second=11 third=12" (PrintL(3) [first=10 second=11 third=12] | s=first=%d second=%d third=%d)
+-- PresentT "first=10 second=11 third=12"
+--
+-- >>> pl @(PrintL 2 "first=%d second=%d third=%d" Id) [10,11,12]
+-- Error PrintL(2) arg count=3
+-- FailT "PrintL(2) arg count=3"
+--
+-- >>> pl @(PrintL 4 "first=%d second=%d third=%d" Id) [10,11,12]
+-- Error PrintL(4) arg count=3
+-- FailT "PrintL(4) arg count=3"
+--
+data PrintL (n :: Nat) s p
+
+instance (KnownNat n
+        , PrintC bs
+        , (b,bs) ~ InductListP n a
+        , InductListC n a
+        , PrintfArg b
+        , PP s x ~ String
+        , PP p x ~ [a]
+        , P s x
+        , P p x
+        ) => P (PrintL n s p) x where
+  type PP (PrintL n s p) x = String
+  eval _ opts x = do
+    let msg0 = "PrintL(" ++ show n ++ ")"
+        n = nat @n
+    lrx <- runPQ msg0 (Proxy @s) (Proxy @p) opts x []
+    case lrx of
+      Left e -> pure e
+      Right (s,p,ss,pp) -> do
+        let hhs = [hh ss, hh pp]
+        if length p /= n then pure $ mkNode opts (FailT (msg0 <> " arg count=" ++ show (length p))) [msg0 <> " wrong length " ++ show (length p)] hhs
+        else do
+          lr <- catchitNF @_ @E.SomeException (prtC @bs s (inductListC @n @a p))
+          pure $ case lr of
+            Left e -> mkNode opts (FailT (msg0 <> "(" <> e <> ")")) [msg0 <> " s=" <> s] hhs
+            Right ret -> mkNode opts (PresentT ret) [msg0 <> " [" <> showLit0 opts "" ret <> "]" <> showLit0 opts " | s=" s] hhs
+
+type family CheckT (tp :: Type) :: Bool where
+  CheckT () = GL.TypeError ('GL.Text "Printfn: inductive tuple cannot be empty")
+  CheckT o = 'True
+
+type family ApplyConstT (ta :: Type) (b :: Type) :: Type where
+--type family ApplyConstT ta b where -- less restrictive so allows ('Just Int) Bool through!
+  ApplyConstT (t a) b = t b
+  ApplyConstT ta b = GL.TypeError (
+       'GL.Text "ApplyConstT: (t a) b but found something else"
+       ':$$: 'GL.Text "t a = "
+       ':<>: 'GL.ShowType ta
+       ':$$: 'GL.Text "b = "
+       ':<>: 'GL.ShowType b)
+
+-- | similar to 'Control.Applicative.<$'
+--
+-- >>> pz @(Fst Id <$ Snd Id) ("abc",Just 20)
+-- Present Just "abc"
+-- PresentT (Just "abc")
+--
+data p <$ q
+infixl 4 <$
+
+instance (P p x
+        , P q x
+        , Show (PP p x)
+        , Functor t
+        , PP q x ~ t c
+        , ApplyConstT (PP q x) (PP p x) ~ t (PP p x)
+        ) => P (p <$ q) x where
+  type PP (p <$ q) x = ApplyConstT (PP q x) (PP p x)
+  eval _ opts x = do
+    let msg0 = "(<$)"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let d = p <$ q
+        in mkNode opts (PresentT d) [msg0 <> show0 opts " " p] [hh pp, hh qq]
+
+data p <* q
+infixl 4 <*
+
+-- | similar to 'Control.Applicative.<*'
+--
+-- >>> pz @(Fst Id <* Snd Id) (Just "abc",Just 20)
+-- Present Just "abc"
+-- PresentT (Just "abc")
+--
+type p *> q = q <* p
+infixl 4 *>
+
+instance (Show (t c)
+        , P p x
+        , P q x
+        , Show (t b)
+        , Applicative t
+        , t b ~ PP p x
+        , PP q x ~ t c
+        ) => P (p <* q) x where
+  type PP (p <* q) x = PP p x
+  eval _ opts x = do
+    let msg0 = "(<*)"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let d = p <* q
+        in mkNode opts (PresentT d) [show01' opts msg0 p "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
+
+-- | similar to 'Control.Applicative.<|>'
+--
+-- >>> pz @(Fst Id <|> Snd Id) (Nothing,Just 20)
+-- Present Just 20
+-- PresentT (Just 20)
+--
+-- >>> pz @(Fst Id <|> Snd Id) (Just 10,Just 20)
+-- Present Just 10
+-- PresentT (Just 10)
+--
+-- >>> pz @(Fst Id <|> Snd Id) (Nothing,Nothing)
+-- Present Nothing
+-- PresentT Nothing
+--
+data p <|> q
+infixl 3 <|>
+
+instance (P p x
+        , P q x
+        , Show (t b)
+        , Alternative t
+        , t b ~ PP p x
+        , PP q x ~ t b
+        ) => P (p <|> q) x where
+  type PP (p <|> q) x = PP p x
+  eval _ opts x = do
+    let msg0 = "(<|>)"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq) ->
+        let d = p <|> q
+        in mkNode opts (PresentT d) [show01' opts msg0 d "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
+
+
+-- | similar to 'Control.Comonad.extract'
+--
+-- >>> pz @Extract (Nothing,Just 20)
+-- Present Just 20
+-- PresentT (Just 20)
+--
+-- >>> pz @Extract (Identity 20)
+-- Present 20
+-- PresentT 20
+--
+data Extract
+instance (Show (t a)
+        , Show a
+        , Comonad t
+        ) => P Extract (t a) where
+  type PP Extract (t a) = a
+  eval _ opts ta =
+    let msg0 = "Extract"
+        d = extract ta
+    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d ta] []
+
+-- | similar to 'Control.Comonad.duplicate'
+--
+-- >>> pz @Duplicate (20,"abc")
+-- Present (20,(20,"abc"))
+-- PresentT (20,(20,"abc"))
+--
+data Duplicate
+
+instance (Show (t a)
+        , Show (t (t a))
+        , Comonad t
+        ) => P Duplicate (t a) where
+  type PP Duplicate (t a) = t (t a)
+  eval _ opts ta =
+    let msg0 = "Duplicate"
+        d = duplicate ta
+    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d ta] []
+
+-- | similar to 'Control.Monad.join'
+--
+-- >>> pz @Join  (Just (Just 20))
+-- Present Just 20
+-- PresentT (Just 20)
+--
+-- >>> pz @Join  ["ab","cd","","ef"]
+-- Present "abcdef"
+-- PresentT "abcdef"
+--
+data Join
+
+instance (Show (t (t a))
+        , Show (t a)
+        , Monad t
+        ) => P Join (t (t a)) where
+  type PP Join (t (t a)) = t a
+  eval _ opts tta =
+    let msg0 = "Join"
+        d = join tta
+    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d tta] []
+
+-- | function application for expressions: similar to 'GHC.Base.$'
+--
+-- pz @(Fst Id $ Snd Id) ((*16),4)
+-- Present 64
+-- PresentT 64
+--
+-- pz @(Id $ "def") ("abc"<>)
+-- Present "abcdef"
+-- PresentT "abcdef"
+--
+data p $ q
+infixl 0 $
+
+instance (P p x
+        , P q x
+        , PP p x ~ (a -> b)
+        , FnT (PP p x) ~ b
+        , PP q x ~ a
+        , Show a
+        , Show b
+        ) => P (p $ q) x where
+  type PP (p $ q) x = FnT (PP p x)
+  eval _ opts x = do
+    let msg0 = "($)"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq)  ->
+        let d = p q
+        in mkNode opts (PresentT d) ["fn $ " <> show q <> " = " <> show d] [hh pp, hh qq]
+
+-- reify this so we can combine (type synonyms dont work as well)
+
+-- | flipped function application for expressions: similar to 'Control.Lens.&'
+--
+-- pz @(Snd Id & Fst Id) ((*16),4)
+-- Present 64
+-- PresentT 64
+--
+-- pz @("def" & Id) ("abc"<>)
+-- Present "abcdef"
+-- PresentT "abcdef"
+--
+data q & p -- flips the args eg a & b & (,) = (b,a)
+infixr 1 &
+
+instance (P p x
+        , P q x
+        , PP p x ~ (a -> b)
+        , FnT (PP p x) ~ b
+        , PP q x ~ a
+        , Show a
+        , Show b
+        ) => P (q & p) x where
+  type PP (q & p) x = FnT (PP p x)
+  eval _ opts x = do
+    let msg0 = "(&)"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,q,pp,qq)  ->
+        let d = p q
+        in mkNode opts (PresentT d) ["fn & " <> show q <> " = " <> show d] [hh pp, hh qq]
+
+type family FnT ab :: Type where
+  FnT (a -> b) = b
+  FnT ab = GL.TypeError (
+      'GL.Text "FnT: expected Type -> Type but found a simple Type?"
+      ':$$: 'GL.Text "ab = "
+      ':<>: 'GL.ShowType ab)
+
+-- | similar to 'T.strip' 'T.stripStart' 'T.stripEnd'
+--
+-- >>> pz @(Trim (Snd Id)) (20," abc   " :: String)
+-- Present "abc"
+-- PresentT "abc"
+--
+-- >>> pz @(Trim (Snd Id)) (20,T.pack " abc   ")
+-- Present "abc"
+-- PresentT "abc"
+--
+-- >>> pz @(TrimStart (Snd Id)) (20," abc   ")
+-- Present "abc   "
+-- PresentT "abc   "
+--
+-- >>> pz @(TrimEnd (Snd Id)) (20," abc   ")
+-- Present " abc"
+-- PresentT " abc"
+--
+-- >>> pz @(TrimEnd "  abc ") ()
+-- Present "  abc"
+-- PresentT "  abc"
+--
+-- >>> pz @(TrimEnd "") ()
+-- Present ""
+-- PresentT ""
+--
+-- >>> pz @(Trim "         ") ()
+-- Present ""
+-- PresentT ""
+--
+-- >>> pz @(Trim "") ()
+-- Present ""
+-- PresentT ""
+--
+data Trim' (left :: Bool) (right :: Bool) p
+type Trim p = Trim' 'True 'True p
+type TrimStart p = Trim' 'True 'False p
+type TrimEnd p = Trim' 'False 'True p
+
+instance (FailUnlessT (OrT l r)
+           ('GL.Text "Trim': left and right cannot both be False")
+        , GetBool l
+        , GetBool r
+        , TL.IsText (PP p x)
+        , P p x
+        ) => P (Trim' l r p) x where
+  type PP (Trim' l r p) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Trim" ++ (if l && r then "" else if l then "Start" else "End")
+        l = getBool @l
+        r = getBool @r
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right (view TL.unpacked -> p) ->
+        let fl = if l then dropWhile isSpace else id
+            fr = if r then dropWhileEnd isSpace else id
+            b =  (fl . fr) p
+        in mkNode opts (PresentT (b ^. TL.packed)) [msg0 <> showLit0 opts "" b <> showLit1 opts " | " p] [hh pp]
+
+-- | similar to 'T.stripLeft' 'T.stripRight'
+--
+-- >>> pz @(StripLeft "xyz" Id) ("xyzHello" :: String)
+-- Present Just "Hello"
+-- PresentT (Just "Hello")
+--
+-- >>> pz @(StripLeft "xyz" Id) (T.pack "xyzHello")
+-- Present Just "Hello"
+-- PresentT (Just "Hello")
+--
+-- >>> pz @(StripLeft "xyz" Id) "xywHello"
+-- Present Nothing
+-- PresentT Nothing
+--
+-- >>> pz @(StripRight "xyz" Id) "Hello xyz"
+-- Present Just "Hello "
+-- PresentT (Just "Hello ")
+--
+-- >>> pz @(StripRight "xyz" Id) "xyzHelloxyw"
+-- Present Nothing
+-- PresentT Nothing
+--
+-- >>> pz @(StripRight "xyz" Id) ""
+-- Present Nothing
+-- PresentT Nothing
+--
+-- >>> pz @(StripRight "xyz" "xyz") ()
+-- Present Just ""
+-- PresentT (Just "")
+--
+data StripLR (right :: Bool) p q
+type StripRight p q = StripLR 'True p q
+type StripLeft p q = StripLR 'False p q
+
+instance (GetBool r
+        , PP p x ~ String
+        , P p x
+        , TL.IsText (PP q x)
+        , P q x
+        ) => P (StripLR r p q) x where
+  type PP (StripLR r p q) x = Maybe (PP q x)
+  eval _ opts x = do
+    let msg0 = "Strip" ++ (if r then "Right" else "Left")
+        r = getBool @r
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,view TL.unpacked -> q,pp,qq) ->
+        let b = if r then
+                  let (before,after) = splitAt (length q - length p) q
+                  in if after == p then Just before else Nothing
+                else
+                  let (before,after) = splitAt (length p) q
+                  in if before == p then Just after else Nothing
+        in mkNode opts (PresentT (fmap (view TL.packed) b)) [msg0 <> show0 opts "" b <> showLit1 opts " | p=" p <> showLit1 opts " | q=" q] [hh pp, hh qq]
+
+-- | creates a promoted list of predicates and then evaluates them into a list. see PP instance for '[k]
+--
+-- >>> pz @(Repeat 4 (Succ Id)) 'c'
+-- Present "dddd"
+-- PresentT "dddd"
+--
+-- >>> pz @(Repeat 4 "abc") ()
+-- Present ["abc","abc","abc","abc"]
+-- PresentT ["abc","abc","abc","abc"]
+--
+data Repeat (n :: Nat) p
+instance (P (RepeatT n p) a
+         ) => P (Repeat n p) a where
+  type PP (Repeat n p) a = PP (RepeatT n p) a
+  eval _ opts a =
+    eval (Proxy @(RepeatT n p)) opts a
+
+-- | leverages 'Do' for repeating predicates (passthrough method)
+-- same as @DoN n p == FoldN n p Id@ but more efficient
+--
+-- >>> pz @(DoN 4 (Succ Id)) 'c'
+-- Present 'g'
+-- PresentT 'g'
+--
+-- >>> pz @(DoN 4 (Id <> " | ")) "abc"
+-- Present "abc |  |  |  | "
+-- PresentT "abc |  |  |  | "
+--
+-- >>> pz @(DoN 4 (Id <> "|" <> Id)) "abc"
+-- Present "abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc"
+-- PresentT "abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc"
+--
+data DoN (n :: Nat) p
+instance (P (DoExpandT (RepeatT n p)) a
+         ) => P (DoN n p) a where
+  type PP (DoN n p) a = PP (Do (RepeatT n p)) a
+  eval _ opts a =
+    eval (Proxy @(Do (RepeatT n p))) opts a
+
+-- | extract the value from a 'Maybe' otherwise use the default value
+--
+-- >>> pz @(JustDef (1 % 4) Id) (Just 20.4)
+-- Present 102 % 5
+-- PresentT (102 % 5)
+--
+-- >>> pz @(JustDef (1 % 4) Id) Nothing
+-- Present 1 % 4
+-- PresentT (1 % 4)
+--
+-- >>> pz @(JustDef (MEmptyT _) Id) (Just "xy")
+-- Present "xy"
+-- PresentT "xy"
+--
+-- >>> pz @(JustDef (MEmptyT _) Id) Nothing
+-- Present ()
+-- PresentT ()
+--
+-- >>> pz @(JustDef (MEmptyT (SG.Sum _)) Id) Nothing
+-- Present Sum {getSum = 0}
+-- PresentT (Sum {getSum = 0})
+--
+data JustDef p q
+
+instance ( PP p x ~ a
+         , PP q x ~ Maybe a
+         , P p x
+         , P q x)
+    => P (JustDef p q) x where
+  type PP (JustDef p q) x = MaybeT (PP q x)
+  eval _ opts x = do
+    let msg0 = "JustDef"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          Just b -> pure $ mkNode opts (PresentT b) [msg0 <> " Just"] [hh qq]
+          Nothing -> do
+            pp <- eval (Proxy @p) opts x
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right b -> mkNode opts (PresentT b) [msg0 <> " Nothing"] [hh qq, hh pp]
+
+
+type family MaybeT mb where
+  MaybeT (Maybe a) = a
+  MaybeT o = GL.TypeError (
+      'GL.Text "MaybeT: expected 'Maybe a' "
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
+
+-- | extract the value from a 'Maybe' or fail
+--
+-- >>> pz @(JustFail "nope" Id) (Just 99)
+-- Present 99
+-- PresentT 99
+--
+-- >>> pz @(JustFail "nope" Id) Nothing
+-- Error nope
+-- FailT "nope"
+--
+-- >>> pz @(JustFail (PrintF "oops=%d" (Snd Id)) (Fst Id)) (Nothing, 123)
+-- Error oops=123
+-- FailT "oops=123"
+--
+-- >>> pz @(JustFail (PrintF "oops=%d" (Snd Id)) (Fst Id)) (Just 'x', 123)
+-- Present 'x'
+-- PresentT 'x'
+--
+data JustFail p q
+
+instance ( PP p x ~ String
+         , PP q x ~ Maybe a
+         , P p x
+         , P q x)
+    => P (JustFail p q) x where
+  type PP (JustFail p q) x = MaybeT (PP q x)
+  eval _ opts x = do
+    let msg0 = "JustFail"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          Just b -> pure $ mkNode opts (PresentT b) [msg0 <> " Just"] [hh qq]
+          Nothing -> do
+            pp <- eval (Proxy @p) opts x
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (FailT p) [msg0 <> " Nothing"] [hh qq, hh pp]
+
+-- | extract the Left value from an 'Either' otherwise use the default value
+--
+-- if there is no Left value then \p\ is passed the Right value and the whole context
+--
+-- >>> pz @(LeftDef (1 % 4) Id) (Left 20.4)
+-- Present 102 % 5
+-- PresentT (102 % 5)
+--
+-- >>> pz @(LeftDef (1 % 4) Id) (Right "aa")
+-- Present 1 % 4
+-- PresentT (1 % 4)
+--
+-- >>> pz @(LeftDef (PrintT "found right=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Right "xy")
+-- Present "found right=xy fst=123"
+-- PresentT "found right=xy fst=123"
+--
+-- >>> pz @(LeftDef (MEmptyT _) Id) (Right 222)
+-- Present ()
+-- PresentT ()
+--
+-- >>> pz @(LeftDef (MEmptyT (SG.Sum _)) Id) (Right 222)
+-- Present Sum {getSum = 0}
+-- PresentT (Sum {getSum = 0})
+--
+data LeftDef p q
+
+instance ( PP q x ~ Either a b
+         , PP p (b,x) ~ a
+         , P q x
+         , P p (b,x)
+    ) => P (LeftDef p q) x where
+  type PP (LeftDef p q) x = LeftT (PP q x)
+  eval _ opts x = do
+    let msg0 = "LeftDef"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          Left a -> pure $ mkNode opts (PresentT a) [msg0 <> " Left"] [hh qq]
+          Right b -> do
+            pp <- eval (Proxy @p) opts (b,x)
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (PresentT p) [msg0 <> " Right"] [hh qq, hh pp]
+
+type family LeftT lr where
+  LeftT (Either a b) = a
+  LeftT o = GL.TypeError (
+      'GL.Text "LeftT: expected 'Either a b' "
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
+
+type family RightT lr where
+  RightT (Either a b) = b
+  RightT o = GL.TypeError (
+      'GL.Text "RightT: expected 'Either a b' "
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
+
+-- | extract the Right value from an 'Either'
+--
+-- if there is no Right value then \p\ is passed the Left value and the whole context
+--
+-- >>> pz @(RightDef (1 % 4) Id) (Right 20.4)
+-- Present 102 % 5
+-- PresentT (102 % 5)
+--
+-- >>> pz @(RightDef (1 % 4) Id) (Left "aa")
+-- Present 1 % 4
+-- PresentT (1 % 4)
+--
+-- >>> pz @(RightDef (PrintT "found left=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Left "xy")
+-- Present "found left=xy fst=123"
+-- PresentT "found left=xy fst=123"
+--
+-- >>> pz @(RightDef (MEmptyT _) Id) (Left 222)
+-- Present ()
+-- PresentT ()
+--
+-- >>> pz @(RightDef (MEmptyT (SG.Sum _)) Id) (Left 222)
+-- Present Sum {getSum = 0}
+-- PresentT (Sum {getSum = 0})
+--
+data RightDef p q
+
+instance ( PP q x ~ Either a b
+         , PP p (a,x) ~ b
+         , P q x
+         , P p (a,x)
+    ) => P (RightDef p q) x where
+  type PP (RightDef p q) x = RightT (PP q x)
+  eval _ opts x = do
+    let msg0 = "RightDef"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          Right b -> pure $ mkNode opts (PresentT b) [msg0 <> " Right"] [hh qq]
+          Left a -> do
+            pp <- eval (Proxy @p) opts (a,x)
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (PresentT p) [msg0 <> " Left"] [hh qq, hh pp]
+
+
+-- | extract the Left value from an 'Either' otherwise fail with an error message
+--
+-- if there is no Left value then \p\ is passed the Right value and the whole context
+--
+-- >>> pz @(LeftFail "oops" Id) (Left 20.4)
+-- Present 20.4
+-- PresentT 20.4
+--
+-- >>> pz @(LeftFail "oops" Id) (Right "aa")
+-- Error oops
+-- FailT "oops"
+--
+-- >>> pz @(LeftFail (PrintT "found right=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Right "xy")
+-- Error found right=xy fst=123
+-- FailT "found right=xy fst=123"
+--
+-- >>> pz @(LeftFail (MEmptyT _) Id) (Right 222)
+-- Error
+-- FailT ""
+--
+data LeftFail p q
+
+instance ( PP p (b,x) ~ String
+         , PP q x ~ Either a b
+         , P p (b,x)
+         , P q x)
+    => P (LeftFail p q) x where
+  type PP (LeftFail p q) x = LeftT (PP q x)
+  eval _ opts x = do
+    let msg0 = "LeftFail"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          Left a -> pure $ mkNode opts (PresentT a) [msg0 <> " Left"] [hh qq]
+          Right b -> do
+            pp <- eval (Proxy @p) opts (b,x)
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (FailT p) [msg0 <> " Right"] [hh qq, hh pp]
+
+
+-- | extract the Right value from an 'Either' otherwise fail with an error message
+--
+-- if there is no Right value then \p\ is passed the Left value and the whole context
+--
+-- >>> pz @(RightFail "oops" Id) (Right 20.4)
+-- Present 20.4
+-- PresentT 20.4
+--
+-- >>> pz @(RightFail "oops" Id) (Left "aa")
+-- Error oops
+-- FailT "oops"
+--
+-- >>> pz @(RightFail (PrintT "found left=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Left "xy")
+-- Error found left=xy fst=123
+-- FailT "found left=xy fst=123"
+--
+-- >>> pz @(RightFail (MEmptyT _) Id) (Left 222)
+-- Error
+-- FailT ""
+--
+data RightFail p q
+
+instance ( PP p (a,x) ~ String
+         , PP q x ~ Either a b
+         , P p (a,x)
+         , P q x)
+    => P (RightFail p q) x where
+  type PP (RightFail p q) x = RightT (PP q x)
+  eval _ opts x = do
+    let msg0 = "RightFail"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          Right b -> pure $ mkNode opts (PresentT b) [msg0 <> " Right"] [hh qq]
+          Left a -> do
+            pp <- eval (Proxy @p) opts (a,x)
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (FailT p) [msg0 <> " Left"] [hh qq, hh pp]
+
+
+
+-- | extract the This value from an 'These' otherwise use the default value
+--
+-- if there is no This value then \p\ is passed the whole context only
+--
+-- >>> pz @(ThisDef (1 % 4) Id) (This 20.4)
+-- Present 102 % 5
+-- PresentT (102 % 5)
+--
+-- >>> pz @(ThisDef (1 % 4) Id) (That "aa")
+-- Present 1 % 4
+-- PresentT (1 % 4)
+--
+-- >>> pz @(ThisDef (1 % 4) Id) (These 2.3 "aa")
+-- Present 1 % 4
+-- PresentT (1 % 4)
+--
+-- >>> pz @(ThisDef (PrintT "found %s fst=%d" '(ShowP (Snd Id), Fst Id)) (Snd Id)) (123,That "xy")
+-- Present "found That \"xy\" fst=123"
+-- PresentT "found That \"xy\" fst=123"
+--
+-- >>> pz @(ThisDef (MEmptyT _) Id) (That 222)
+-- Present ()
+-- PresentT ()
+--
+-- >>> pz @(ThisDef (MEmptyT (SG.Sum _)) Id) (These 222 'x')
+-- Present Sum {getSum = 0}
+-- PresentT (Sum {getSum = 0})
+--
+data ThisDef p q
+
+instance ( PP q x ~ These a b
+         , PP p x ~ a
+         , P q x
+         , P p x
+    ) => P (ThisDef p q) x where
+  type PP (ThisDef p q) x = ThisT (PP q x)
+  eval _ opts x = do
+    let msg0 = "ThisDef"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          This a -> pure $ mkNode opts (PresentT a) [msg0 <> " This"] [hh qq]
+          _ -> do
+            pp <- eval (Proxy @p) opts x
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (PresentT p) [msg0 <> " " <> getTheseType q] [hh qq, hh pp]
+
+type family ThisT lr where
+  ThisT (These a b) = a
+  ThisT o = GL.TypeError (
+      'GL.Text "ThisT: expected 'These a b' "
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
+
+type family ThatT lr where
+  ThatT (These a b) = b
+  ThatT o = GL.TypeError (
+      'GL.Text "ThatT: expected 'These a b' "
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
+
+type family TheseT lr where
+  TheseT (These a b) = (a,b)
+  TheseT o = GL.TypeError (
+      'GL.Text "TheseT: expected 'These a b' "
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
+
+
+-- | extract the That value from an 'These' otherwise use the default value
+--
+-- if there is no That value then \p\ is passed the whole context only
+--
+-- >>> pz @(ThatDef (1 % 4) Id) (That 20.4)
+-- Present 102 % 5
+-- PresentT (102 % 5)
+--
+-- >>> pz @(ThatDef (1 % 4) Id) (This "aa")
+-- Present 1 % 4
+-- PresentT (1 % 4)
+--
+-- >>> pz @(ThatDef (1 % 4) Id) (These "aa" 2.3)
+-- Present 1 % 4
+-- PresentT (1 % 4)
+--
+-- >>> pz @(ThatDef (PrintT "found %s fst=%d" '(ShowP (Snd Id), Fst Id)) (Snd Id)) (123,This "xy")
+-- Present "found This \"xy\" fst=123"
+-- PresentT "found This \"xy\" fst=123"
+--
+-- >>> pz @(ThatDef (MEmptyT _) Id) (This 222)
+-- Present ()
+-- PresentT ()
+--
+-- >>> pz @(ThatDef (MEmptyT (SG.Sum _)) Id) (These 'x' 1120)
+-- Present Sum {getSum = 0}
+-- PresentT (Sum {getSum = 0})
+--
+data ThatDef p q
+
+instance ( PP q x ~ These a b
+         , PP p x ~ b
+         , P q x
+         , P p x
+    ) => P (ThatDef p q) x where
+  type PP (ThatDef p q) x = ThatT (PP q x)
+  eval _ opts x = do
+    let msg0 = "ThatDef"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          That a -> pure $ mkNode opts (PresentT a) [msg0 <> " That"] [hh qq]
+          _ -> do
+            pp <- eval (Proxy @p) opts x
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (PresentT p) [msg0 <> " " <> getTheseType q] [hh qq, hh pp]
+
+-- | extract the These value from an 'These' otherwise use the default value
+--
+-- if there is no These value then \p\ is passed the whole context only
+--
+-- >>> pz @(TheseDef '(1 % 4,"zz") Id) (These 20.4 "x")
+-- Present (102 % 5,"x")
+-- PresentT (102 % 5,"x")
+--
+-- >>> pz @(TheseDef '(1 % 4,"zz") Id) (This 20.4)
+-- Present (1 % 4,"zz")
+-- PresentT (1 % 4,"zz")
+--
+-- >>> pz @(TheseDef '(1 % 4,"zz") Id) (That "x")
+-- Present (1 % 4,"zz")
+-- PresentT (1 % 4,"zz")
+--
+-- >>> pz @(TheseDef '(PrintT "found %s fst=%d" '(ShowP (Snd Id), Fst Id),999) (Snd Id)) (123,This "xy")
+-- Present ("found This \"xy\" fst=123",999)
+-- PresentT ("found This \"xy\" fst=123",999)
+--
+-- >>> pz @(TheseDef (MEmptyT (SG.Sum _, String)) Id) (This 222)
+-- Present (Sum {getSum = 0},"")
+-- PresentT (Sum {getSum = 0},"")
+--
+-- >>> pz @(TheseDef (MEmptyT _) Id) (These (222 :: SG.Sum Int) "aa")
+-- Present (Sum {getSum = 222},"aa")
+-- PresentT (Sum {getSum = 222},"aa")
+--
+data TheseDef p q
+
+instance ( PP q x ~ These a b
+         , PP p x ~ (a,b)
+         , P q x
+         , P p x
+    ) => P (TheseDef p q) x where
+  type PP (TheseDef p q) x = TheseT (PP q x)
+  eval _ opts x = do
+    let msg0 = "TheseDef"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          These a b -> pure $ mkNode opts (PresentT (a,b)) [msg0 <> " These"] [hh qq]
+          _ -> do
+            pp <- eval (Proxy @p) opts x
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (PresentT p) [msg0 <> " " <> getTheseType q] [hh qq, hh pp]
+
+
+-- | extract the This value from a 'These' otherwise fail with an error message
+--
+-- if there is no This value then \p\ is passed the whole context only
+--
+-- >>> pz @(ThisFail "oops" Id) (This 20.4)
+-- Present 20.4
+-- PresentT 20.4
+--
+-- >>> pz @(ThisFail "oops" Id) (That "aa")
+-- Error oops
+-- FailT "oops"
+--
+-- >>> pz @(ThisFail (PrintT "found %s fst=%d" '(ShowP (Snd Id),Fst Id)) (Snd Id)) (123,That "xy")
+-- Error found That "xy" fst=123
+-- FailT "found That \"xy\" fst=123"
+--
+-- >>> pz @(ThisFail (MEmptyT _) Id) (That 222)
+-- Error
+-- FailT ""
+--
+data ThisFail p q
+
+instance ( PP p x ~ String
+         , PP q x ~ These a b
+         , P p x
+         , P q x)
+    => P (ThisFail p q) x where
+  type PP (ThisFail p q) x = ThisT (PP q x)
+  eval _ opts x = do
+    let msg0 = "ThisFail"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          This a -> pure $ mkNode opts (PresentT a) [msg0 <> " This"] [hh qq]
+          _ -> do
+            pp <- eval (Proxy @p) opts x
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (FailT p) [msg0 <> " " <> getTheseType q] [hh qq, hh pp]
+
+
+-- | extract the That value from a 'These' otherwise fail with an error message
+--
+-- if there is no That value then \p\ is passed the whole context only
+--
+-- >>> pz @(ThatFail "oops" Id) (That 20.4)
+-- Present 20.4
+-- PresentT 20.4
+--
+-- >>> pz @(ThatFail "oops" Id) (This "aa")
+-- Error oops
+-- FailT "oops"
+--
+-- >>> pz @(ThatFail (PrintT "found %s fst=%d" '(ShowP (Snd Id),Fst Id)) (Snd Id)) (123,This "xy")
+-- Error found This "xy" fst=123
+-- FailT "found This \"xy\" fst=123"
+--
+-- >>> pz @(ThatFail (MEmptyT _) Id) (This 222)
+-- Error
+-- FailT ""
+--
+data ThatFail p q
+
+instance ( PP p x ~ String
+         , PP q x ~ These a b
+         , P p x
+         , P q x)
+    => P (ThatFail p q) x where
+  type PP (ThatFail p q) x = ThatT (PP q x)
+  eval _ opts x = do
+    let msg0 = "ThatFail"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          That a -> pure $ mkNode opts (PresentT a) [msg0 <> " That"] [hh qq]
+          _ -> do
+            pp <- eval (Proxy @p) opts x
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (FailT p) [msg0 <> " " <> getTheseType q] [hh qq, hh pp]
+
+
+
+
+-- | extract the These value from a 'These' otherwise fail with an error message
+--
+-- if there is no These value then \p\ is passed the whole context only
+--
+-- >>> pz @(TheseFail "oops" Id) (These "abc" 20.4)
+-- Present ("abc",20.4)
+-- PresentT ("abc",20.4)
+--
+-- >>> pz @(TheseFail "oops" Id) (That "aa")
+-- Error oops
+-- FailT "oops"
+--
+-- >>> pz @(TheseFail (PrintT "found %s fst=%d" '(ShowP (Snd Id),Fst Id)) (Snd Id)) (123,That "xy")
+-- Error found That "xy" fst=123
+-- FailT "found That \"xy\" fst=123"
+--
+-- >>> pz @(TheseFail (MEmptyT _) Id) (That 222)
+-- Error
+-- FailT ""
+--
+data TheseFail p q
+
+instance ( PP p x ~ String
+         , PP q x ~ These a b
+         , P p x
+         , P q x)
+    => P (TheseFail p q) x where
+  type PP (TheseFail p q) x = TheseT (PP q x)
+  eval _ opts x = do
+    let msg0 = "TheseFail"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        case q of
+          These a b -> pure $ mkNode opts (PresentT (a,b)) [msg0 <> " These"] [hh qq]
+          _ -> do
+            pp <- eval (Proxy @p) opts x
+            pure $ case getValueLR opts msg0 pp [hh qq] of
+              Left e -> e
+              Right p -> mkNode opts (FailT p) [msg0 <> " " <> getTheseType q] [hh qq, hh pp]
+
+getTheseType :: These a b -> String
+getTheseType = \case
+  This {} -> "This"
+  That {} -> "That"
+  These {} -> "These"
+
+-- | takes the head of a list like container
+--
+-- >>> pz @(Head Id) "abcd"
+-- Present 'a'
+-- PresentT 'a'
+--
+-- >>> pz @(Head Id) []
+-- Error Head(empty)
+-- FailT "Head(empty)"
+--
+data Head p
+
+instance (Show (ConsT s)
+        , Show s
+        , Cons s s (ConsT s) (ConsT s)
+        , PP p x ~ s
+        , P p x
+        ) => P (Head p) x where
+  type PP (Head p) x = ConsT (PP p x)
+  eval _ opts x = do
+    let msg0 = "Head"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        case p ^? _Cons of
+          Nothing -> mkNode opts (FailT (msg0 <> "(empty)")) [msg0 <> " no data"] [hh pp]
+          Just (a,_) -> mkNode opts (PresentT a) [show01 opts msg0 a p] [hh pp]
+
+-- | takes the tail of a list like container
+--
+-- >>> pz @(Tail Id) "abcd"
+-- Present "bcd"
+-- PresentT "bcd"
+--
+-- >>> pz @(Tail Id) []
+-- Error Tail(empty)
+-- FailT "Tail(empty)"
+--
+data Tail p
+
+instance (Show s
+        , Cons s s (ConsT s) (ConsT s)
+        , PP p x ~ s
+        , P p x
+        ) => P (Tail p) x where
+  type PP (Tail p) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Tail"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        case p ^? _Cons of
+          Nothing -> mkNode opts (FailT (msg0 <> "(empty)")) [msg0 <> " no data"] [hh pp]
+          Just (_,as) -> mkNode opts (PresentT as) [show01 opts msg0 as p] [hh pp]
+
+
+-- | takes the last of a list like container
+--
+-- >>> pz @(Last Id) "abcd"
+-- Present 'd'
+-- PresentT 'd'
+--
+-- >>> pz @(Last Id) []
+-- Error Last(empty)
+-- FailT "Last(empty)"
+--
+
+data Last p
+
+instance (Show (ConsT s)
+        , Show s
+        , Snoc s s (ConsT s) (ConsT s)
+        , PP p x ~ s
+        , P p x
+        ) => P (Last p) x where
+  type PP (Last p) x = ConsT (PP p x)
+  eval _ opts x = do
+    let msg0 = "Last"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        case p ^? _Snoc of
+          Nothing -> mkNode opts (FailT (msg0 <> "(empty)")) [msg0 <> " no data"] [hh pp]
+          Just (_,a) -> mkNode opts (PresentT a) [show01 opts msg0 a p] [hh pp]
+
+-- | takes the init of a list like container
+--
+-- >>> pz @(Init Id) "abcd"
+-- Present "abc"
+-- PresentT "abc"
+--
+-- >>> pz @(Init Id) (T.pack "abcd")
+-- Present "abc"
+-- PresentT "abc"
+--
+-- >>> pz @(Init Id) []
+-- Error Init(empty)
+-- FailT "Init(empty)"
+--
+
+data Init p
+
+instance (Show s
+        , Snoc s s (ConsT s) (ConsT s)
+        , PP p x ~ s
+        , P p x
+        ) => P (Init p) x where
+  type PP (Init p) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Init"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        case p ^? _Snoc of
+          Nothing -> mkNode opts (FailT (msg0 <> "(empty)")) [msg0 <> " no data"] [hh pp]
+          Just (as,_) -> mkNode opts (PresentT as) [show01 opts msg0 as p] [hh pp]
+
+
+-- | tries to extract @a@ from @Maybe a@ otherwise it fails
+--
+-- >>> pz @(Just Id) (Just "abc")
+-- Present "abc"
+-- PresentT "abc"
+--
+-- >>> pz @(Just Id) Nothing
+-- Error Just(empty)
+-- FailT "Just(empty)"
+--
+data Just p
+
+instance (Show a
+        , PP p x ~ Maybe a
+        , P p x
+        ) => P (Just p) x where
+  type PP (Just p) x = MaybeT (PP p x)
+  eval _ opts x = do
+    let msg0 = "Just"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        case p of
+          Nothing -> mkNode opts (FailT (msg0 <> "(empty)")) [msg0 <> " found Nothing"] [hh pp]
+          Just d -> mkNode opts (PresentT d) [show01 opts msg0 d p] [hh pp]
src/Predicate/Refined.hs view
@@ -29,26 +29,30 @@   , RefinedC
   , newRefined
   , RefinedT(..)
+
   -- ** print methods
   , prtRefinedIO
   , prtRefinedTIO
   , prtRefinedT
-  -- ** create Refined
+
+  -- ** create methods
   , withRefinedT
   , withRefinedTIO
   , newRefinedT
   , newRefinedTIO
+
   -- ** QuickCheck method
   , arbRefined
+
   -- ** manipulate RefinedT values
   , convertRefinedT
   , unRavelT
   , unRavelTIO
-  , unRavelTI
   , rapply
   , rapply0
   , rapply1
-  -- ** create Refined unsafely
+
+  -- ** unsafe create methods
   , unsafeRefined
   , unsafeRefined'
  ) where
@@ -60,7 +64,7 @@ import Control.Monad.Except
 import Control.Monad.Writer (WriterT(..), runWriterT, MonadWriter, tell)
 import Control.Monad.Cont
-import Data.Aeson
+import Data.Aeson (ToJSON(..), FromJSON(..))
 import GHC.Generics (Generic)
 import qualified Language.Haskell.TH.Syntax as TH
 import System.Console.Pretty
@@ -80,49 +84,49 @@ 
 -- | a simple refinement type that ensures the predicate \'p\' holds for the type \'a\'
 --
--- >>> prtRefinedIO @(Between 10 14) ol 13
+-- >>> prtRefinedIO @(Between 10 14) oz 13
 -- Right (Refined {unRefined = 13})
 --
--- >>> prtRefinedIO @(Between 10 14) ol 99
+-- >>> prtRefinedIO @(Between 10 14) oz 99
 -- Left FalseP
 --
--- >>> prtRefinedIO @(Last >> Len == 4) ol ["one","two","three","four"]
+-- >>> prtRefinedIO @(Last Id >> Len == 4) oz ["one","two","three","four"]
 -- Right (Refined {unRefined = ["one","two","three","four"]})
 --
--- >>> prtRefinedIO @(Re "^\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}$" Id) ol "141.213.1.99"
+-- >>> prtRefinedIO @(Re "^\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}$" Id) oz "141.213.1.99"
 -- Right (Refined {unRefined = "141.213.1.99"})
 --
--- >>> prtRefinedIO @(Re "^\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}$" Id) ol "141.213.1"
+-- >>> prtRefinedIO @(Re "^\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}$" Id) oz "141.213.1"
 -- Left FalseP
 --
--- >>> prtRefinedIO @(Map (ReadP Int) (Resplit "\\." Id) >> Guard (Printf "bad length: found %d" Len) (Len == 4) >> 'True) ol "141.213.1"
+-- >>> prtRefinedIO @(Map (ReadP Int Id) (Resplit "\\." Id) >> Guard (PrintF "bad length: found %d" Len) (Len == 4) >> 'True) oz "141.213.1"
 -- Left (FailP "bad length: found 3")
 --
--- >>> prtRefinedIO @(Map (ReadP Int) (Resplit "\\." Id) >> Guard (Printf "bad length: found %d" Len) (Len == 4) >> GuardsN (Printf2 "octet %d out of range %d") 4 (Between 0 255) >> 'True) ol "141.213.1.444"
+-- >>> prtRefinedIO @(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) >> 'True) oz "141.213.1.444"
 -- Left (FailP "octet 4 out of range 444")
 --
--- >>> prtRefinedIO @(Map (ReadP Int) (Resplit "\\." Id) >> Guard (Printf "bad length: found %d" Len) (Len == 4) >> GuardsN (Printf2 "octet %d out of range %d") 4 (Between 0 255) >> 'True) ol "141.213.1x34.444"
+-- >>> prtRefinedIO @(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) >> 'True) oz "141.213.1x34.444"
 -- Left (FailP "ReadP Int (1x34) failed")
 --
--- >>> prtRefinedIO @(Map ('[Id] >> ReadP Int) Id >> Luhn Id) ol "12344"
+-- >>> prtRefinedIO @(Map ('[Id] >> ReadP Int Id) Id >> Luhn Id) oz "12344"
 -- Right (Refined {unRefined = "12344"})
 --
--- >>> prtRefinedIO @(Map ('[Id] >> ReadP Int) Id >> Luhn Id) ol "12340"
+-- >>> prtRefinedIO @(Map ('[Id] >> ReadP Int Id) Id >> Luhn Id) oz "12340"
 -- Left FalseP
 --
--- >>> prtRefinedIO @(Any (Prime Id) Id) ol [11,13,17,18]
+-- >>> prtRefinedIO @(Any (Prime Id) Id) oz [11,13,17,18]
 -- Right (Refined {unRefined = [11,13,17,18]})
 --
--- >>> prtRefinedIO @(All (Prime Id) Id) ol [11,13,17,18]
+-- >>> prtRefinedIO @(All (Prime Id) Id) oz [11,13,17,18]
 -- Left FalseP
 --
--- >>> prtRefinedIO @(Snd Id !! Fst Id >> Len > 5) ol (2,["abc","defghij","xyzxyazsfd"])
+-- >>> prtRefinedIO @(Snd Id !! Fst Id >> Len > 5) oz (2,["abc","defghij","xyzxyazsfd"])
 -- Right (Refined {unRefined = (2,["abc","defghij","xyzxyazsfd"])})
 --
--- >>> prtRefinedIO @(Snd Id !! Fst Id >> Len > 5) ol (27,["abc","defghij","xyzxyazsfd"])
+-- >>> prtRefinedIO @(Snd Id !! Fst Id >> Len > 5) oz (27,["abc","defghij","xyzxyazsfd"])
 -- Left (FailP "(!!) index not found")
 --
--- >>> prtRefinedIO @(Snd Id !! Fst Id >> Len <= 5) ol (2,["abc","defghij","xyzxyazsfd"])
+-- >>> prtRefinedIO @(Snd Id !! Fst Id >> Len <= 5) oz (2,["abc","defghij","xyzxyazsfd"])
 -- Left FalseP
 newtype Refined p a = Refined { unRefined :: a } deriving (Show, Eq, Generic, TH.Lift)
 
@@ -145,7 +149,7 @@                              "unRefined"
                              (PCR.reset GR.readPrec)
                GR.expectP (RL.Punc "}")
-               let (_,mr) = runIdentity $ newRefined @p ol fld0
+               let (_,mr) = runIdentity $ newRefined @p oz fld0 -- since we cant display the error message ...
                case mr of
                  Nothing -> fail ""
                  Just _r -> pure (Refined fld0)
@@ -163,30 +167,25 @@ -- | 'FromJSON' instance for 'Refined'
 --
 -- >>> :set -XOverloadedStrings
--- >>> eitherDecode' @(Refined (Between 10 14) Int) "13"
+-- >>> import qualified Data.Aeson as A
+-- >>> A.eitherDecode' @(Refined (Between 10 14) Int) "13"
 -- Right (Refined {unRefined = 13})
 --
--- >>> removeAnsi $ eitherDecode' @(Refined (Between 10 14) Int) "16"
+-- >>> removeAnsi $ A.eitherDecode' @(Refined (Between 10 14) Int) "16"
 -- Error in $: Refined:FalseP
--- False True && False
+-- False 16 <= 14
 -- |
--- +- True  16 >= 10
--- |  |
--- |  +- P I
--- |  |
--- |  `- P '10
+-- +- P Id 16
 -- |
--- `- False 16 <= 14
---    |
---    +- P I
---    |
---    `- P '14
+-- +- P '10
+-- |
+-- `- P '14
 -- <BLANKLINE>
 --
 instance (RefinedC p a, FromJSON a) => FromJSON (Refined p a) where
   parseJSON z = do
                   a <- parseJSON z
-                  let ((bp,e),mr) = runIdentity $ newRefined @p o2 a
+                  let ((bp,(e,_top)),mr) = runIdentity $ newRefined @p o2 a
                   case mr of
                     Nothing -> fail $ "Refined:" ++ show bp ++ "\n" ++ e
                     Just r -> return r
@@ -196,10 +195,10 @@ -- >>> import Data.Time
 -- >>> import Control.Lens
 -- >>> import Control.Arrow ((+++))
--- >>> type K1 = Refined (ReadP Day >> 'True) String
--- >>> type K2 = Refined (ReadP Day >> Between (ReadP' Day "2019-03-30") (ReadP' Day "2019-06-01")) String
--- >>> type K3 = Refined (ReadP Day >> Between (ReadP' Day "2019-05-30") (ReadP' Day "2019-06-01")) String
--- >>> r = unsafeRefined' ol "2019-04-23" :: K1
+-- >>> type K1 = Refined (ReadP Day Id >> 'True) String
+-- >>> type K2 = Refined (ReadP Day Id >> Between (ReadP Day "2019-03-30") (ReadP Day "2019-06-01")) String
+-- >>> type K3 = Refined (ReadP Day Id >> Between (ReadP Day "2019-05-30") (ReadP Day "2019-06-01")) String
+-- >>> r = unsafeRefined' oz "2019-04-23" :: K1
 -- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K1 (B.encode r)
 -- Refined {unRefined = "2019-04-23"}
 --
@@ -208,35 +207,29 @@ --
 -- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K3 (B.encode r)
 -- Refined:FalseP
--- False >> False | 2019-04-23
+-- False (>>) False | {2019-05-30 <= 2019-04-23}
 -- |
 -- +- P ReadP Day (2019-04-23) 2019-04-23 | 2019-04-23
 -- |  |
 -- |  `- P Id "2019-04-23"
 -- |
--- `- False False && True
+-- `- False 2019-05-30 <= 2019-04-23
 --    |
---    +- False 2019-04-23 >= 2019-05-30
---    |  |
---    |  +- P I
+--    +- P Id 2019-04-23
+--    |
+--    +- P ReadP Day (2019-05-30) 2019-05-30 | 2019-05-30
 --    |  |
---    |  `- P ReadP Day (2019-05-30) 2019-05-30 | 2019-05-30
---    |     |
---    |     `- P '2019-05-30
+--    |  `- P '2019-05-30
 --    |
---    `- True  2019-04-23 <= 2019-06-01
---       |
---       +- P I
+--    `- P ReadP Day (2019-06-01) 2019-06-01 | 2019-06-01
 --       |
---       `- P ReadP Day (2019-06-01) 2019-06-01 | 2019-06-01
---          |
---          `- P '2019-06-01
+--       `- P '2019-06-01
 -- <BLANKLINE>
 --
 instance (RefinedC p a, Binary a) => Binary (Refined p a) where
   get = do
           fld0 <- B.get @a
-          let ((bp,e),mr) = runIdentity $ newRefined @p o2 fld0
+          let ((bp,(e,_top)),mr) = runIdentity $ newRefined @p o2 fld0
           case mr of
             Nothing -> fail $ "Refined:" ++ show bp ++ "\n" ++ e
             Just r -> return r
@@ -321,7 +314,10 @@ prtRefinedIO opts a = do
   tt <- evalBool (Proxy @p) opts a
   let msg = (_tBool tt ^. boolT2P, prtTreePure opts (fromTT tt))
-  unless (oLite opts) $ putStrLn $ snd msg
+  case oDebug opts of
+     OZero -> pure ()  -- putStrLn $ showBoolP opts (fst msg) <> " " <> topMessage tt
+     OLite -> putStrLn $ showBoolP opts (fst msg) <> " " <> topMessage tt
+     _ -> putStrLn $ snd msg
   pure $ case getValueLR opts "" tt [] of
     Right True -> Right (Refined a)
     _ -> Left (fst msg)
@@ -330,11 +326,15 @@ newRefined :: forall p a m . (MonadEval m, RefinedC p a)
    => POpts
    -> a
-   -> m ((BoolP, String), Maybe (Refined p a))
+   -> m ((BoolP, (String, String)), Maybe (Refined p a))
 newRefined opts a = do
   tt <- evalBool (Proxy @p) opts a
-  let msg = (_tBool tt ^. boolT2P, prtTreePure opts (fromTT tt))
-  pure $ (msg,) $ case getValueLR opts "" tt [] of
+  let rc = _tBool tt ^. boolT2P
+      ss = case oDebug opts of
+             OZero -> ("","")
+             OLite -> ("",topMessage tt)
+             _ -> (prtTreePure opts (fromTT tt),topMessage tt)
+  pure $ ((rc,ss),) $ case getValueLR opts "" tt [] of
        Right True -> Just (Refined a)
        _ -> Nothing
 
@@ -387,9 +387,6 @@ 
 unRavelTIO :: RefinedT IO a -> IO (Either String a, [String])
 unRavelTIO = runWriterT . runExceptT . unRefinedT
-
-unRavelTI :: RefinedT Identity a -> (Either String a, [String])
-unRavelTI = runIdentity . runWriterT . runExceptT . unRefinedT
 
 prtRefinedTImpl :: forall n m a . (MonadIO n, Show a) => (forall x . m x -> n x) -> RefinedT m a -> n ()
 prtRefinedTImpl f rt = do
src/Predicate/Refined3.hs view
@@ -30,7 +30,6 @@   -- ** Refined3
     Refined3(r3In,r3Out)
   , Refined3C
-  , RefinedEmulate
 
  -- ** display results
   , prtEval3P
@@ -43,22 +42,16 @@   , Results (..)
   , RResults (..)
 
-  -- ** evaluation methods
-  , eval3P
-  , eval3
-  , eval3M
-  , eval3PX
-  , eval3X
-
   -- ** proxy methods
   , mkProxy3
   , mkProxy3'
-  , mkProxy3P
-  , mkProxy3P'
-  , MkProxy3T
   , MakeR3
 
-  -- ** create or combine Refined3 values
+  -- ** evaluation methods
+  , eval3P
+  , eval3
+
+  -- ** create a wrapped Refined3 value
   , withRefined3TIO
   , withRefined3T
   , withRefined3TP
@@ -76,6 +69,12 @@   -- ** unsafe methods for creating Refined3
   , unsafeRefined3
   , unsafeRefined3'
+
+  -- ** emulate Refined3 using Refined
+  , RefinedEmulate
+  , eval3PX
+  , eval3X
+
  ) where
 import Predicate.Refined
 import Predicate.Core
@@ -85,7 +84,7 @@ import Data.Proxy
 import Control.Monad.Except
 import Control.Monad.Writer (tell)
-import Data.Aeson
+import Data.Aeson (ToJSON(..), FromJSON(..))
 import qualified Language.Haskell.TH.Syntax as TH
 import System.Console.Pretty
 import Test.QuickCheck
@@ -95,6 +94,9 @@ import qualified Data.Binary as B
 import Data.Binary (Binary)
 import Data.Maybe (fromMaybe)
+import Control.Lens ((^?),ix)
+import Data.Tree.Lens (root)
+import Data.Char (isSpace)
 
 -- $setup
 -- >>> :set -XDataKinds
@@ -116,39 +118,45 @@ --
 -- Setting the input type __i__ to 'GHC.Base.String' resembles the corresponding Read/Show instances but with an additional predicate on the read value
 --
---   * __read__ a string into an internal type and store in 'r3In'
---   * __validate__ 'r3In' using the predicate __op__
---   * __show__ 'r3In' and store that formatted result in 'r3Out'
+--   * __read__ a string using /ip/ into an internal type and store in 'r3In'
+--   * __validate__ 'r3In' using the predicate /op/
+--   * __show__ 'r3In' using /fmt/ and store that formatted result in 'r3Out'
 --
--- Although the most common scenario is String as input, you are free to choose any input type you like
+-- Although a common scenario is String as input, you are free to choose any input type you like
 --
--- >>> prtEval3 @(ReadBase Int 16) @(Lt 255) @(Printf "%x" Id) ol "00fe"
+-- >>> prtEval3 @(ReadBase Int 16 Id) @(Lt 255) @(PrintF "%x" Id) oz "00fe"
 -- Right (Refined3 {r3In = 254, r3Out = "fe"})
 --
--- >>> prtEval3 @(ReadBase Int 16) @(Lt 253) @(Printf "%x" Id) ol "00fe"
+-- >>> prtEval3 @(ReadBase Int 16 Id) @(Lt 253) @(PrintF "%x" Id) oz "00fe"
 -- Left Step 2. False Boolean Check(op) | FalseP
 --
--- >>> prtEval3 @(ReadBase Int 16) @(Lt 255) @(Printf "%x" Id) ol "00fg"
+-- >>> prtEval3 @(ReadBase Int 16 Id) @(Lt 255) @(PrintF "%x" Id) oz "00fg"
 -- Left Step 1. Initial Conversion(ip) Failed | invalid base 16
 --
--- >>> prtEval3 @(Map (ReadP Int) (Resplit "\\." Id)) @(Guard (Printf "found length=%d" Len) (Len >> Id == 4) >> 'True) @(Printfnt 4 "%03d.%03d.%03d.%03d") ol "198.162.3.1.5"
+-- >>> prtEval3 @(Map (ReadP Int Id) (Resplit "\\." Id)) @(Msg "length invalid:" (Len == 4)) @(PrintL 4 "%03d.%03d.%03d.%03d" Id) ol "198.162.3.1.5"
+-- Left Step 2. False Boolean Check(op) | {length invalid:5 == 4}
+--
+-- >>> prtEval3 @(Map (ReadP Int Id) (Resplit "\\." Id)) @(Guard (PrintF "found length=%d" Len) (Len == 4) >> 'True) @(PrintL 4 "%03d.%03d.%03d.%03d" Id) oz "198.162.3.1.5"
 -- Left Step 2. Failed Boolean Check(op) | found length=5
 --
--- >>> prtEval3 @(Map (ReadP Int) (Resplit "\\." Id)) @(Guard (Printf "found length=%d" Len) (Len >> Id == 4) >> 'True) @(Printfnt 4 "%03d.%03d.%03d.%03d") ol "198.162.3.1"
+-- >>> prtEval3 @(Map (ReadP Int Id) (Resplit "\\." Id)) @(Guard (PrintF "found length=%d" Len) (Len == 4) >> 'True) @(PrintL 4 "%03d.%03d.%03d.%03d" Id) oz "198.162.3.1"
 -- Right (Refined3 {r3In = [198,162,3,1], r3Out = "198.162.003.001"})
 --
 -- >>> :m + Data.Time.Calendar.WeekDate
--- >>> prtEval3 @(MkDay >> 'Just Id) @(Guard "expected a Sunday" (Thd Id == 7) >> 'True) @(UnMkDay (Fst Id)) ol (2019,10,13)
+-- >>> prtEval3 @(MkDay >> 'Just Id) @(Guard "expected a Sunday" (Thd Id == 7) >> 'True) @(UnMkDay (Fst Id)) oz (2019,10,13)
 -- Right (Refined3 {r3In = (2019-10-13,41,7), r3Out = (2019,10,13)})
 --
--- >>> prtEval3 @(MkDay' (Fst Id) (Snd Id) (Thd Id) >> 'Just Id) @(Guard "expected a Sunday" (Thd Id == 7) >> 'True) @(UnMkDay (Fst Id)) ol (2019,10,12)
+-- >>> prtEval3 @(MkDay >> 'Just Id) @(Msg "expected a Sunday:" (Thd Id == 7)) @(UnMkDay (Fst Id)) ol (2019,10,12)
+-- Left Step 2. False Boolean Check(op) | {expected a Sunday:6 == 7}
+--
+-- >>> prtEval3 @(MkDay' (Fst Id) (Snd Id) (Thd Id) >> 'Just Id) @(Guard "expected a Sunday" (Thd Id == 7) >> 'True) @(UnMkDay (Fst Id)) oz (2019,10,12)
 -- Left Step 2. Failed Boolean Check(op) | expected a Sunday
 --
 -- >>> type T4 k = '(MkDay >> 'Just Id, Guard "expected a Sunday" (Thd Id == 7) >> 'True, UnMkDay (Fst Id), k)
--- >>> prtEval3P (Proxy @(T4 _)) ol (2019,10,12)
+-- >>> prtEval3P (Proxy @(T4 _)) oz (2019,10,12)
 -- Left Step 2. Failed Boolean Check(op) | expected a Sunday
 --
--- >>> prtEval3P (Proxy @(T4 _)) ol (2019,10,13)
+-- >>> prtEval3P (Proxy @(T4 _)) oz (2019,10,13)
 -- Right (Refined3 {r3In = (2019-10-13,41,7), r3Out = (2019,10,13)})
 --
 data Refined3 ip op fmt i = Refined3 { r3In :: PP ip i, r3Out :: PP fmt (PP ip i) }
@@ -184,16 +192,16 @@ -- read instance from -ddump-deriv
 -- | 'Read' instance for 'Refined3'
 --
--- >>> reads @(Refined3 (ReadBase Int 16) (Between 0 255) (ShowBase 16) String) "Refined3 {r3In = 254, r3Out = \"fe\"}"
+-- >>> reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255) (ShowBase 16 Id) String) "Refined3 {r3In = 254, r3Out = \"fe\"}"
 -- [(Refined3 {r3In = 254, r3Out = "fe"},"")]
 --
--- >>> reads @(Refined3 (ReadBase Int 16) (Between 0 255) (ShowBase 16) String) "Refined3 {r3In = 300, r3Out = \"12c\"}"
+-- >>> reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255) (ShowBase 16 Id) String) "Refined3 {r3In = 300, r3Out = \"12c\"}"
 -- []
 --
--- >>> reads @(Refined3 (ReadBase Int 16) (Id < 0) (ShowBase 16) String) "Refined3 {r3In = -1234, r3Out = \"-4d2\"}"
+-- >>> reads @(Refined3 (ReadBase Int 16 Id) (Id < 0) (ShowBase 16 Id) String) "Refined3 {r3In = -1234, r3Out = \"-4d2\"}"
 -- [(Refined3 {r3In = -1234, r3Out = "-4d2"},"")]
 --
--- >>> reads @(Refined3 (Map (ReadP Int) (Resplit "\\." Id)) (Guard "len/=4" (Len == 4) >> 'True) (Printfnt 4 "%d.%d.%d.%d") String) "Refined3 {r3In = [192,168,0,1], r3Out = \"192.168.0.1\"}"
+-- >>> reads @(Refined3 (Map (ReadP Int Id) (Resplit "\\." Id)) (Guard "len/=4" (Len == 4) >> 'True) (PrintL 4 "%d.%d.%d.%d" Id) String) "Refined3 {r3In = [192,168,0,1], r3Out = \"192.168.0.1\"}"
 -- [(Refined3 {r3In = [192,168,0,1], r3Out = "192.168.0.1"},"")]
 --
 instance ( Eq i
@@ -216,21 +224,23 @@                                "r3Out" (PCR.reset GR.readPrec)
                  GR.expectP (RL.Punc "}")
 
-                 let (_ret,mr) = runIdentity $ eval3MSkip @_ @ip @op @fmt o2 fld1
+                 let (_ret,mr) = runIdentity $ eval3MSkip @_ @ip @op @fmt oz fld1
                  case mr of
-                   Nothing -> fail "" --   show (prt3Impl o2 _ret)
-                   Just (Refined3 _r1 r2) | r2 == fld2 -> pure (Refined3 fld1 fld2)
-                                         | otherwise -> fail "" -- "mismatch on r3Out fmt: found (" ++ show fld2 ++ ") but expected(" ++ show r2 ++ ")"
+                   Nothing -> fail ""
+                   Just (Refined3 _r1 r2)
+                     | r2 == fld2 -> pure (Refined3 fld1 fld2)
+                     | otherwise -> fail "" -- cant display a decent error message
              ))
     readList = GR.readListDefault
     readListPrec = GR.readListPrecDefault
 
 -- | 'ToJSON' instance for 'Refined3'
 --
--- >>> encode (unsafeRefined3 @(ReadBase Int 16) @(Between 0 255) @(ShowBase 16) 254 "fe")
+-- >>> import qualified Data.Aeson as A
+-- >>> A.encode (unsafeRefined3 @(ReadBase Int 16 Id) @(Between 0 255) @(ShowBase 16 Id) 254 "fe")
 -- "\"fe\""
 --
--- >>> encode (unsafeRefined3 @Id @'True @Id 123 123)
+-- >>> A.encode (unsafeRefined3 @Id @'True @Id 123 123)
 -- "123"
 --
 instance ToJSON (PP fmt (PP ip i)) => ToJSON (Refined3 ip op fmt i) where
@@ -239,11 +249,12 @@ 
 -- | 'FromJSON' instance for 'Refined3'
 --
--- >>> eitherDecode' @(Refined3 (ReadBase Int 16) (Id > 10 && Id < 256) (ShowBase 16) String) "\"00fe\""
+-- >>> import qualified Data.Aeson as A
+-- >>> A.eitherDecode' @(Refined3 (ReadBase Int 16 Id) (Id > 10 && Id < 256) (ShowBase 16 Id) String) "\"00fe\""
 -- Right (Refined3 {r3In = 254, r3Out = "fe"})
 --
--- >>> removeAnsi $ eitherDecode' @(Refined3 (ReadBase Int 16) (Id > 10 && Id < 256) (ShowBase 16) String) "\"00fe443a\""
--- Error in $: Refined3:Step 2. False Boolean Check(op) | FalseP
+-- >>> removeAnsi $ A.eitherDecode' @(Refined3 (ReadBase Int 16 Id) (Id > 10 && Id < 256) (ShowBase 16 Id) String) "\"00fe443a\""
+-- Error in $: Refined3:Step 2. False Boolean Check(op) | {True && False | (16663610 < 256)}
 -- <BLANKLINE>
 -- *** Step 1. Success Initial Conversion(ip) [16663610] ***
 -- <BLANKLINE>
@@ -253,7 +264,7 @@ -- <BLANKLINE>
 -- *** Step 2. False Boolean Check(op) ***
 -- <BLANKLINE>
--- False True && False
+-- False True && False | (16663610 < 256)
 -- |
 -- +- True  16663610 > 10
 -- |  |
@@ -286,15 +297,14 @@         , Show i
         , Refined3C ip op fmt i
         ) => Arbitrary (Refined3 ip op fmt i) where
-  arbitrary = suchThatMap (arbitrary @(PP ip i)) $ eval3MQuickIdentity @ip @op @fmt o2
+  arbitrary = suchThatMap (arbitrary @(PP ip i)) $ eval3MQuickIdentity @ip @op @fmt
 -}
 arbRefined3 :: forall ip op fmt i .
    ( Arbitrary (PP ip i)
    , Refined3C ip op fmt i
    ) => Proxy '(ip,op,fmt,i)
-     -> POpts
      -> Gen (Refined3 ip op fmt i)
-arbRefined3 _ = suchThatMap (arbitrary @(PP ip i)) . eval3MQuickIdentity @ip @op @fmt
+arbRefined3 _ = suchThatMap (arbitrary @(PP ip i)) $ eval3MQuickIdentity @ip @op @fmt
 
 -- help things along a little
 arbRefined3With ::
@@ -302,21 +312,20 @@   . (Arbitrary (PP ip i)
    , Refined3C ip op fmt i)
   => Proxy '(ip,op,fmt,i)
-  -> POpts
   -> (PP ip i -> PP ip i)
   -> Gen (Refined3 ip op fmt i)
-arbRefined3With _ opts f =
-  suchThatMap (f <$> arbitrary @(PP ip i)) $ eval3MQuickIdentity @ip @op @fmt opts
+arbRefined3With _ f =
+  suchThatMap (f <$> arbitrary @(PP ip i)) $ eval3MQuickIdentity @ip @op @fmt
 
 -- | 'Binary' instance for 'Refined3'
 --
 -- >>> import Control.Arrow ((+++))
 -- >>> import Control.Lens
 -- >>> import Data.Time
--- >>> type K1 = MakeR3 '(ReadP Day, 'True, ShowP Id, String)
--- >>> type K2 = MakeR3 '(ReadP Day, Between (ReadP' Day "2019-03-30") (ReadP' Day "2019-06-01"), ShowP Id, String)
--- >>> type K3 = MakeR3 '(ReadP Day, Between (ReadP' Day "2019-05-30") (ReadP' Day "2019-06-01"), ShowP Id, String)
--- >>> r = unsafeRefined3' ol "2019-04-23" :: K1
+-- >>> type K1 = MakeR3 '(ReadP Day Id, 'True, ShowP Id, String)
+-- >>> type K2 = MakeR3 '(ReadP Day Id, Between (ReadP Day "2019-03-30") (ReadP Day "2019-06-01"), ShowP Id, String)
+-- >>> type K3 = MakeR3 '(ReadP Day Id, Between (ReadP Day "2019-05-30") (ReadP Day "2019-06-01"), ShowP Id, String)
+-- >>> r = unsafeRefined3' oz "2019-04-23" :: K1
 -- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K1 (B.encode r)
 -- Refined3 {r3In = 2019-04-23, r3Out = "2019-04-23"}
 --
@@ -324,7 +333,7 @@ -- Refined3 {r3In = 2019-04-23, r3Out = "2019-04-23"}
 --
 -- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K3 (B.encode r)
--- Refined3:Step 2. False Boolean Check(op) | FalseP
+-- Refined3:Step 2. False Boolean Check(op) | {2019-05-30 <= 2019-04-23}
 -- <BLANKLINE>
 -- *** Step 1. Success Initial Conversion(ip) [2019-04-23] ***
 -- <BLANKLINE>
@@ -334,23 +343,17 @@ -- <BLANKLINE>
 -- *** Step 2. False Boolean Check(op) ***
 -- <BLANKLINE>
--- False False && True
+-- False 2019-05-30 <= 2019-04-23
 -- |
--- +- False 2019-04-23 >= 2019-05-30
--- |  |
--- |  +- P I
+-- +- P Id 2019-04-23
+-- |
+-- +- P ReadP Day (2019-05-30) 2019-05-30 | 2019-05-30
 -- |  |
--- |  `- P ReadP Day (2019-05-30) 2019-05-30 | 2019-05-30
--- |     |
--- |     `- P '2019-05-30
+-- |  `- P '2019-05-30
 -- |
--- `- True  2019-04-23 <= 2019-06-01
---    |
---    +- P I
+-- `- P ReadP Day (2019-06-01) 2019-06-01 | 2019-06-01
 --    |
---    `- P ReadP Day (2019-06-01) 2019-06-01 | 2019-06-01
---       |
---       `- P '2019-06-01
+--    `- P '2019-06-01
 -- <BLANKLINE>
 --
 instance ( Show (PP fmt (PP ip i))
@@ -366,34 +369,33 @@             Just r -> return r
   put (Refined3 _ r) = B.put @i r
 
--- | wraps the parameters for 'Refined3' in a 4-tuple
+-- | creates a 4-tuple proxy (see 'withRefined3TP' 'newRefined3TP' 'eval3P' 'prtEval3P')
 --
--- useful for methods such as 'withRefined3TP' and 'newRefined3TP'
-mkProxy3 :: forall ip op fmt i . Proxy '(ip,op,fmt,i)
+-- use type application to set the 4-tuple or skip that and set the individual parameters directly
+--
+-- set the 4-tuple directly
+--
+-- >>> eg1 = mkProxy3 @'(ReadP Int Id, Gt 10, ShowP Id, String)
+-- >>> prtEval3P eg1 ol "24"
+-- Right (Refined3 {r3In = 24, r3Out = "24"})
+--
+-- skip the 4-tuple and set each parameter individually using type application
+--
+-- >>> eg2 = mkProxy3 @_ @(ReadP Int Id) @(Gt 10) @(ShowP Id)
+-- >>> prtEval3P eg2 ol "24"
+-- Right (Refined3 {r3In = 24, r3Out = "24"})
+--
+mkProxy3 :: forall z ip op fmt i . z ~ '(ip,op,fmt,i) => Proxy '(ip,op,fmt,i)
 mkProxy3 = Proxy
 
--- | same as 'mkProxy3' but checks to make sure the proxy is consistent with the Refined3C constraint
-mkProxy3' :: forall ip op fmt i . Refined3C ip op fmt i => Proxy '(ip,op,fmt,i)
+-- | same as 'mkProxy3' but checks to make sure the proxy is consistent with the 'Refined3C' constraint
+mkProxy3' :: forall z ip op fmt i . (z ~ '(ip,op,fmt,i), Refined3C ip op fmt i) => Proxy '(ip,op,fmt,i)
 mkProxy3' = Proxy
 
--- | use type application to set the parameters which then will be wrapped into a 4-tuple
---
--- useful for passing into 'eval3P' / 'prtEval3P'
-mkProxy3P :: forall z ip op fmt i . z ~ '(ip,op,fmt,i) => Proxy '(ip,op,fmt,i)
-mkProxy3P = Proxy
-
--- | same as 'mkProxy3P' but checks to make sure the proxy is consistent with the Refined3C constraint
-mkProxy3P' :: forall z ip op fmt i . (z ~ '(ip,op,fmt,i), Refined3C ip op fmt i) => Proxy '(ip,op,fmt,i)
-mkProxy3P' = Proxy
-
 -- | convenience type family for converting from a 4-tuple '(ip,op,fmt,i) to a 'Refined3' signature
 type family MakeR3 p where
   MakeR3 '(ip,op,fmt,i) = Refined3 ip op fmt i
 
--- | convenience type family for converting from a 4-tuple '(ip,op,fmt,i) to a Proxy
-type family MkProxy3T p where
-  MkProxy3T '(ip,op,fmt,i) = Proxy '(ip,op,fmt,i)
-
 withRefined3TIO :: forall ip op fmt i m b
   . (MonadIO m, Refined3C ip op fmt i, Show (PP ip i), Show i)
   => POpts
@@ -408,15 +410,14 @@ -- reads a binary string and adds the values together
 --
 -- >>> :set -XPolyKinds
--- >>> type Base n p = '(ReadBase Int n, p, ShowBase 16, String)
--- >>> base16 = Proxy @(Base 16 (Between 100 200))
--- >>> base2 = Proxy @(Base 2 'True)
--- >>> prtRefinedTIO $ withRefined3TP base16 ol "a3" $ \x -> withRefined3TP base2 ol "1001110111" $ \y -> pure (r3In x + r3In y)
+-- >>> b16 = Proxy @'(ReadBase Int 16 Id, Between 100 200, ShowBase 16 Id, String)
+-- >>> b2 = Proxy @'(ReadBase Int 2 Id, 'True, ShowBase 2 Id, String)
+-- >>> prtRefinedTIO $ withRefined3TP b16 oz "a3" $ \x -> withRefined3TP b2 oz "1001110111" $ \y -> pure (r3In x + r3In y)
 -- 794
 --
 -- this example fails as the the hex value is out of range
 --
--- >>> prtRefinedTIO $ withRefined3TP base16 o0 "a388" $ \x -> withRefined3TP base2 o0 "1001110111" $ \y -> pure (x,y)
+-- >>> prtRefinedTIO $ withRefined3TP b16 o0 "a388" $ \x -> withRefined3TP b2 o0 "1001110111" $ \y -> pure (x,y)
 -- <BLANKLINE>
 -- *** Step 1. Success Initial Conversion(ip) [41864] ***
 -- <BLANKLINE>
@@ -426,21 +427,15 @@ -- <BLANKLINE>
 -- *** Step 2. False Boolean Check(op) ***
 -- <BLANKLINE>
--- False True && False
+-- False 41864 <= 200
 -- |
--- +- True  41864 >= 100
--- |  |
--- |  +- P I
--- |  |
--- |  `- P '100
+-- +- P Id 41864
 -- |
--- `- False 41864 <= 200
---    |
---    +- P I
---    |
---    `- P '200
+-- +- P '100
+-- |
+-- `- P '200
 -- <BLANKLINE>
--- failure msg[Step 2. False Boolean Check(op) | FalseP]
+-- failure msg[Step 2. False Boolean Check(op) | {41864 <= 200}]
 --
 withRefined3T :: forall ip op fmt i m b
   . (Monad m, Refined3C ip op fmt i, Show (PP ip i), Show i)
@@ -467,9 +462,15 @@ 
 -- | create a wrapped 'Refined3' type
 --
--- >>> prtRefinedTIO $ newRefined3TP (Proxy @'(MkDay >> JustFail "asfd" Id, GuardSimple (Thd Id == 5) >> 'True, UnMkDay (Fst Id), (Int,Int,Int))) ol (2019,11,1)
+-- >>> prtRefinedTIO $ newRefined3TP (Proxy @'(MkDay >> Just Id, GuardSimple (Thd Id == 5) >> 'True, UnMkDay (Fst Id), (Int,Int,Int))) oz (2019,11,1)
 -- Refined3 {r3In = (2019-11-01,44,5), r3Out = (2019,11,1)}
 --
+-- >>> prtRefinedTIO $ newRefined3TP (Proxy @'(MkDay >> Just Id, Thd Id == 5, UnMkDay (Fst Id), (Int,Int,Int))) ol (2019,11,2)
+-- failure msg[Step 2. False Boolean Check(op) | {6 == 5}]
+--
+-- >>> prtRefinedTIO $ newRefined3TP (Proxy @'(MkDay >> Just Id, Msg "wrong day:" (Thd Id == 5), UnMkDay (Fst Id), (Int,Int,Int))) ol (2019,11,2)
+-- failure msg[Step 2. False Boolean Check(op) | {wrong day:6 == 5}]
+--
 newRefined3TP :: forall m ip op fmt i proxy
    . (Refined3C ip op fmt i, Monad m, Show (PP ip i), Show i)
   => proxy '(ip,op,fmt,i)
@@ -489,9 +490,6 @@   -> RefinedT m (Refined3 ip op fmt i)
 newRefined3TPIO = newRefined3TPImpl liftIO
 
--- we call this cos we need to do the bool check and get fmt value
--- eval (PP op i) ~ True and eval (PP fmt i) to get the other value
--- input is set to @Id meaning that PP fmt (PP ip i) /= i doesnt hold
 newRefined3TPImpl :: forall n m ip op fmt i proxy
    . (Refined3C ip op fmt i
     , Monad m
@@ -561,7 +559,6 @@   -> RefinedT m (Refined3 ip op fmt i)
 rapply3 = rapply3P (Proxy @'(ip,op,fmt,i))
 
--- this is the most generic
 -- prtRefinedT $ rapply3P base16 (+) (newRefined3TP Proxy "ff") (newRefined3TP Proxy "22")
 
 -- | same as 'rapply3' but uses a 4-tuple proxy instead
@@ -594,6 +591,7 @@      | XTTrueT a b      -- Right a + Right True + Right b
      deriving (Show,Eq)
 
+-- | An ADT that summarises the results of evaluating Refined3 representing all possible states
 data RResults a b =
        RF String (Tree PE)        -- Left e
      | RTF a (Tree PE) String (Tree PE)    -- Right a + Left e
@@ -602,6 +600,7 @@      | RTTrueT a (Tree PE) (Tree PE) b (Tree PE)      -- Right a + Right True + Right b
      deriving Show
 
+-- | same as 'prtEval3P' but runs in IO
 prtEval3PIO :: forall ip op fmt i proxy
   . ( Refined3C ip op fmt i
     , Show (PP ip i)
@@ -614,6 +613,7 @@   x <- eval3M opts i
   prt3IO opts x
 
+-- | same as 'prtEval3P' but skips the proxy and allows you to set each parameter individually using type application
 prtEval3 :: forall ip op fmt i
   . ( Refined3C ip op fmt i
     , Show (PP ip i)
@@ -621,10 +621,9 @@   => POpts
   -> i
   -> Either Msg3 (Refined3 ip op fmt i)
-prtEval3 opts i =
-  let x = eval3 opts i
-  in prt3 opts x
+prtEval3 = prtEval3P Proxy
 
+-- | create a Refined3 using a 4-tuple proxy and aggregate the results on failure
 prtEval3P :: forall ip op fmt i proxy
   . ( Refined3C ip op fmt i
     , Show (PP ip i)
@@ -633,15 +632,12 @@   -> POpts
   -> i
   -> Either Msg3 (Refined3 ip op fmt i)
-prtEval3P _ opts i =
-  let x = eval3 opts i
-  in prt3 opts x
-
+prtEval3P _ opts = prt3 opts . eval3 opts
 
--- pass in a proxy (use mkProxy to package all the types together as a 4-tuple)
--- ip converts input 'i' to format used for op and fmt
--- op is a boolean predicate [has to be True to continue] (uses P ip i as input)
--- fmt formats the output (can be anything ie not just String) (uses P ip i as input)
+-- | create a Refined3 value using a 4-tuple proxy (see 'mkProxy3')
+--
+-- use 'mkProxy3' to package all the types together as a 4-tuple
+--
 eval3P :: forall ip op fmt i proxy . Refined3C ip op fmt i
   => proxy '(ip,op,fmt,i)
   -> POpts
@@ -649,13 +645,12 @@   -> (RResults (PP ip i) (PP fmt (PP ip i)), Maybe (Refined3 ip op fmt i))
 eval3P _ opts = runIdentity . eval3M opts
 
--- same as eval3P but can just pass in ip op fmt separately
--- with eval3P we have to specify 'i' but in eval3 we dont cos gets it from context
+-- | same as 'eval3P' but can pass the parameters individually using type application
 eval3 :: forall ip op fmt i . Refined3C ip op fmt i
   => POpts
   -> i
   -> (RResults (PP ip i) (PP fmt (PP ip i)), Maybe (Refined3 ip op fmt i))
-eval3 opts = runIdentity . eval3M opts
+eval3 = eval3P Proxy
 
 eval3M :: forall m ip op fmt i . (MonadEval m, Refined3C ip op fmt i)
   => POpts
@@ -676,7 +671,7 @@               Left e -> pure (RTF a t1 e t2, Nothing)
        Left e -> pure (RF e t1, Nothing)
 
--- skip ip conversion: ie uses internal value
+-- | creates Refined3 value but skips the initial conversion
 eval3MSkip :: forall m ip op fmt i . (MonadEval m, Refined3C ip op fmt i)
    => POpts
    -> PP ip i
@@ -692,19 +687,18 @@         Right False -> pure (RTFalse a mkNodeSkipP t2, Nothing)
         Left e -> pure (RTF a mkNodeSkipP e t2, Nothing)
 
--- calculates from internal value
+-- | calculates from internal value
 eval3MQuickIdentity :: forall ip op fmt i . Refined3C ip op fmt i
-   => POpts
-   -> PP ip i
+   => PP ip i
    -> Maybe (Refined3 ip op fmt i)
-eval3MQuickIdentity opts = runIdentity . eval3MQuick opts
+eval3MQuickIdentity = runIdentity . eval3MQuick
 
 -- from PP ip i
 eval3MQuick :: forall m ip op fmt i . (MonadEval m, Refined3C ip op fmt i)
-   => POpts
-   -> PP ip i
+   => PP ip i
    -> m (Maybe (Refined3 ip op fmt i))
-eval3MQuick opts a = do
+eval3MQuick a = do
+  let opts = oz
   rr <- evalBool (Proxy @op) opts a
   case getValLR (_tBool rr) of
     Right True -> do
@@ -717,7 +711,7 @@ prt3IO :: (Show a, Show b) => POpts -> (RResults a b, Maybe r) -> IO (Either String r)
 prt3IO opts (ret,mr) = do
   let m3 = prt3Impl opts ret
-  unless (oLite opts) $ putStrLn $ m3Long m3
+  unless (hasNoTree opts) $ putStrLn $ m3Long m3
   return $ maybe (Left (m3Desc m3 <> " | " <> m3Short m3)) Right mr
 
 prt3 :: (Show a, Show b) => POpts -> (RResults a b, Maybe r) -> Either Msg3 r
@@ -734,7 +728,7 @@ prt3Impl opts v =
   let outmsg msg = "\n*** " <> msg <> " ***\n\n"
       msg1 a = outmsg ("Step 1. Success Initial Conversion(ip) [" ++ show a ++ "]")
-      mkMsg3 m n r | oLite opts = Msg3 m n ""
+      mkMsg3 m n r | hasNoTree opts = Msg3 m n ""
                    | otherwise = Msg3 m n r
   in case v of
        RF e t1 ->
@@ -750,7 +744,10 @@               <> prtTreePure opts t2
          in mkMsg3 m n r
        RTFalse a t1 t2 ->
-         let (m,n) = ("Step 2. False Boolean Check(op)", "FalseP")
+         let (m,n) = ("Step 2. False Boolean Check(op)", z)
+             z = case t2 ^? root . pStrings . ix 0 of
+                   Just w -> if null (dropWhile isSpace w) then "FalseP" else "{" <> w <> "}"
+                   Nothing -> "FalseP"
              r = msg1 a
               <> fixLite opts a t1
               <> outmsg m
@@ -775,27 +772,22 @@               <> fixLite opts b t3
          in mkMsg3 m n r
 
-
--- | emulates 'Refined3' but uses 'Refined.Refined'
--- reuses the mkProxy3 but returns Refined vs Refined3
--- using plain Refined to emulate Refined3 sort of
--- we just output fmt instead of embedding it in Refined3
--- so \'ip\' predicate gets us started: we store that \'PP ip i\' in Refined
--- then we run the boolean predicate \'op\' which is successful if true
--- then we run \'fmt\' against '\PP ip i\' and output both the Refined (PP p i) and the PP fmt (PP (ip i)) ie \'fmt\' run against PP ip i
---       if any of the three steps fails the process stops immediately and dumps out RResults
+-- | similar to 'eval3P' but it emulates 'Refined3' but using 'Refined'
+--
+-- takes a 4-tuple proxy as input but outputs the Refined value and the result separately
+--
+-- * initial conversion using \'ip\' and stores that in 'Refined'
+-- * runs the boolean predicate \'op\' to make sure to validate the converted value from 1.
+-- * runs \'fmt\' against the converted value from 1.
+-- * returns both the 'Refined' and the output from 3.
+-- * if any of the above steps fail the process stops it and dumps out 'RResults'
+--
 eval3PX :: forall ip op fmt i proxy . Refined3C ip op fmt i
   => proxy '(ip,op,fmt,i)
   -> POpts
   -> i
   -> (RResults (PP ip i) (PP fmt (PP ip i)), Maybe (Refined op (PP ip i), PP fmt (PP ip i)))
-eval3PX _ = eval3X @ip @op @fmt
-
-eval3X :: forall ip op fmt i . Refined3C ip op fmt i
-  => POpts
-  -> i
-  -> (RResults (PP ip i) (PP fmt (PP ip i)), Maybe (Refined op (PP ip i), PP fmt (PP ip i)))
-eval3X opts i = runIdentity $ do
+eval3PX _ opts i = runIdentity $ do
   ll@(fromTT -> t1) <- eval (Proxy @ip) opts i
   case getValLR (_tBool ll) of
        Right a -> do
@@ -810,5 +802,12 @@               Left e -> pure (RTF a t1 e t2, Nothing)
        Left e -> pure (RF e t1, Nothing)
 
--- | emulates 'Refined.Refined' using 'Refined3' ie the input conversion and output formatting are noops
+-- | same as 'eval3PX' but allows you to set the parameters individually using type application
+eval3X :: forall ip op fmt i . Refined3C ip op fmt i
+  => POpts
+  -> i
+  -> (RResults (PP ip i) (PP fmt (PP ip i)), Maybe (Refined op (PP ip i), PP fmt (PP ip i)))
+eval3X = eval3PX (Proxy @'(ip,op,fmt,i))
+
+-- | emulates 'Refined' using 'Refined3' by setting the input conversion and output formatting as noops
 type RefinedEmulate p a = Refined3 Id p Id a
src/Predicate/Refined3Helper.hs view
@@ -23,23 +23,31 @@   -- ** date time checkers
     datetime1
   , DateTime1
+
+  , datetime1'
+  , DateTime1'
+
+  , daten
+  , DateN
+  , datetimen
+  , DateTimeN
+  , DateTimeNR
+  , DateFmts
+  , DateTimeFmts
+
+  -- *** time checkers
   , hms
   , Hms
-  , HmsRE
   , Hmsip
   , Hmsop
   , Hmsfmt
-  , DateFmts
-  , DateN
-  , DateTimeFmts
-  , DateTimeN
-  , daten
-  , datetimen
+  , HmsRE
 
   -- ** credit cards
   , ccn
-  , cc11
+  , ccn'
   , Ccn
+  , cc11
   , CC11
   , LuhnR
   , LuhnT
@@ -56,8 +64,11 @@ 
  -- ** base n
   , basen
+  , base2
   , base16
   , basen'
+  , base2'
+  , base16'
   , BaseN
   , BaseN'
   , BaseIJ
@@ -89,7 +100,7 @@ import Predicate.Prelude
 import Predicate.Util
 import Data.Proxy
-import GHC.TypeLits (AppendSymbol,Nat)
+import GHC.TypeLits (KnownNat, AppendSymbol,Nat)
 import Data.Kind (Type)
 import Data.Time
 
@@ -101,106 +112,119 @@ 
 -- | credit card with luhn algorithm
 --
--- >>> prtEval3P cc11 ol "1234-5678-901"
+-- >>> prtEval3P cc11 oz "1234-5678-901"
 -- Left Step 2. False Boolean Check(op) | FalseP
 --
--- >>> prtEval3P cc11 ol "1234-5678-903"
+-- >>> prtEval3P cc11 oz "1234-5678-903"
 -- Right (Refined3 {r3In = [1,2,3,4,5,6,7,8,9,0,3], r3Out = "1234-5678-903"})
 --
--- >>> pl @(Ccip >> Ccop 11) "79927398713"
+-- >>> pz @(Ccip >> Ccop 11) "79927398713"
 -- True
 -- TrueT
 --
--- >>> pl @(Ccip >> Ccop 10) "79927398713"
+-- >>> pz @(Ccip >> Ccop 10) "79927398713"
 -- Error expected 10 digits but found 11
 -- FailT "expected 10 digits but found 11"
 --
-type Ccip = Map (ReadP Int) (Ones (Remove "-" Id))
-type Ccop (n :: Nat) = Guard ('(n,Len) >> Printf2 "expected %d digits but found %d") (Len >> Same n) >> Luhn Id
+type Ccip = Map (ReadP Int Id) (Ones (Remove "-" Id))
+type Ccop (n :: Nat) = Guard (PrintT "expected %d digits but found %d" '(n,Len)) (Len == n) >> Luhn Id
 type Ccfmt (ns :: [Nat]) = ConcatMap (ShowP Id) Id >> SplitAts ns Id >> Concat (Intercalate '["-"] Id)
 
 type Ccn (ns :: [Nat]) = '(Ccip, Ccop (SumT ns), Ccfmt ns, String)
 
 type CC11 = Ccn '[4,4,3]
 
--- not great for the general case: but specific case is easier
 ccn :: Proxy (Ccn ns)
 ccn = mkProxy3
 
+-- works but have to add all the constraints
+ccn' :: (PP ns [Char] ~ [Integer], KnownNat (SumT ns), P ns [Char]) => Proxy (Ccn ns)
+ccn' = mkProxy3'
+
 cc11 :: Proxy (Ccn '[4,4,3])   -- or Proxy CC11
-cc11 = mkProxy3P
+cc11 = mkProxy3'
 
 -- | read in a valid datetime
 --
--- >>> prtEval3P (datetime1 @LocalTime) ol "2018-09-14 02:57:04"
+-- >>> prtEval3P (datetime1 @LocalTime) oz "2018-09-14 02:57:04"
 -- Right (Refined3 {r3In = 2018-09-14 02:57:04, r3Out = "2018-09-14 02:57:04"})
 --
+-- >>> prtEval3P (datetime1' @LocalTime) oz "2018-09-14 99:98:97"
+-- Left Step 2. Failed Boolean Check(op) | invalid hours 99
+--
 -- >>> prtEval3P (datetime1 @LocalTime) ol "2018-09-14 99:98:97"
--- Left Step 2. Failed Boolean Check(op) | hours invalid: found 99
+-- Left Step 2. False Boolean Check(op) | {(>>) False | {GuardBool(0) [hours] (99 <= 23)}}
 --
+-- >>> prtEval3P (datetime1' @LocalTime) oz "2018-09-14 23:01:97"
+-- Left Step 2. Failed Boolean Check(op) | invalid seconds 97
+--
 -- >>> prtEval3P (datetime1 @LocalTime) ol "2018-09-14 23:01:97"
--- Left Step 2. Failed Boolean Check(op) | seconds invalid: found 97
+-- Left Step 2. False Boolean Check(op) | {(>>) False | {GuardBool(2) [seconds] (97 <= 59)}}
 --
--- >>> prtEval3P (Proxy @(DateTime1 UTCTime)) ol "2018-09-14 99:98:97"
+-- >>> prtEval3P (Proxy @(DateTime1 UTCTime)) oz "2018-09-14 99:98:97"
 -- Right (Refined3 {r3In = 2018-09-18 04:39:37 UTC, r3Out = "2018-09-18 04:39:37"})
 --
 datetime1 :: Proxy (DateTime1 t)
-datetime1 = mkProxy3P
+datetime1 = mkProxy3
 
 type DateTime1 (t :: Type) = '(Dtip t, Dtop, Dtfmt, String)
 type Dtip t = ParseTimeP t "%F %T" Id
 
+datetime1' :: Proxy (DateTime1' t)
+datetime1' = mkProxy3
+
+type DateTime1' (t :: Type) = '(Dtip t, Dtop', Dtfmt, String)
+
 -- extra check to validate the time as parseTime doesnt validate the time component
 -- ZonedTime LocalTime and TimeOfDay don't do validation and allow invalid stuff through : eg 99:98:97 is valid
 -- UTCTime will do the same but any overages get tacked on to the day and time as necessary: makes the time valid! 99:98:97 becomes 04:39:37
 --    2018-09-14 99:00:96 becomes 2018-09-18 03:01:36
-{-
+
 type Dtop' =
-   Map (ReadP Int) (FormatTimeP "%H %M %S" Id >> Resplit "\\s+" Id)
-     >> Guards '[ '(Printf2 "guard %d invalid hours %d", Between 0 23)
-                , '(Printf2 "guard %d invalid minutes %d", Between 0 59)
-                , '(Printf2 "guard %d invalid seconds %d", Between 0 59)
+   Map (ReadP Int Id) (FormatTimeP "%H %M %S" Id >> Resplit "\\s+" Id)
+     >> GuardsDetail "invalid %s %d"
+               '[ '("hours", Between 0 23)
+                , '("minutes", Between 0 59)
+                , '("seconds", Between 0 59)
                 ] >> 'True
+{-
+type Dtop'' =
+   Map (ReadP Int Id) (FormatTimeP "%H %M %S" Id >> Resplit "\\s+" Id)
+     >> Guards '[ '(PrintT "guard %d invalid hours %d" Id, Between 0 23)
+                , '(PrintT "guard %d invalid minutes %d" Id, Between 0 59)
+                , '(PrintT "guard %d invalid seconds %d" Id, Between 0 59)
+                ] >> 'True
 -}
+
 type Dtop =
-   Map (ReadP Int) (FormatTimeP "%H %M %S" Id >> Resplit "\\s+" Id)
-     >> GuardsDetail "%s invalid: found %d"
-                  '[ '("hours", Between 0 23)
-                   , '("minutes",Between 0 59)
-                   , '("seconds",Between 0 59)
-                   ] >> 'True
+   Map (ReadP Int Id) (FormatTimeP "%H %M %S" Id >> Resplit "\\s+" Id)
+     >> Bools '[ '("hours", Between 0 23)
+               , '("minutes",Between 0 59)
+               , '("seconds",Between 0 59)
+               ]
 
 type Dtfmt = FormatTimeP "%F %T" Id
 
 ssn :: Proxy Ssn
-ssn = mkProxy3
+ssn = mkProxy3'
 
 -- | read in an ssn
 --
--- >>> prtEval3P ssn ol "134-01-2211"
+-- >>> prtEval3P ssn oz "134-01-2211"
 -- Right (Refined3 {r3In = [134,1,2211], r3Out = "134-01-2211"})
 --
 -- >>> prtEval3P ssn ol "666-01-2211"
--- Left Step 2. Failed Boolean Check(op) | number for group 1 invalid: found 666
---
--- >>> prtEval3P ssn ol "666-01-2211"
--- Left Step 2. Failed Boolean Check(op) | number for group 1 invalid: found 666
+-- Left Step 2. False Boolean Check(op) | {GuardBool(0) [number for group 0 invalid: found 666] (True && False | (666 /= 666))}
 --
 -- >>> prtEval3P ssn ol "667-00-2211"
--- Left Step 2. Failed Boolean Check(op) | number for group 2 invalid: found 0
---
--- >>> prtEval3P ssn ol "666-01-2211"
--- Left Step 2. Failed Boolean Check(op) | number for group 1 invalid: found 666
---
--- >>> prtEval3P ssn ol "991-22-9999"
--- Left Step 2. Failed Boolean Check(op) | number for group 1 invalid: found 991
+-- Left Step 2. False Boolean Check(op) | {GuardBool(1) [number for group 1 invalid: found 0] (1 <= 0)}
 --
 type Ssn = '(Ssnip, Ssnop, Ssnfmt, String)
 
-type Ssnip = Map (ReadP Int) (Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> Snd OneP)
-type Ssnop = GuardsQuick (Printf2 "number for group %d invalid: found %d")
+type Ssnip = Map (ReadP Int Id) (Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> Snd OneP)
+type Ssnop = BoolsQuick (PrintT "number for group %d invalid: found %d" Id)
                      '[Between 1 899 && Id /= 666, Between 1 99, Between 1 9999]
-                      >> 'True
+
 {-
 type Ssnop' = GuardsDetail "%s invalid: found %d"
                           '[ '("first", Between 1 899 && Id /= 666)
@@ -208,7 +232,7 @@                            , '("third" , Between 1 9999)
                            ] >> 'True
 -}
-type Ssnfmt = Printfnt 3 "%03d-%02d-%04d"
+type Ssnfmt = PrintL 3 "%03d-%02d-%04d" Id
 
 -- | read in a time and validate it
 --
@@ -216,50 +240,58 @@ -- Right (Refined3 {r3In = [23,13,59], r3Out = "23:13:59"})
 --
 -- >>> prtEval3P hms ol "23:13:60"
--- Left Step 2. Failed Boolean Check(op) | seconds invalid: found 60
+-- Left Step 2. False Boolean Check(op) | {GuardBool(2) [seconds] (60 <= 59)}
 --
 -- >>> prtEval3P hms ol "26:13:59"
--- Left Step 2. Failed Boolean Check(op) | hours invalid: found 26
+-- Left Step 2. False Boolean Check(op) | {GuardBool(0) [hours] (26 <= 23)}
 --
 hms :: Proxy Hms
-hms = mkProxy3
-
-type Hms = '(Hmsip, Hmsop >> 'True, Hmsfmt, String)
+hms = mkProxy3'
 
-type Hmsip = Map (ReadP Int) (Resplit ":" Id)
+type Hms = '(Hmsip, Hmsop, Hmsfmt, String)
 
-type Hmsop = GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)]
+type Hmsip = Map (ReadP Int Id) (Resplit ":" Id)
 {-
-type Hmsop = Guard (Printf "expected len 3 but found %d" Len) (Length Id == 3)
-             >> Guards '[ '(Printf2 "guard(%d) %d hours is out of range", Between 0 23)
-                        , '(Printf2 "guard(%d) %d mins is out of range", Between 0 59)
-                        , '(Printf2 "guard(%d) %d secs is out of range", Between 0 59)]
+type Hmsop = BoolsQuick ""
+              '[ Msg "hours:"   (Between 0 23)
+              ,  Msg "minutes:" (Between 0 59)
+              ,  Msg "seconds:" (Between 0 59)]
 -}
-type Hmsfmt = Printfnt 3 "%02d:%02d:%02d"
+type Hmsop = Bools
+             '[ '("hours", Between 0 23)
+              , '("minutes",Between 0 59)
+               ,'("seconds",Between 0 59)]
+{-
+type Hmsop = Guard (PrintF "expected len 3 but found %d" Len) (Length Id == 3)
+             >> Guards '[ '(PrintT "guard(%d) %d hours is out of range" Id, Between 0 23)
+                        , '(PrintT "guard(%d) %d mins is out of range" Id, Between 0 59)
+                        , '(PrintT "guard(%d) %d secs is out of range" Id, Between 0 59)]
+-}
+type Hmsfmt = PrintL 3 "%02d:%02d:%02d" Id
 
 -- | read in an ipv4 address and validate it
 --
--- >>> prtEval3P ip ol "001.223.14.1"
+-- >>> prtEval3P ip oz "001.223.14.1"
 -- Right (Refined3 {r3In = [1,223,14,1], r3Out = "001.223.014.001"})
 --
 -- >>> prtEval3P ip ol "001.223.14.999"
--- Left Step 2. Failed Boolean Check(op) | guard(4) octet out of range 0-255 found 999
+-- Left Step 2. False Boolean Check(op) | {GuardBool(3) [guard(3) octet out of range 0-255 found 999] (999 <= 255)}
 --
--- >>> prtEval3P ip ol "001.223.14.999.1"
+-- >>> prtEval3P ip oz "001.223.14.999.1"
 -- Left Step 1. Initial Conversion(ip) Failed | Regex no results
 --
 -- >>> prtEval3P ip ol "001.257.14.1"
--- Left Step 2. Failed Boolean Check(op) | guard(2) octet out of range 0-255 found 257
+-- Left Step 2. False Boolean Check(op) | {GuardBool(1) [guard(1) octet out of range 0-255 found 257] (257 <= 255)}
 --
 type Ip = '(Ipip, Ipop, Ipfmt, String)
 
 ip :: Proxy Ip
-ip = mkProxy3
+ip = mkProxy3'
 
-type Ipip = Map (ReadP Int) (Rescan "^(\\d{1,3}).(\\d{1,3}).(\\d{1,3}).(\\d{1,3})$" Id >> OneP >> Snd Id)
+type Ipip = Map (ReadP Int Id) (Rescan "^(\\d{1,3}).(\\d{1,3}).(\\d{1,3}).(\\d{1,3})$" Id >> OneP >> Snd Id)
 -- RepeatT is a type family so it expands everything! replace RepeatT with a type class
-type Ipop = GuardsN (Printf2 "guard(%d) octet out of range 0-255 found %d") 4 (Between 0 255) >> 'True
-type Ipfmt = Printfnt 4 "%03d.%03d.%03d.%03d"
+type Ipop = BoolsN (PrintT "guard(%d) octet out of range 0-255 found %d" Id) 4 (Between 0 255)
+type Ipfmt = PrintL 4 "%03d.%03d.%03d.%03d" Id
 
 type HmsRE = "^([0-1][0-9]|2[0-3]):([0-5][0-9]):([0-5][0-9])$" -- strict validation should only be done in 'op' not 'ip'
 
@@ -272,25 +304,39 @@ type DateN = '(ParseTimes Day DateFmts Id, 'True, FormatTimeP "%Y-%m-%d" Id, String)
 
 type DateTimeFmts = '["%Y-%m-%d %H:%M:%S", "%m/%d/%y %H:%M:%S", "%B %d %Y %H:%M:%S", "%Y-%m-%dT%H:%M:%S"]
+
+type DateTimeNR = MakeR3 DateTimeN
 type DateTimeN = '(ParseTimes UTCTime DateTimeFmts Id, 'True, FormatTimeP "%Y-%m-%d %H:%M:%S" Id, String)
 
 -- | convert a string from a given base \'i\' and store it internally as an base 10 integer
 --
--- >>> prtEval3P base16 ol "00fe"
+-- >>> prtEval3P base16 oz "00fe"
 -- Right (Refined3 {r3In = 254, r3Out = "fe"})
 --
--- >>> prtEval3P (basen' @16 @(Between 100 400)) ol "00fe"
+-- >>> prtEval3P (basen' @16 @(Between 100 400)) oz "00fe"
 -- Right (Refined3 {r3In = 254, r3Out = "fe"})
 --
--- >>> prtEval3P (basen' @16 @(GuardSimple (Id < 400) >> 'True)) ol "f0fe"
--- Left Step 2. Failed Boolean Check(op) | 61694 < 400
+-- >>> prtEval3P (basen' @16 @(GuardSimple (Id < 400) >> 'True)) oz "f0fe"
+-- Left Step 2. Failed Boolean Check(op) | (61694 < 400)
 --
+-- >>> prtEval3P (basen' @16 @(Id < 400)) ol "f0fe" -- todo: why different parens vs braces
+-- Left Step 2. False Boolean Check(op) | {61694 < 400}
+--
 type BaseN (n :: Nat) = BaseN' n 'True
-type BaseN' (n :: Nat) p = '(ReadBase Int n, p, ShowBase n, String)
+type BaseN' (n :: Nat) p = '(ReadBase Int n Id, p, ShowBase n Id, String)
 
 base16 :: Proxy (BaseN 16)
-base16 = basen @16
+base16 = basen
 
+base16' :: Proxy (BaseN' 16 p)
+base16' = basen'
+
+base2 :: Proxy (BaseN 2)
+base2 = basen
+
+base2' :: Proxy (BaseN' 2 p)
+base2' = basen'
+
 -- replace with BetweenT 2 36 n
 --basen :: forall n . (KnownNat n, (n GN.<=? 36) ~ 'True, (2 GN.<=? n) ~ 'True) => Proxy (BaseN n)
 --basen = mkProxy3
@@ -312,21 +358,21 @@ basen' = mkProxy3
 -}
 daten :: Proxy DateN
-daten = mkProxy3
+daten = mkProxy3'
 
 datetimen :: Proxy DateTimeN
-datetimen = mkProxy3
+datetimen = mkProxy3'
 
 -- | ensures that two numbers are in a given range (emulates 'Refined.Refined')
 --
--- >>> prtEval3P (between @10 @16) ol 14
+-- >>> prtEval3P (between @10 @16) oz 14
 -- Right (Refined3 {r3In = 14, r3Out = 14})
 --
--- >>> prtEval3P (between @10 @16) ol 17
+-- >>> prtEval3P (between @10 @16) oz 17
 -- Left Step 2. False Boolean Check(op) | FalseP
 --
 -- >>> prtEval3P (between @10 @16) o0 17
--- Left Step 2. False Boolean Check(op) | FalseP
+-- Left Step 2. False Boolean Check(op) | {17 <= 16}
 -- <BLANKLINE>
 -- *** Step 1. Success Initial Conversion(ip) [17] ***
 -- <BLANKLINE>
@@ -334,19 +380,13 @@ -- <BLANKLINE>
 -- *** Step 2. False Boolean Check(op) ***
 -- <BLANKLINE>
--- False True && False
+-- False 17 <= 16
 -- |
--- +- True  17 >= 10
--- |  |
--- |  +- P I
--- |  |
--- |  `- P '10
+-- +- P Id 17
 -- |
--- `- False 17 <= 16
---    |
---    +- P I
---    |
---    `- P '16
+-- +- P '10
+-- |
+-- `- P '16
 -- <BLANKLINE>
 --
 between :: Proxy (BetweenN m n)
@@ -359,18 +399,17 @@ 
 -- | Luhn check
 --
--- >>> prtEval3P (Proxy @(LuhnT 4)) ol "1230"
+-- >>> prtEval3P (Proxy @(LuhnT 4)) oz "1230"
 -- Right (Refined3 {r3In = [1,2,3,0], r3Out = "1230"})
 --
 -- >>> prtEval3P (Proxy @(LuhnT 4)) ol "1234"
--- Left Step 2. Failed Boolean Check(op) | Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4]
-
+-- Left Step 2. False Boolean Check(op) | {True && False | (Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])}
+--
 -- | uses builtin 'Luhn'
 type LuhnT (n :: Nat) =
-   '(Map (ReadP Int) (Ones Id)
-   , Guard (Printfn "incorrect number of digits found %d but expected %d in [%s]" (TupleI '[Len, W n, ShowP Id]))
-           (Len >> Same n)
-     >> GuardSimple (Luhn Id) >> 'True
+   '(Map (ReadP Int Id) (Ones Id)
+   , Msg "incorrect number of digits:"
+         (Len == n) && Luhn Id
    , ConcatMap (ShowP Id) Id
    , String)
 
@@ -390,58 +429,58 @@ 
 -- | convert a string from a given base \'i\' and store it internally as a base \'j\' string
 --
--- >>> prtEval3P (Proxy @(BaseIJ 16 2)) ol "fe"
+-- >>> prtEval3P (Proxy @(BaseIJ 16 2)) oz "fe"
 -- Right (Refined3 {r3In = "11111110", r3Out = "fe"})
 --
--- >>> prtEval3P (Proxy @(BaseIJ 16 2)) ol "fge"
+-- >>> prtEval3P (Proxy @(BaseIJ 16 2)) oz "fge"
 -- Left Step 1. Initial Conversion(ip) Failed | invalid base 16
 --
--- >>> prtEval3P (Proxy @(BaseIJ' 16 2 (GuardSimple (ReadBase Int 2 < 1000) >> 'True))) ol "ffe"
--- Left Step 2. Failed Boolean Check(op) | 4094 < 1000
+-- >>> prtEval3P (Proxy @(BaseIJ' 16 2 (ReadBase Int 2 Id < 1000))) ol "ffe"
+-- Left Step 2. False Boolean Check(op) | {4094 < 1000}
 --
 type BaseIJ (i :: Nat) (j :: Nat) = BaseIJ' i j 'True
-type BaseIJ' (i :: Nat) (j :: Nat) p = '(ReadBase Int i >> ShowBase j, p, ReadBase Int j >> ShowBase i, String)
+type BaseIJ' (i :: Nat) (j :: Nat) p = '(ReadBase Int i Id >> ShowBase j Id, p, ReadBase Int j Id >> ShowBase i Id, String)
 
 -- | take any valid Read/Show instance and turn it into a valid 'Refined3'
 --
 -- >>> :m + Data.Ratio
--- >>> prtEval3P (readshow @Rational) ol "13 % 3"
+-- >>> prtEval3P (readshow @Rational) oz "13 % 3"
 -- Right (Refined3 {r3In = 13 % 3, r3Out = "13 % 3"})
 --
--- >>> prtEval3P (readshow @Rational) ol "13x % 3"
+-- >>> prtEval3P (readshow @Rational) oz "13x % 3"
 -- Left Step 1. Initial Conversion(ip) Failed | ReadP Ratio Integer (13x % 3) failed
 --
--- >>> prtEval3P (readshow' @Rational @(Between (3 % 1) (5 % 1))) ol "13 % 3"
+-- >>> prtEval3P (readshow' @Rational @(Between (3 % 1) (5 % 1))) oz "13 % 3"
 -- Right (Refined3 {r3In = 13 % 3, r3Out = "13 % 3"})
 --
--- >>> prtEval3P (Proxy @(ReadShow' Rational (Between (11 %- 2) (3 %- 1)))) ol "-13 % 3"
+-- >>> prtEval3P (Proxy @(ReadShow' Rational (Between (11 %- 2) (3 %- 1)))) oz "-13 % 3"
 -- Right (Refined3 {r3In = (-13) % 3, r3Out = "(-13) % 3"})
 --
--- >>> prtEval3P (Proxy @(ReadShow' Rational (Id > (15 % 1)))) ol "13 % 3"
+-- >>> prtEval3P (Proxy @(ReadShow' Rational (Id > (15 % 1)))) oz "13 % 3"
 -- Left Step 2. False Boolean Check(op) | FalseP
 --
--- >>> prtEval3P (Proxy @(ReadShow' Rational (Guard (Printf "invalid=%3.2f" (FromRational Double Id)) (Id > (15 % 1)) >> 'True))) ol "13 % 3"
--- Left Step 2. Failed Boolean Check(op) | invalid=4.33
+-- >>> prtEval3P (Proxy @(ReadShow' Rational (Msg (PrintF "invalid=%3.2f" (FromRational Double Id)) (Id > (15 % 1))))) ol "13 % 3"
+-- Left Step 2. False Boolean Check(op) | {invalid=4.3313 % 3 > 15 % 1}
 --
--- >>> prtEval3P (Proxy @(ReadShow' Rational (Id > (11 % 1)))) ol "13 % 3"
+-- >>> prtEval3P (Proxy @(ReadShow' Rational (Id > (11 % 1)))) oz "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
--- >>> prtEval3P (readshow @UTCTime) ol tmString
+-- >>> prtEval3P (readshow @UTCTime) oz tmString
 -- Right (Refined3 {r3In = 2018-10-19 14:53:11.5121359 UTC, r3Out = "2018-10-19 14:53:11.5121359 UTC"})
 --
 -- >>> :m + Data.Aeson
--- >>> prtEval3P (readshow @Value) ol "String \"jsonstring\""
+-- >>> prtEval3P (readshow @Value) oz "String \"jsonstring\""
 -- Right (Refined3 {r3In = String "jsonstring", r3Out = "String \"jsonstring\""})
 --
--- >>> prtEval3P (readshow @Value) ol "Number 123.4"
+-- >>> prtEval3P (readshow @Value) oz "Number 123.4"
 -- Right (Refined3 {r3In = Number 123.4, r3Out = "Number 123.4"})
 --
-type ReadShow (t :: Type) = '(ReadP t, 'True, ShowP Id, String)
+type ReadShow (t :: Type) = '(ReadP t Id, 'True, ShowP Id, String)
 type ReadShowR (t :: Type) = MakeR3 (ReadShow t)
 
-type ReadShow' (t :: Type) p = '(ReadP t, p, ShowP Id, String)
+type ReadShow' (t :: Type) p = '(ReadP t Id, p, ShowP Id, String)
 type ReadShowR' (t :: Type) p = MakeR3 (ReadShow' t p)
 
 readshow :: Proxy (ReadShow t)
src/Predicate/Util.hs view
@@ -25,6 +25,7 @@ {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FunctionalDependencies #-}
 {- |
      Utility methods for Predicate / methods for displaying the evaluation tree ...
 -}
@@ -35,6 +36,9 @@   , tStrings
   , tForest
   , fixBoolT
+  , topMessage
+  , topMessage'
+  , hasNoTree
 
  -- ** BoolT
   , BoolT(..)
@@ -47,6 +51,8 @@   , boolT2P
   , BoolP
   , PE(PE)
+  , pStrings
+  , pBool
 
  -- ** create tree functions
   , mkNode
@@ -66,7 +72,9 @@ 
  -- ** display options
   , POpts(..)
+  , ODebug(..)
   , defOpts
+  , oz
   , ol
   , olc
   , o0
@@ -74,9 +82,9 @@   , o2n
   , o3
   , ou
+  , ou3
   , oun
   , setw
-  , setd
   , setu
   , setc
   , color0
@@ -85,9 +93,15 @@   , color3
   , color4
   , colorMe
+  , zero
   , lite
-  , unicode
+  , subnormal
   , normal
+  , verbose
+  , isVerbose
+  , ansi
+  , unicode
+  , showBoolP
 
 -- ** formatting functions
   , show01
@@ -100,7 +114,7 @@   , show3
   , show1
 
-  -- ** Regex
+  -- ** regular expressions
   , ROpt(..)
   , compileRegex
   , GetROpts(..)
@@ -109,17 +123,16 @@   -- ** useful type families
   , BetweenT
   , NullT
-  , FailIfT
+  , FailWhenT
+  , FailUnlessT
   , AndT
   , OrT
   , NotT
   , RepeatT
   , IntersperseT
   , LenT
-  , ReverseTupleC(..)
-  , TupleListT
-  , TupleListD(..)
-  , TupleLenT
+  , InductTupleC(..)
+  , InductListC(..)
   , FlipT
   , IfT
   , SumT
@@ -127,6 +140,10 @@   , ConsT
   , type (%%)
   , type (%&)
+  , T_1
+  , T_2
+  , T_3
+  , T_4
 
  -- ** extract values from the type level
   , nat
@@ -139,7 +156,6 @@   , GetThese(..)
   , GetOrdering(..)
   , GetBool(..)
-  , ToN
   , OrderingP(..)
   , GetOrd(..)
 
@@ -152,10 +168,10 @@   , prettyRational
 
  -- ** boolean methods
-  , imply
-  , evalBinStrict
+  , (~>)
 
  -- ** miscellaneous
+  , Holder
   , hh
   , showT
   , prettyOrd
@@ -195,6 +211,7 @@ import Data.Foldable
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as N
+--import Data.Maybe
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -251,11 +268,16 @@ pBool :: Lens' PE BoolP
 pBool afb (PE x y) = flip PE y <$> afb x
 
+pStrings :: Lens' PE [String]
+pStrings afb s = (\b -> s { _pStrings = b }) <$> afb (_pStrings s)
+
 -- | creates a Node for the evaluation tree
 mkNode :: POpts -> BoolT a -> [String] -> [Holder] -> TT a
-mkNode opts bt ss hs
-  | oLite opts = TT bt [] []
-  | otherwise = TT bt ss (map fromTTH hs)
+mkNode opts bt ss hs =
+  case oDebug opts of
+    OZero -> TT bt [] []
+    OLite -> TT bt (take 1 ss) [] -- keeps the last one so we can use the root to give more details on failure (especially for Refined and Refined3 types)
+    _ -> TT bt ss (map fromTTH hs)
 
 -- | creates a Boolean node for a predicate type
 mkNodeB :: POpts -> Bool -> [String] -> [Holder] -> TT Bool
@@ -323,15 +345,13 @@ 
 -- | customizable options
 data POpts = POpts { oWidth :: Int -- ^ length of data to display for 'showLitImpl'
-                   , oDebug :: !Int  -- ^ debug level
+                   , oDebug :: !ODebug -- ^ debug level
                    , oDisp :: Disp -- ^ display the tree using the normal tree or unicode
-                   , oHide :: !Int -- ^ hides one layer of a tree
                    , oColor :: !(String, PColor) -- ^ color palette used
-                   , oLite :: !Bool -- ^ skip the tree entirely and display the end result
                    }
 
 -- | display format for the tree
-data Disp = NormalDisp -- ^ draw normal tree
+data Disp = Ansi -- ^ draw normal tree
           | Unicode  -- ^ use unicode
           deriving (Show, Eq)
 
@@ -340,23 +360,31 @@     "POpts: showA=" <> show (oWidth opts)
     <> " debug=" <> show (oDebug opts)
     <> " disp=" <> show (oDisp opts)
-    <> " hide=" <> show (oHide opts)
     <> " color=" <> show (fst (oColor opts))
-    <> " lite=" <> show (oLite opts)
 
 defOpts :: POpts
 defOpts = POpts
     { oWidth = 200
-    , oDebug = 2
-    , oDisp = NormalDisp
-    , oHide = 0
+    , oDebug = ONormal
+    , oDisp = Ansi
     , oColor = color1
-    , oLite = False
     }
 
+data ODebug =
+       OZero
+     | OLite
+     | OSubNormal
+     | ONormal
+     | OVerbose
+     deriving (Ord, Show, Eq, Enum, Bounded)
+
 -- | skip colors and just return the summary
+oz :: POpts
+oz = defOpts { oColor = color0, oDebug = OZero }
+
+-- | skip colors and just return the summary
 ol :: POpts
-ol = defOpts { oColor = color0, oLite = True }
+ol = defOpts { oColor = color0, oDebug = OLite }
 
 -- | skip the detail and just return the summary but keep the colors
 olc :: POpts
@@ -368,32 +396,48 @@ 
 -- | displays the detailed evaluation tree using colors.
 o2 :: POpts
-o2 = defOpts { oDebug = 2 }
+o2 = defOpts
 
 -- | same as 'o2' but for a narrow display
 o2n :: POpts
 o2n = o2 { oWidth = 120 }
 
--- | same as 'o2' for a wider display and more lenient debug mode setting
+-- | same as 'o2' for a wider display and verbose debug mode setting
 o3 :: POpts
-o3 = defOpts { oDebug = 3, oWidth = 400 }
+o3 = defOpts { oDebug = OVerbose, oWidth = 400 }
 
 -- | displays the detailed evaluation tree using unicode and colors. ('o2' works better on Windows)
 ou :: POpts
 ou = defOpts { oDisp = Unicode }
 
+-- | same as 'ou' for a wider display and verbose debug mode setting
+ou3 :: POpts
+ou3 = o3 { oDisp = Unicode }
+
 -- | same as 'ou' but for a narrow display
 oun :: POpts
 oun = ou { oWidth = 120 }
 
+-- | helper method to set the debug level
+isVerbose :: POpts -> Bool
+isVerbose = (OVerbose==) . oDebug
+
 -- | helper method to limit the width of the tree
 setw :: Int -> POpts -> POpts
 setw w o = o { oWidth = w }
 
 -- | helper method to set the debug level
-setd :: Int -> POpts -> POpts
-setd v o = o { oDebug = v }
+verbose :: POpts -> POpts
+verbose o = o { oDebug = OVerbose }
 
+-- | helper method to set the debug level
+normal :: POpts -> POpts
+normal o = o { oDebug = ONormal }
+
+-- | helper method to set the debug level
+subnormal :: POpts -> POpts
+subnormal o = o { oDebug = OSubNormal }
+
 -- | set display to unicode and colors
 setu :: POpts -> POpts
 setu o = o { oDisp = Unicode }
@@ -460,13 +504,13 @@ 
 -- | display all data regardless of debug level
 showLit0 :: POpts -> String -> String -> String
-showLit0 o s a = showLitImpl o 0 s a
+showLit0 o s a = showLitImpl o OLite s a
 
 -- | more restrictive: only display data at debug level 1 or less
 showLit1 :: POpts -> String -> String -> String
-showLit1 o s a = showLitImpl o 1 s a
+showLit1 o s a = showLitImpl o OLite s a
 
-showLitImpl :: POpts -> Int -> String -> String -> String
+showLitImpl :: POpts -> ODebug -> String -> String -> String
 showLitImpl o i s a =
   if oDebug o >= i then
     let f n = let ss = take n a
@@ -475,15 +519,15 @@   else ""
 
 show0 :: Show a => POpts -> String -> a -> String
-show0 o s a = showAImpl o 0 s a
+show0 o s a = showAImpl o OLite s a
 
 show3 :: Show a => POpts -> String -> a -> String
-show3 o s a = showAImpl o 3 s a
+show3 o s a = showAImpl o OVerbose s a
 
 show1 :: Show a => POpts -> String -> a -> String
-show1 o s a = showAImpl o 1 s a
+show1 o s a = showAImpl o OLite s a
 
-showAImpl :: Show a => POpts -> Int -> String -> a -> String
+showAImpl :: Show a => POpts -> ODebug -> String -> a -> String
 showAImpl o i s a = showLitImpl o i s (show a)
 
 -- | Regex options for Rescan Resplit Re etc
@@ -587,7 +631,7 @@      ([], tfs) -> Right (valsFromTTs (map snd ts), tfs)
 
 formatList :: forall x z . Show x => POpts -> [((Int, x), z)] -> String
-formatList opts = unwords . map (\((i, a), _) -> "(i=" <> show i <> showAImpl opts 0 ", a=" a <> ")")
+formatList opts = unwords . map (\((i, a), _) -> "(i=" <> show i <> showAImpl opts OLite ", a=" a <> ")")
 
 -- | extract all root values from a list of trees
 valsFromTTs :: [TT a] -> [a]
@@ -640,44 +684,25 @@ 
 -- | boolean implication
 --
--- >>> True `imply` False
+-- >>> True ~> False
 -- False
 --
--- >>> True `imply` True
+-- >>> True ~> True
 -- True
 --
--- >>> False `imply` False
+-- >>> False ~> False
 -- True
 --
--- >>> False `imply` True
+-- >>> False ~> True
 -- True
 
-imply :: Bool -> Bool -> Bool
-imply p q = not p || q
-
--- msg is only used for an exception: up to the calling programs to deal with ading msg to good and bad
--- | applies a boolean binary operation against the values from two boolean trees
-evalBinStrict :: POpts
-                 -> String
-                 -> (Bool -> Bool -> Bool)
-                 -> TT Bool
-                 -> TT Bool
-                 -> TT Bool
-evalBinStrict opts s fn ll rr =
-  case getValueLR opts (s <> " p") ll [Holder rr] of
-    Left e -> e
-    Right a ->
-      case getValueLR opts (s <> " q") rr [hh ll] of
-        Left e -> e
-        Right b ->
-          let z = fn a b
-          in mkNodeB opts z [show a <> " " <> s <> " " <> show b] [hh ll, hh rr]
+(~>) :: Bool -> Bool -> Bool
+p ~> q = not p || q
 
 -- | type level Between
 type family BetweenT (a :: Nat) (b :: Nat) (v :: Nat) :: Constraint where
   BetweenT m n v =
-     FailIfT (NotT (AndT (m GL.<=? v) (v GL.<=? n)))
-              ((m GL.<=? v) ~ 'True, (v GL.<=? n) ~ 'True)
+     FailUnlessT (AndT (m GL.<=? v) (v GL.<=? n))
             ('GL.Text "BetweenT failure"
              ':$$: 'GL.ShowType v
              ':$$: 'GL.Text " is outside of "
@@ -690,12 +715,16 @@   NullT ("" :: Symbol) = 'True
   NullT _ = 'False
 
--- todo: constraint \'c\' is not passed on properly
--- | helper method to fail with an error if the True
-type family FailIfT (b :: Bool) (c :: Constraint) (msg :: GL.ErrorMessage) :: Constraint where
-  FailIfT 'False c _ = c
-  FailIfT 'True _ e = GL.TypeError e
+-- | helper method to fail with an error 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 an error when False
+type family FailUnlessT (b :: Bool) (msg :: GL.ErrorMessage) :: Constraint where
+  FailUnlessT 'True _ = ()
+  FailUnlessT 'False e = GL.TypeError e
+
 -- | typelevel And
 type family AndT (b :: Bool) (b1 :: Bool) :: Bool where
   AndT 'False _ = 'False
@@ -720,6 +749,7 @@ nat = fromIntegral (GL.natVal (Proxy @n))
 
 -- | gets the Symbol from the typelevel
+--
 -- >>> symb @"abc"
 -- "abc"
 --
@@ -797,31 +827,6 @@ instance GetBool 'False where
   getBool = False
 
-data N = S N | Z
-
--- a shim for TupleListImpl used mainly by Printfn
--- | inductive numbers
-type family ToN (n :: Nat) :: N where
-  ToN 0 = 'Z
-  ToN n = 'S (ToN (n GL.- 1))
-{-
--- | converts an inductive number to Nat
-type family FromN (n :: N) :: Nat where
-  FromN 'Z = 0
-  FromN ('S n) = 1 GL.+ FromN n
-
--- | extract N from the type level to Int
-class GetNatN (n :: N) where
-  getNatN :: Int
-instance GetNatN 'Z where
-  getNatN = 0
-instance GetNatN n => GetNatN ('S n) where
-  getNatN = 1 + getNatN @n
-
-getN :: Typeable t => Proxy (t :: N) -> Int
-getN p = length (show (typeRep p)) `div` 5
--}
-
 data OrderingP = Cgt | Cge | Ceq | Cle | Clt | Cne deriving (Show, Eq, Enum, Bounded)
 
 class GetOrd (k :: OrderingP) where
@@ -835,10 +840,19 @@ instance GetOrd 'Cne where getOrd = ("/=",(/=))
 
 toNodeString :: POpts -> PE -> String
-toNodeString opts bpe
-  | oLite opts = error $ "shouldnt be calling this if we are going lite: toNodeString oLite " ++ show bpe
-  | otherwise = showBoolP opts (_pBool bpe) <> " " <> displayMessages (_pStrings bpe)
+toNodeString opts bpe =
+  if hasNoTree opts then error $ "shouldnt be calling this if we are dropping details: toNodeString " <> show (oDebug opts) <> " " <> show bpe
+  else showBoolP opts (_pBool bpe) <> " " <> displayMessages (_pStrings bpe)
 
+hasNoTree :: POpts -> Bool
+hasNoTree opts =
+  case oDebug opts of
+    OZero -> True
+    OLite -> True
+    OSubNormal -> False
+    ONormal -> False
+    OVerbose -> False
+
 nullSpace :: String -> String
 nullSpace s | null s = ""
             | otherwise = " " <> s
@@ -873,14 +887,14 @@ prtTT' o y = liftEval y >>= prtTree o . fromTT
 
 prtTree :: POpts -> Tree PE -> IO ()
-prtTree o = prtImpl o . fmap (toNodeString o)
+prtTree o = putStr . prtTreePure o -- prtImpl o . fmap (toNodeString o)
 
 prtImpl :: POpts -> Tree String -> IO ()
 prtImpl = (putStr .) . showImpl
 
 fixLite :: forall a . Show a => POpts -> a -> Tree PE -> String
 fixLite opts a t
-  | oLite opts = fixPresentP opts (t ^. root . pBool) a <> "\n"
+  | hasNoTree opts = fixPresentP opts (t ^. root . pBool) a <> "\n"
   | otherwise = prtTreePure opts t
 
 fixPresentP :: Show a => POpts -> BoolP -> a -> String
@@ -891,26 +905,38 @@ 
 prtTreePure :: POpts -> Tree PE -> String
 prtTreePure opts t
-  | oLite opts = showBoolP opts (t ^. root . pBool)
+  | hasNoTree opts = showBoolP opts (t ^. root . pBool)
   | otherwise = showImpl opts $ fmap (toNodeString opts) t
 
+topMessage' :: TT a -> String
+topMessage' pp = maybe "" innermost (pp ^? tStrings . ix 0)
+
+topMessage :: TT a -> String
+topMessage pp = maybe "" (\x -> "(" <> x <> ")") (pp ^? tStrings . ix 0)
+
+innermost :: String -> String
+innermost = ('{':) . reverse . ('}':) . takeWhile (/='{') . dropWhile (=='}') . reverse
+
 showImpl :: POpts -> Tree String -> String
 showImpl o =
   case oDisp o of
     Unicode -> TV.showTree
-    NormalDisp -> drawTree -- to drop the last newline else we have to make sure that everywhere else has that newline: eg fixLite
+    Ansi -> drawTree -- to drop the last newline else we have to make sure that everywhere else has that newline: eg fixLite
 
 -- | skip displaying the tree and just output the result
 lite :: POpts -> POpts
-lite o = o { oLite = True }
+lite o = o { oDebug = OLite }
 
+zero :: POpts -> POpts
+zero o = o { oDebug = OZero }
+
 -- | display in unicode (non-Windows)
 unicode :: POpts -> POpts
 unicode o = o { oDisp = Unicode }
 
 -- | normal display
-normal :: POpts -> POpts
-normal o = o { oDisp = NormalDisp }
+ansi :: POpts -> POpts
+ansi o = o { oDisp = Ansi }
 
 prettyRational :: Rational -> String
 prettyRational (numerator &&& denominator -> (n,d)) =
@@ -948,76 +974,115 @@   LenT '[] = 0
   LenT (x ': xs) = 1 GN.+ LenT xs
 
-type family TupleListT (n :: N) a where
-  TupleListT 'Z a = ()
-  TupleListT ('S n) a = (a, TupleListT n a)
-
-class TupleListD (n :: N) a where
-  tupleListD :: Bool -> [a] -> Either String (TupleListT n a)
-
-instance TupleListD 'Z a where
-  tupleListD isStrict = \case
-     z@(_:_) | isStrict ->
-       let len = length z
-       in Left $ "is strict and has " <> show len <> " extra element" <> (if len == 1 then "" else "s")
-     _ -> Right ()
-
-instance (TupleListD n a) => TupleListD ('S n) a where
-  tupleListD isStrict = \case
-    [] -> Left "no data left" -- nothing i can do here even if not strict
-    a:as -> (a,) <$> tupleListD @n @a isStrict as
-
--- up to 12
-class ReverseTupleC x where
-  type ReverseTupleP x
-  reverseTupleC :: x -> ReverseTupleP x
-instance (GL.TypeError ('GL.Text "ReverseTupleC: inductive tuple cannot be empty")) => ReverseTupleC () where
-  type ReverseTupleP () = ()
-  reverseTupleC () = ()
-instance ReverseTupleC (a,()) where
-  type ReverseTupleP (a,()) = (a,())
-  reverseTupleC (a,()) = (a,())
-instance ReverseTupleC (a,(b,())) where
-  type ReverseTupleP (a,(b,())) = (b,(a,()))
-  reverseTupleC (a,(b,())) = (b,(a,()))
-instance ReverseTupleC (a,(b,(c,()))) where
-  type ReverseTupleP (a,(b,(c,()))) = (c,(b,(a,())))
-  reverseTupleC (a,(b,(c,()))) = (c,(b,(a,())))
-instance ReverseTupleC (a,(b,(c,(d,())))) where
-  type ReverseTupleP (a,(b,(c,(d,())))) = (d,(c,(b,(a,()))))
-  reverseTupleC (a,(b,(c,(d,())))) = (d,(c,(b,(a,()))))
-instance ReverseTupleC (a,(b,(c,(d,(e,()))))) where
-  type ReverseTupleP (a,(b,(c,(d,(e,()))))) = (e,(d,(c,(b,(a,())))))
-  reverseTupleC (a,(b,(c,(d,(e,()))))) = (e,(d,(c,(b,(a,())))))
-instance ReverseTupleC (a,(b,(c,(d,(e,(f,())))))) where
-  type ReverseTupleP (a,(b,(c,(d,(e,(f,())))))) = (f,(e,(d,(c,(b,(a,()))))))
-  reverseTupleC (a,(b,(c,(d,(e,(f,())))))) = (f,(e,(d,(c,(b,(a,()))))))
-instance ReverseTupleC (a,(b,(c,(d,(e,(f,(g,()))))))) where
-  type ReverseTupleP (a,(b,(c,(d,(e,(f,(g,()))))))) = (g,(f,(e,(d,(c,(b,(a,())))))))
-  reverseTupleC (a,(b,(c,(d,(e,(f,(g,()))))))) = (g,(f,(e,(d,(c,(b,(a,())))))))
-instance ReverseTupleC (a,(b,(c,(d,(e,(f,(g,(h,())))))))) where
-  type ReverseTupleP (a,(b,(c,(d,(e,(f,(g,(h,())))))))) = (h,(g,(f,(e,(d,(c,(b,(a,()))))))))
-  reverseTupleC (a,(b,(c,(d,(e,(f,(g,(h,())))))))) = (h,(g,(f,(e,(d,(c,(b,(a,()))))))))
-instance ReverseTupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,()))))))))) where
-  type ReverseTupleP (a,(b,(c,(d,(e,(f,(g,(h,(i,()))))))))) = (i,(h,(g,(f,(e,(d,(c,(b,(a,())))))))))
-  reverseTupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,()))))))))) = (i,(h,(g,(f,(e,(d,(c,(b,(a,())))))))))
-instance ReverseTupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,())))))))))) where
-  type ReverseTupleP (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,())))))))))) = (j,(i,(h,(g,(f,(e,(d,(c,(b,(a,()))))))))))
-  reverseTupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,())))))))))) = (j,(i,(h,(g,(f,(e,(d,(c,(b,(a,()))))))))))
-instance ReverseTupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,()))))))))))) where
-  type ReverseTupleP (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,()))))))))))) = (k,(j,(i,(h,(g,(f,(e,(d,(c,(b,(a,())))))))))))
-  reverseTupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,()))))))))))) = (k,(j,(i,(h,(g,(f,(e,(d,(c,(b,(a,())))))))))))
-instance ReverseTupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,(l,())))))))))))) where
-  type ReverseTupleP (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,(l,())))))))))))) = (l,(k,(j,(i,(h,(g,(f,(e,(d,(c,(b,(a,()))))))))))))
-  reverseTupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,(l,())))))))))))) = (l,(k,(j,(i,(h,(g,(f,(e,(d,(c,(b,(a,()))))))))))))
+-- | takes a flat n-tuple and creates a reversed inductive tuple. see 'Predicate.Prelude.PrintT'
+--
+-- >>> inductTupleC (123,'x',False,"abc")
+-- ("abc",(False,('x',(123,()))))
+--
+-- >>> inductTupleC (123,'x')
+-- ('x',(123,()))
+--
+class InductTupleC x where
+  type InductTupleP x
+  inductTupleC :: x -> InductTupleP x
+instance (GL.TypeError ('GL.Text "InductTupleC: inductive tuple cannot be empty")) => InductTupleC () where
+  type InductTupleP () = ()
+  inductTupleC () = ()
+instance InductTupleC (a,b) where
+  type InductTupleP (a,b) = (b,(a,()))
+  inductTupleC (a,b) = (b,(a,()))
+instance InductTupleC (a,b,c) where
+  type InductTupleP (a,b,c) = (c,(b,(a,())))
+  inductTupleC (a,b,c) = (c,(b,(a,())))
+instance InductTupleC (a,b,c,d) where
+  type InductTupleP (a,b,c,d) = (d,(c,(b,(a,()))))
+  inductTupleC (a,b,c,d) = (d,(c,(b,(a,()))))
+instance InductTupleC (a,b,c,d,e) where
+  type InductTupleP (a,b,c,d,e) = (e,(d,(c,(b,(a,())))))
+  inductTupleC (a,b,c,d,e) = (e,(d,(c,(b,(a,())))))
+instance InductTupleC (a,b,c,d,e,f) where
+  type InductTupleP (a,b,c,d,e,f) = (f,(e,(d,(c,(b,(a,()))))))
+  inductTupleC (a,b,c,d,e,f) = (f,(e,(d,(c,(b,(a,()))))))
+instance InductTupleC (a,b,c,d,e,f,g) where
+  type InductTupleP (a,b,c,d,e,f,g) = (g,(f,(e,(d,(c,(b,(a,())))))))
+  inductTupleC (a,b,c,d,e,f,g) = (g,(f,(e,(d,(c,(b,(a,())))))))
+instance InductTupleC (a,b,c,d,e,f,g,h) where
+  type InductTupleP (a,b,c,d,e,f,g,h) = (h,(g,(f,(e,(d,(c,(b,(a,()))))))))
+  inductTupleC (a,b,c,d,e,f,g,h) = (h,(g,(f,(e,(d,(c,(b,(a,()))))))))
+instance InductTupleC (a,b,c,d,e,f,g,h,i) where
+  type InductTupleP (a,b,c,d,e,f,g,h,i) = (i,(h,(g,(f,(e,(d,(c,(b,(a,())))))))))
+  inductTupleC (a,b,c,d,e,f,g,h,i) = (i,(h,(g,(f,(e,(d,(c,(b,(a,())))))))))
+instance InductTupleC (a,b,c,d,e,f,g,h,i,j) where
+  type InductTupleP (a,b,c,d,e,f,g,h,i,j) = (j,(i,(h,(g,(f,(e,(d,(c,(b,(a,()))))))))))
+  inductTupleC (a,b,c,d,e,f,g,h,i,j) = (j,(i,(h,(g,(f,(e,(d,(c,(b,(a,()))))))))))
+instance InductTupleC (a,b,c,d,e,f,g,h,i,j,k) where
+  type InductTupleP (a,b,c,d,e,f,g,h,i,j,k) = (k,(j,(i,(h,(g,(f,(e,(d,(c,(b,(a,())))))))))))
+  inductTupleC (a,b,c,d,e,f,g,h,i,j,k) = (k,(j,(i,(h,(g,(f,(e,(d,(c,(b,(a,())))))))))))
+instance InductTupleC (a,b,c,d,e,f,g,h,i,j,k,l) where
+  type InductTupleP (a,b,c,d,e,f,g,h,i,j,k,l) = (l,(k,(j,(i,(h,(g,(f,(e,(d,(c,(b,(a,()))))))))))))
+  inductTupleC (a,b,c,d,e,f,g,h,i,j,k,l) = (l,(k,(j,(i,(h,(g,(f,(e,(d,(c,(b,(a,()))))))))))))
 
-type family TupleLenT (t :: Type) :: Nat where
-  TupleLenT () = 0
-  TupleLenT (_,ts) = 1 GN.+ TupleLenT ts
-  TupleLenT  t = GL.TypeError (
-      'GL.Text "TupleLenT: expected a valid inductive tuple"
-      ':$$: 'GL.Text "t = "
-      ':<>: 'GL.ShowType t)
+-- | takes a list and converts to a reversed inductive tuple. see 'Predicate.Prelude.PrintL'
+--
+-- >>> inductListC @4 [10,12,13,1]
+-- (1,(13,(12,(10,()))))
+--
+-- >>> inductListC @2 ["ab","cc"]
+-- ("cc",("ab",()))
+--
+class InductListC (n :: Nat) a where
+  type InductListP n a
+  inductListC :: [a] -> InductListP n a
+instance (GL.TypeError ('GL.Text "InductListC: inductive tuple cannot be empty")) => InductListC 0 a where
+  type InductListP 0 a = ()
+  inductListC _ = error "InductListC 0: shouldnt be called"
+instance (GL.TypeError ('GL.Text "InductListC: inductive tuple cannot have one element")) => InductListC 1 a where
+  type InductListP 1 a = a
+  inductListC _ = error "InductListC 1: shouldnt be called"
+instance InductListC 2 a where
+  type InductListP 2 a = (a,(a,()))
+  inductListC [a,b] = (b,(a,()))
+  inductListC _ = error $ "inductListC: expected 2 values"
+instance InductListC 3 a where
+  type InductListP 3 a = (a,(a,(a,())))
+  inductListC [a,b,c] = (c,(b,(a,())))
+  inductListC _ = error $ "inductListC: expected 3 values"
+instance InductListC 4 a where
+  type InductListP 4 a = (a,(a,(a,(a,()))))
+  inductListC [a,b,c,d] = (d,(c,(b,(a,()))))
+  inductListC _ = error $ "inductListC: expected 4 values"
+instance InductListC 5 a where
+  type InductListP 5 a = (a,(a,(a,(a,(a,())))))
+  inductListC [a,b,c,d,e] = (e,(d,(c,(b,(a,())))))
+  inductListC _ = error $ "inductListC: expected 5 values"
+instance InductListC 6 a where
+  type InductListP 6 a = (a,(a,(a,(a,(a,(a,()))))))
+  inductListC [a,b,c,d,e,f] = (f,(e,(d,(c,(b,(a,()))))))
+  inductListC _ = error $ "inductListC: expected 6 values"
+instance InductListC 7 a where
+  type InductListP 7 a = (a,(a,(a,(a,(a,(a,(a,())))))))
+  inductListC [a,b,c,d,e,f,g] = (g,(f,(e,(d,(c,(b,(a,())))))))
+  inductListC _ = error $ "inductListC: expected 7 values"
+instance InductListC 8 a where
+  type InductListP 8 a = (a,(a,(a,(a,(a,(a,(a,(a,()))))))))
+  inductListC [a,b,c,d,e,f,g,h] = (h,(g,(f,(e,(d,(c,(b,(a,()))))))))
+  inductListC _ = error $ "inductListC: expected 8 values"
+instance InductListC 9 a where
+  type InductListP 9 a = (a,(a,(a,(a,(a,(a,(a,(a,(a,())))))))))
+  inductListC [a,b,c,d,e,f,g,h,i] = (i,(h,(g,(f,(e,(d,(c,(b,(a,())))))))))
+  inductListC _ = error $ "inductListC: expected 9 values"
+instance InductListC 10 a where
+  type InductListP 10 a = (a,(a,(a,(a,(a,(a,(a,(a,(a,(a,()))))))))))
+  inductListC [a,b,c,d,e,f,g,h,i,j] = (j,(i,(h,(g,(f,(e,(d,(c,(b,(a,()))))))))))
+  inductListC _ = error $ "inductListC: expected 10 values"
+instance InductListC 11 a where
+  type InductListP 11 a = (a,(a,(a,(a,(a,(a,(a,(a,(a,(a,(a,())))))))))))
+  inductListC [a,b,c,d,e,f,g,h,i,j,k] = (k,(j,(i,(h,(g,(f,(e,(d,(c,(b,(a,())))))))))))
+  inductListC _ = error $ "inductListC: expected 11 values"
+instance InductListC 12 a where
+  type InductListP 12 a = (a,(a,(a,(a,(a,(a,(a,(a,(a,(a,(a,(a,()))))))))))))
+  inductListC [a,b,c,d,e,f,g,h,i,j,k,l] = (l,(k,(j,(i,(h,(g,(f,(e,(d,(c,(b,(a,()))))))))))))
+  inductListC _ = error $ "inductListC: expected 12 values"
 
 -- partially apply the 2nd arg to an ADT -- $ and & work with functions only
 -- doesnt apply more than once because we need to eval it
@@ -1058,6 +1123,38 @@       'GL.Text "invalid ConsT instance"
       ':$$: 'GL.Text "s = "
       ':<>: 'GL.ShowType s)
+
+-- | used by "Predicate.Refined3" for extracting \'ip\' from a 4-tuple
+type family T_1 x where
+  T_1 '(a,b,c,d) = a
+  T_1 o = GL.TypeError (
+      'GL.Text "invalid T_1 instance"
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
+
+-- | used by "Predicate.Refined3" for extracting the boolean predicate \'op\' from a 4-tuple
+type family T_2 x where
+  T_2 '(a,b,c,d) = b
+  T_2 o = GL.TypeError (
+      'GL.Text "invalid T_2 instance"
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
+
+-- | used by "Predicate.Refined3" for extracting \'fmt\' from a 4-tuple
+type family T_3 x where
+  T_3 '(a,b,c,d) = c
+  T_3 o = GL.TypeError (
+      'GL.Text "invalid T_3 instance"
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
+
+-- | used by "Predicate.Refined3" for extracting the input type \'i\' from a 4-tuple
+type family T_4 x where
+  T_4 '(a,b,c,d) = d
+  T_4 o = GL.TypeError (
+      'GL.Text "invalid T_4 instance"
+      ':$$: 'GL.Text "o = "
+      ':<>: 'GL.ShowType o)
 
 -- | a typeclass for choosing which monad to run in
 class Monad m => MonadEval m where
src/Predicate/Util_TH.hs view
@@ -44,7 +44,7 @@ -- >$$(refinedTH 99) :: Refined (Between 100 125) Int
 --
 -- <interactive>:8:4: error:
---     * refinedTH: predicate failed with FalseP
+--     * refinedTH: predicate failed with FalseP (100 <= 99)
 --     * In the Template Haskell splice $$(refinedTH 99)
 --       In the expression:
 --           $$(refinedTH 99) :: Refined (Between 100 125) Int
@@ -79,7 +79,7 @@ --    |
 --    `- P 'asdf
 --
--- refinedTH: predicate failed with FailP "asdf"
+-- refinedTH: predicate failed with FailP "asdf" ((>>) lhs failed)
 --     * In the Template Haskell splice $$(refinedTH' o0 99)
 --       In the expression:
 --           $$(refinedTH' o2 99) ::
@@ -93,11 +93,11 @@   -> TH.Q (TH.TExp (Refined p i))
 refinedTH' opts i = do
   let msg0 = "refinedTH"
-  let ((bp,e),mr) = runIdentity $ newRefined @p opts i
+  let ((bp,(e,top)),mr) = runIdentity $ newRefined @p opts i
   case mr of
     Nothing ->
-      let msg1 = if oLite opts then "" else ("\n" ++ e ++ "\n")
-      in fail $ msg1 ++ msg0 ++ ": predicate failed with " ++ show bp -- ++ "\n" ++ e
+      let msg1 = if hasNoTree opts then "" else "\n" ++ e ++ "\n"
+      in fail $ msg1 ++ msg0 ++ ": predicate failed with " ++ show bp ++ " " ++ top
     Just r -> TH.TExp <$> TH.lift r
 
 -- | creates a 'Refined3.Refined3' refinement type with terse output
@@ -133,21 +133,15 @@ --
 -- *** Step 2. False Boolean Check(op) ***
 --
--- False False && True
+-- False 100 <= 99
 -- |
--- +- False 99 >= 100
--- |  |
--- |  +- P I
--- |  |
--- |  `- P '100
+-- +- P Id 99
 -- |
--- `- True  99 <= 125
---    |
---    +- P I
---    |
---    `- P '125
+-- +- P '100
+-- |
+-- `- P '125
 --
--- refined3TH: predicate failed with Step 2. False Boolean Check(op) | FalseP
+-- refined3TH: predicate failed with Step 2. False Boolean Check(op) | {100 <= 99}
 --     * In the Template Haskell splice $$(refined3TH' o2 99)
 --       In the expression:
 --           $$(refined3TH' o2 99) :: Refined3 Id (Between 100 125) Id Int
@@ -166,7 +160,7 @@       m3 = prt3Impl opts ret
   case mr of
     Nothing ->
-      let msg1 = if oLite opts then "" else (m3Long m3 ++ "\n")
+      let msg1 = if hasNoTree opts then "" else m3Long m3 ++ "\n"
       in fail $ msg1 ++ msg0 ++ ": predicate failed with " ++ (m3Desc m3 <> " | " <> m3Short m3)
     Just r -> TH.TExp <$> TH.lift r
test/TastyExtras.hs view
@@ -56,7 +56,7 @@ expectPE bp m = do
   x <- m
   print (x,bp)
-  bp @?= x
+  x @?= bp
 
 expectJ :: (HasCallStack, Show a, Eq a)
   => Either [String] a
test/TestJson.hs view
@@ -59,32 +59,38 @@      , age1 :: AgeR
      , likesPizza1 :: Bool
      , date1 :: DateTimeNR
-     , ipaddress1 :: Ip4R
+     , ipaddress1 :: Ip4R'
      } deriving (Show,Generic,Eq)
 
 instance ToJSON Person1
 instance FromJSON Person1
 
 type ValidName =
-         Guard (Printf "invalid name(%s)" Id)
+         Guard (PrintF "invalid name(%s)" Id)
         (Re "^[A-Z][a-z']+$" Id) >> 'True
 
-type NameR = Refined ValidName String
+type ValidName' = Msg "invalid name:" (Re "^[A-Z][a-z']+$" Id)
 
+type NameR = Refined ValidName' String
+
 type NameR1 = Refined (Name1 >> 'True) String
 type Name1 =
           Uncons
        >> 'Just Id
-       >> Guard (Printf "not upper first(%c)" (Fst Id)) (Fst Id >> '[Id] >> IsUpper)
-       >> Guard (Printf "not lower rest(%s)" (Snd Id)) (Snd Id >> IsLower)
+       >> Guard (PrintF "not upper first(%c)" (Fst Id)) (Fst Id >> '[Id] >> IsUpper)
+       >> Guard (PrintF "not lower rest(%s)" (Snd Id)) (Snd Id >> IsLower)
 
 type AgeR = Refined (Between 10 60) Int
 
 type Ip4R = MakeR3 '(Ip4ip, Ip4op >> 'True, Ip4fmt, String)
+type Ip4R' = MakeR3 '(Ip4ip, Ip4op', Ip4fmt, String)
 
-type Ip4ip = Map (ReadP Int) (Resplit "\\." Id)
-type Ip4op = Guard (Printf "expected length 4 found %d" Len) (Len >> Same 4)
-          >> GuardsN (Printf2 "guard(%d): expected between 0 and 255 found %d") 4 (Between 0 255)
-type Ip4fmt = Printfnt 4 "%03d.%03d.%03d.%03d"
+type Ip4ip = Map (ReadP Int Id) (Resplit "\\." Id)
+type Ip4op = Guard (PrintF "expected length 4 found %d" Len) (Len == 4)
+          >> GuardsN (PrintT "guard(%d): expected between 0 and 255 found %d" Id) 4 (Between 0 255)
 
-type DateTimeNR = MakeR3 DateTimeN
+type Ip4op' = Msg "length:" (Len == 4)
+          && BoolsN (PrintT "guard(%d): expected between 0 and 255 found %d" Id) 4 (Between 0 255)
+
+type Ip4fmt = PrintL 4 "%03d.%03d.%03d.%03d" Id
+
test/TestPredicate.hs view
@@ -54,13 +54,13 @@   , expectPE (PresentT (Right 12)) $ pl @(Not Id +++ Id) (Right 12)
   , expectPE (PresentT (Right 1)) $ pl @(HeadDef () Id +++ Id) (Right @[()] 1) -- breaks otherwise: Id says () -> () so has to be a list of [()]
   , expectPE (PresentT (Right 1)) $ pl @(HeadDef () Id +++ Id) (Right @[()] 1) -- this breaks! cos Left doesnt have a type
-  , expectPE FalseT $ pl @(Not (Fst Id >> Len >> Le 6)) ([2..7],True)
-  , expectPE TrueT $ pl @(Fst Id >> Len >> Le 6) ([2..7],True)
+  , expectPE FalseT $ pl @(Not (Fst Id >> Len <= 6)) ([2..7],True)
+  , expectPE TrueT $ pl @(Fst Id >> Len <= 6) ([2..7],True)
   , expectPE TrueT $ pl @(Length (Fst Id) <= 6) ([2..7],True)
-  , expectPE TrueT $ pl @(Fst Id >> (Len >> Le 6)) ([2..7],True)
+  , expectPE TrueT $ pl @(Fst Id >> (Len <= 6)) ([2..7],True)
   , expectPE FalseT $ pl @(HeadDef 12 (Fst Id) >> Le 6) ([],True)
   , expectPE TrueT $ pl @(HeadDef 1 (Fst Id) >> Le 6) ([],True)
-  , expectPE (FailT "Head(empty)") $ pl @(Head' (Fst Id) >> Le 6) ([] @Int, True)
+  , expectPE (FailT "Head(empty)") $ pl @(Head (Fst Id) >> Le 6) ([] @Int, True)
   , expectPE FalseT $ pl @(HeadDef 10 (Fst Id) >> Le 6) ([],True)
   , expectPE (FailT "zz") $ pl @(HeadFail "zz" (Fst Id) >> Le 6) ([],True)
   , expectPE (FailT "failed1") $ pl @((HeadFail "failed1" (Fst Id) >> Le 6) || 'False) ([],True)
@@ -68,13 +68,13 @@   , expectPE (FailT "failed3") $ pl @((Fst Id >> Failt _ "failed3" >> Le (6 %- 1)) || 'False) ([-5],True)
   , expectPE TrueT $ pl @(MaybeIn 'True Id) (Nothing @Bool) -- need @() else breaks
   , expectPE (PresentT 10) $ pl @(MaybeIn (Failt _ "failed4") Id) (Just 10)
-  , expectPE (PresentT 10) $ pl @(Just' Id) (Just 10)
+  , expectPE (PresentT 10) $ pl @(Just Id) (Just 10)
   , expectPE FalseT $ pl @(MaybeIn 'False Id) (Nothing @Bool) -- breaks otherwise
   , expectPE FalseT $ pl @(Id > "xx") "abc"
   , expectPE TrueT $ pl @(Id > "aa") "abc"
   , expectPE TrueT $ pl @(Gt 4) 5
-  , expectPE TrueT $ pl @(Ors (Map (Gt 3) (Fst Id))) ([10,12,3,5],"ss")
-  , expectPE FalseT $ pl @(Ands (Map (Gt 3) (Fst Id))) ([10,12,3,5],"ss")
+  , expectPE TrueT $ pl @(Any (Gt 3) (Fst Id)) ([10,12,3,5],"ss")
+  , expectPE FalseT $ pl @(All (Gt 3) (Fst Id)) ([10,12,3,5],"ss")
   , expectPE (PresentT [False,False,False,True]) $ pl @(Map (Mod Id 3) (Fst Id) >> Map (Gt 1) Id) ([10,12,3,5],"ss")
   , expectPE (PresentT (12,5)) $ pl @(Fst Id >> Dup >> (Ix 1 (Failp "failed5") *** Ix 3 (Failp "failed5")) >> Id) ([10,12,3,5],"ss")
   , expectPE FalseT $ pl @(Fst Id >> Dup >> (Ix 1 (Failp "failed5") *** Ix 3 (Failp "failed5")) >> Fst Id < Snd Id) ([10,12,3,5],"ss")
@@ -86,8 +86,8 @@   , expectPE FalseT $ pl @(Snd Id >> Len &&& Ix 3 (Failp "someval2") >> Fst Id < Snd Id) ('x',[1..5])
   , expectPE TrueT $ pl @(Snd Id >> Len &&& Ix 3 (Failp "someval3") >> Fst Id > Snd Id) ('x',[1..5])
   , expectPE FalseT $ pl @(Snd Id >> SplitAt 2 Id >> Len *** Len >> Fst Id > Snd Id) ('x',[1..5])
-  , expectPE FalseT $ pl @(Ors (Map (Same 2) Id)) [1,4,5]
-  , expectPE TrueT $ pl @(Ors (Map (Same 2) Id)) [1,4,5,2,1]
+  , expectPE FalseT $ pl @(Any (Same 2) Id) [1,4,5]
+  , expectPE TrueT $ pl @(Any (Same 2) Id) [1,4,5,2,1]
   , expectPE TrueT $ pl @(Elem Id '[2,3,4]) 2
   , expectPE FalseT $ pl @(Elem Id '[2,3,4]) 6
   , expectPE TrueT $ pl @(Elem Id '[13 % 2]) 6.5
@@ -108,11 +108,11 @@   , expectPE (PresentT []) $ pl @(MaybeIn MEmptyP Id) (Nothing @[Int])
   , expectPE (FailT "'Just found Nothing") $ pl @('Just (FailS "someval")) (Nothing @()) -- breaks otherwise
   , expectPE (PresentT (4,4)) $ pl @Dup 4
-  , expectPE (PresentT 3) $ pl @(Last' Id) [1,2,3]
-  , expectPE (PresentT 123) $ pl @(Just' Id >> Id) (Just 123)
+  , expectPE (PresentT 3) $ pl @(Last Id) [1,2,3]
+  , expectPE (PresentT 123) $ pl @(Just Id >> Id) (Just 123)
   , expectPE (FailT "Asdf") $ pl @(HeadFail "Asdf" Id) ([] @()) -- breaks otherwise
-  , expectPE (FailT "Head(empty)") $ pl @(Head' Id) ([] @Int)
-  , expectPE (FailT "Head(empty)") $ pl @(Head' Id) ([] @Double)
+  , expectPE (FailT "Head(empty)") $ pl @(Head Id) ([] @Int)
+  , expectPE (FailT "Head(empty)") $ pl @(Head Id) ([] @Double)
   , expectPE (FailT "Succ bounded failed") $ pl @(SuccB' Id) GT
   , expectPE (PresentT LT) $ pl @(SuccB 'LT Id) GT
   , expectPE (PresentT EQ) $ pl @(SuccB 'GT Id) LT
@@ -121,23 +121,23 @@   , expectPE (PresentT GT) $ pl @(PredB 'GT Id) LT
   , expectPE (PresentT EQ) $ pl @(PredB 'LT Id) GT
   , expectPE (PresentT EQ) $ pl @(PredB' Id) GT
-  , expectPE (FailT "ToEnum bounded failed") $ pl @(ToEnumBF Ordering) 44
-  , expectPE (PresentT LT) $ pl @(ToEnumB Ordering 'LT) 123
-  , expectPE (PresentT EQ) $ pl @(ToEnumB Ordering 'GT) 1
-  , expectPE (PresentT EQ) $ pl @(ToEnumBF Ordering) 1
+  , expectPE (FailT "ToEnum bounded failed") $ pl @(ToEnumBFail Ordering) 44
+  , expectPE (PresentT LT) $ pl @(ToEnumBDef Ordering 'LT) 123
+  , expectPE (PresentT EQ) $ pl @(ToEnumBDef Ordering 'GT) 1
+  , expectPE (PresentT EQ) $ pl @(ToEnumBFail Ordering) 1
   , expectPE (PresentT 11) $ pl @(Succ Id) 10
   , expectPE (FailT "Succ IO e=Prelude.Enum.Bool.succ: bad argument") $ pl @(Succ Id) True -- captures the exception
   , expectPE (PresentT ([4,5,6,7,8,9,10],[1,2,3])) $ pl @(Partition (Gt 3) Id) [1..10]
   , expectPE (PresentT ([2,4,6],[1,3,5])) $ pl @(Partition Even Id) [1..6]
-  , expectPE TrueT $ pl @(Partition Even Id >> Null *** (Len >> Gt 4) >> Fst Id == Snd Id) [1..6]
+  , expectPE TrueT $ pl @(Partition Even Id >> Null *** (Len > 4) >> Fst Id == Snd Id) [1..6]
   , expectPE (PresentT 5) $ pl @(Snd Id >> Snd Id >> Snd Id >> Snd Id >> Id) (9,(1,(2,(3,5))))
-  , expectPE (FailT "ExitWhen") $ pl @(HeadFail "failedn" Id &&& (Len >> Same 1 >> ExitWhen' Id) >> Fst Id) [3]
-  , expectPE (PresentT 3) $ pl @(HeadFail "failedn" Id &&& (Len >> Same 1 >> Not Id >> ExitWhen' Id) >> Fst Id) [3]
-  , expectPE (PresentT 3) $ pl @(HeadFail "failedn" Id &&& (Len >> Same 1 >> ExitWhen' (Not Id)) >> Fst Id) [3]
-  , expectPE (FailT "ExitWhen") $ pl @(ExitWhen' (Len >> Ne 1) >> HeadFail "failedn" Id) [3,1]
-  , expectPE (PresentT 3) $ pl @(ExitWhen' (Len >> Ne 1) >> HeadFail "failedn" Id) [3]
-  , expectPE TrueT $ pl @(ExitWhen' (Len >> Ne 1) >> HeadFail "failedn" Id >> Gt (20 %- 1 )) [3]
-  , expectPE FalseT $ pl @(ExitWhen' (Len >> Ne 1) >> HeadFail "failedn" Id >> Gt (20 %- 1 )) [-23]
+  , expectPE (FailT "ExitWhen") $ pl @(HeadFail "failedn" Id &&& (Len == 1 >> ExitWhen "ExitWhen" Id) >> Fst Id) [3]
+  , expectPE (PresentT 3) $ pl @(Head Id &&& (Len == 1 >> Not Id >> ExitWhen "ExitWhen" Id) >> Fst Id) [3]
+  , expectPE (PresentT 3) $ pl @(Head Id &&& (Len == 1 >> ExitWhen "ExitWhen" (Not Id)) >> Fst Id) [3]
+  , expectPE (FailT "ExitWhen") $ pl @(ExitWhen "ExitWhen" (Len /= 1) >> Head Id) [3,1]
+  , expectPE (PresentT 3) $ pl @(ExitWhen "ExitWhen" (Len /= 1) >> Head Id) [3]
+  , expectPE TrueT $ pl @(ExitWhen "ExitWhen" (Len /= 1) >> Head Id >> Gt (20 %- 1 )) [3]
+  , expectPE FalseT $ pl @(ExitWhen "ExitWhen" (Len /= 1) >> Head Id >> Gt (20 %- 1 )) [-23]
   , expectPE (PresentT (-1.0)) $ pl @(Negate Id >> Dup >> First (Succ Id) >> Swap >> Fst Id - Snd Id) 4
   , expectPE (PresentT (Right 12)) $ pl @(Not Id +++ Id) (Right @Bool 12)
   , expectPE (PresentT Cgt) $ pl @(FromEnum ("aa" ==! Id) >> ToEnum OrderingP Id) "aaaa"
@@ -157,8 +157,8 @@   , expectPE (PresentT [('a',4),('a',14),('b',2),('c',10),('d',12),('z',1)]) $ pl @(SortOn (Fst Id) Id) (zip "cabdaz" [10,4,2,12,14,1])
   , expectPE (FailT "asdf(4)") $ pl @(SortOn (FailS "asdf") Id) [10,4,2,12,14]
   , expectPE TrueT $ pl @(Min &&& Max >> Id >> Fst Id < Snd Id) [10,4,2,12,14]
-  , expectPE (FailT "ExitWhen") $ pl @(Partition (ExitWhen' (Gt 10) >> Gt 2) Id) [1..11]
-  , expectPE (PresentT [False,False,True,True,True]) $ pl @(Map (ExitWhen' (Gt 10) >> Gt 2) Id) [1..5]
+  , expectPE (FailT "ExitWhen") $ pl @(Partition (ExitWhen "ExitWhen" (Gt 10) >> Gt 2) Id) [1..11]
+  , expectPE (PresentT [False,False,True,True,True]) $ pl @(Map (ExitWhen "ExitWhen" (Gt 10) >> Gt 2) Id) [1..5]
   , expectPE (PresentT ([1,2],[3,4,5,6,7,8,9,10,11])) $ pl @(Break (Gt 2) Id) [1..11]
   , expectPE (PresentT ([1,2,3],[4,5,6,7,8,9,10,11])) $ pl @(Span (Lt 4) Id) [1..11]
   , expectPE (PresentT [GT,GT,LT,EQ]) $ pl @(Pairs >> Map (First (Succ Id >> Succ Id) >> Fst Id ==! Snd Id) Id) [1,2,3,6,8]
@@ -181,15 +181,15 @@   , expectPE (PresentT []) $ pl @(MaybeIn MEmptyP (Ones (ShowP Id))) (Nothing @String)
   , expectPE (PresentT "124") $ pl @(ShowP (Succ Id) ||| ShowP Id ) (Left @_ @() 123)
   , expectPE (PresentT "True") $ pl @(ShowP (Succ Id) ||| ShowP Id) (Right @Int True)
-  , expectPE (PresentT (123 % 4)) $ pl @(ReadP Rational) "123 % 4"
-  , expectPE (FailT "ReadP Ratio Integer (x123 % 4) failed") $ pl @(ReadP Rational) "x123 % 4"
+  , expectPE (PresentT (123 % 4)) $ pl @(ReadP Rational Id) "123 % 4"
+  , expectPE (FailT "ReadP Ratio Integer (x123 % 4) failed") $ pl @(ReadP Rational Id) "x123 % 4"
   , expectPE (PresentT "") $ pl @('Proxy >> MEmptyP) "abc"
   , expectPE (PresentT ["a","b","c"]) $ pl @(MEmptyT _ ||| Ones Id) (Right @() "abc")
   , expectPE (PresentT []) $ pl @(MEmptyT _ ||| Ones Id) (Left @_ @[String] ["ab"])
   , expectPE (PresentT ["a","b"]) $ pl @(MaybeIn MEmptyP (Ones Id)) (Just @String "ab")
   , expectPE (PresentT []) $ pl @(MaybeIn MEmptyP (Ones Id)) (Nothing @String)
-  , expectPE (PresentT (True, 13)) $ pl @(Not IsNothing &&& (Just' Id >> Id + 12)) (Just 1)
-  , expectPE (FailT "expected Just") $ pl @(Not IsNothing &&& (Just' Id >> Id + 12)) Nothing
+  , expectPE (PresentT (True, 13)) $ pl @(Not IsNothing &&& (Just Id >> Id + 12)) (Just 1)
+  , expectPE (FailT "Just(empty)") $ pl @(Not IsNothing &&& (Just Id >> Id + 12)) Nothing
   , expectPE (PresentT True) $ pl @(Thd Id >> Fst Id) (1,2,(True,4))
   , expectPE (PresentT True) $ pl @(Fst (Thd Id)) (1,2,(True,4))
   , expectPE (PresentT 'd') $ pl @(Id !! 3) ("asfd" :: T.Text)
@@ -211,12 +211,12 @@   , expectPE (PresentT 'a') $ pl @(Id !! 0) ('a','b','c')
   , expectPE (FailT "err") $ pl @(Id !! Failt _ "err") ('a','b','c')
   , expectPE (PresentT 3) $ pl @(Id !! "d") (M.fromList $ zip (map (:[]) "abcd") [0 ..])
-  , expectPE (PresentT 3) $ pl @(Id !! HeadFail "failedn" "d") (M.fromList $ zip "abcd" [0 ..]) -- had to String (instead of _) to keep this happy: ghci is fine
-  , expectPE (PresentT ()) $ pl @(Id !! HeadFail "failedn" "d") (S.fromList "abcd") -- had to String (instead of _) to keep this happy: ghci is fine
+  , expectPE (PresentT 3) $ pl @(Id !! Head "d") (M.fromList $ zip "abcd" [0 ..]) -- had to String (instead of _) to keep this happy: ghci is fine
+  , expectPE (PresentT ()) $ pl @(Id !! Head "d") (S.fromList "abcd") -- had to String (instead of _) to keep this happy: ghci is fine
   , expectPE (FailT "(!!) index not found") $ pl @(Id !! HeadFail "failedn" "e") (S.fromList "abcd") -- had to String (instead of _) to keep this happy: ghci is fine
-  , expectPE (PresentT 13.345) $ pl @(ExitWhen' (Re "^\\d+(?:\\.\\d+)?$" Id >> Not Id) >> ReadP Double) "13.345"
-  , expectPE (PresentT 13) $ pl @(ExitWhen' (Re "^\\d+(?:\\.\\d+)?$" Id >> Not Id) >> ReadP Double) "13"
-  , expectPE (FailT "regex failed") $ pl @(ExitWhen "regex failed" (Not (Re "^\\d+(?:\\.\\d+)?$" Id)) >> ReadP Double) "-13.4"
+  , expectPE (PresentT 13.345) $ pl @(Guard "regex failed" (Re "^\\d+(?:\\.\\d+)?$" Id) >> ReadP Double Id) "13.345"
+  , expectPE (PresentT 13) $ pl @(Guard "regex failed" (Re "^\\d+(?:\\.\\d+)?$" Id) >> ReadP Double Id) "13"
+  , expectPE (FailT "regex failed") $ pl @(ExitWhen "regex failed" (Not (Re "^\\d+(?:\\.\\d+)?$" Id)) >> ReadP Double Id) "-13.4"
   , expectPE (PresentT GT) $ pl @(FoldN 2 Id (Succ Id)) LT
   , expectPE (FailT "Succ IO e=Prelude.Enum.Ordering.succ: bad argument") $ pl @(FoldN 30 Id (Succ Id)) LT
   , expectPE (PresentT 'g') $ pl @(FoldN 6 Id (Succ Id)) 'a'
@@ -224,7 +224,7 @@   , expectPE (FailT "Regex failed to compile") $ pl @(Re "\\d{4}\\" Id) "ayx"
   , expectPE (PresentT LT) $ pl @(FoldN 0 Id (Succ Id)) LT
   , expectPE (PresentT LT) $ pl @(FoldN 2 Id (Succ Id) >> FoldN 2 Id (Pred Id)) LT
-  , expectPE (PresentT ["2","2"]) $ pl @(Map (Fst Id) (Rescan "." (ShowP Id)) >> FilterBy (Same "2") Id) 12324
+  , expectPE (PresentT ["2","2"]) $ pl @(Map (Fst Id) (Rescan "." (ShowP Id)) >> Filter (Same "2") Id) 12324
   , expectPE (PresentT [LT,LT,LT,GT,EQ,LT]) $ pl @((Ones Id << ShowP Id) >> Map (Fst Id ==! Snd Id) Pairs) 1234223
   , expectPE (PresentT [(0,'a'),(1,'b'),(2,'c'),(3,'d')]) $ pl @(IToList _) ("abcd" :: String)
   , expectPE (PresentT "abcd") $ pl @ToList (M.fromList $ zip [0..] "abcd")
@@ -234,11 +234,14 @@   , expectPE (FailT "err") $ pl @(MaybeIn (Failp "err") Id) (Nothing @Int)
   , expectPE (FailT "err") $ pl @(MaybeIn (Failp "err") Id) (Nothing @())
   , expectPE (PresentT [(0,'a'),(1,'b'),(2,'c'),(3,'d')]) $ pl @(IToList _) (M.fromList $ itoList ("abcd" :: String))
-  , expectPE (PresentT [('a',1),('b',2),('c',3),('d',4),('a',5),('b',6),('c',7)]) $ pl @(ZipL "abcd" Id) [1..7]
-  , expectPE (PresentT [('a',1),('b',2),('c',3),('d',4)]) $ pl @(ZipTrunc "abcd" Id) [1..7]
-  , expectPE (PresentT []) $ pl @(ZipTrunc "" Id) [1..7]
-  , expectPE (PresentT [(1 % 1,'a'),(2 % 1,'b'),(3 % 1,'c'),(1 % 1,'d')]) $ pl @(ZipL '[1 % 1 , 2 % 1 , 3 % 1 ] Id) "abcd"
-  , expectPE (PresentT []) $ pl @(ZipR (EmptyT _ Id) Id) "abcd"
+  , expectPE (PresentT [(1,'a'),(2,'b'),(3,'c'),(4,'d'),(99,'e'),(99,'f'),(99,'g')]) $ pl @(ZipL 99 Id "abcdefg") [1..4]
+  , expectPE (FailT "Zip(3,7) length mismatch") $ pl @(Zip "abc" Id) [1..7]
+  , expectPE (PresentT [(1 % 1,'a'),(2 % 1,'b'),(3 % 1,'c'),(99 % 4,'d'),(99 % 4,'e')]) $ pl @(ZipL (99 % 4) '[1 % 1 , 2 % 1 , 3 % 1 ] Id) "abcde"
+
+  , expectPE (PresentT [("X",'a'),("X",'b'),("X",'c'),("X",'d')]) $ pl @(ZipL "X" (EmptyT _ Id) Id) ("abcd" :: String)
+
+  , expectPE (FailT "ZipR(0,4) rhs would be truncated") $ pl @(ZipR (Char1 "Y") (EmptyT _ Id) Id) "abcd"
+
   , expectPE (PresentT [9,2,7,4]) $ pl @ToList (M.fromList (zip ['a'..] [9,2,7,4]))
   , expectPE (PresentT [(0,9),(1,2),(2,7),(3,4)]) $ pl @(IToList _) [9,2,7,4]
   , expectPE (PresentT [('a',9),('b',2),('c',7),('d',4)]) $ pl @(IToList _) (M.fromList (zip ['a'..] [9,2,7,4]))
@@ -259,21 +262,21 @@   , expectPE (PresentT ["123","2","3","5","6"]) $ pl @(Resplit "\\." Id) "123.2.3.5.6"
   , expectPE (PresentT [("1.2",["1","2"]),("3.4",["3","4"])]) $ pl @(Rescan "(\\d{1,3})(?:\\.(\\d{1,3}))+?" Id) "1.2.3.4" -- bizzare!
   , expectPE (PresentT [("1.2.3.4",["1","2","3","4"])]) $ pl @(Rescan "^(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})$" Id) "1.2.3.4" -- this is good!
-  , expectPE (PresentT [13,16,17]) $ pl @(Guard "err" (Len >> Gt 2) >> Map (Succ Id) Id) [12,15,16]
-  , expectPE (FailT "err found len=3") $ pl @(Guard (Printf "err found len=%d" Len) (Len >> Gt 5) >> Map (Succ Id) Id) [12,15,16]
-  , expectPE (FailT "Printf (IO e=printf: bad formatting char 'd')") $ pl @(Printf "someval %d" Id) ("!23"::String)
+  , expectPE (PresentT [13,16,17]) $ pl @(Guard "err" (Len > 2) >> Map (Succ Id) Id) [12,15,16]
+  , expectPE (FailT "err found len=3") $ pl @(Guard (PrintF "err found len=%d" Len) (Len > 5) >> Map (Succ Id) Id) [12,15,16]
+  , expectPE (FailT "PrintF (IO e=printf: bad formatting char 'd')") $ pl @(PrintF "someval %d" Id) ("!23"::String)
   , expectPE (PresentT [12,0,1,13,0,1,14,0,1,15,0,1,16]) $ pl @(Intercalate (Fst Id) (Snd Id)) ([0,1], [12,13,14,15,16])
   , expectPE (PresentT [12,-5,13,-5,14,-5,15,-5,16]) $ pl @((Pure [] (Negate Len) &&& Id) >> Intercalate (Fst Id) (Snd Id)) [12,13,14,15,16]
-  , expectPE (PresentT [13,16,17]) $ pl @(If (Len >> Gt 2) (Map (Succ Id) Id) (FailS "someval")) [12,15,16]
-  , expectPE (PresentT [13,16,17]) $ pl @(Guard' (Len >> Gt 2) >> Map (Succ Id) Id) [12,15,16]
-  , expectPE (FailT "err") $ pl @(ExitWhen "err" (Len >> Gt 2) >> Map (Succ Id) Id) [12,15,16]
-  , expectPE (PresentT [13]) $ pl @(ExitWhen "err" (Len >> Gt 2) >> Map (Succ Id) Id) [12]
-  , expectPE (FailT "err") $ pl @(Guard "err" (Len >> Gt 2) >> Map (Succ Id) Id) [12]
+  , expectPE (PresentT [13,16,17]) $ pl @(If (Len > 2) (Map (Succ Id) Id) (FailS "someval")) [12,15,16]
+  , expectPE (PresentT [13,16,17]) $ pl @(Guard "oops" (Len > 2) >> Map (Succ Id) Id) [12,15,16]
+  , expectPE (FailT "err") $ pl @(ExitWhen "err" (Len > 2) >> Map (Succ Id) Id) [12,15,16]
+  , expectPE (PresentT [13]) $ pl @(ExitWhen "err" (Len > 2) >> Map (Succ Id) Id) [12]
+  , expectPE (FailT "err") $ pl @(Guard "err" (Len > 2) >> Map (Succ Id) Id) [12]
   , expectPE (PresentT 12) $ pl @OneP [12]
   , expectPE (FailT "expected list of length 1 but found length=5") $ pl @OneP [1..5]
   , expectPE (FailT "expected list of length 1 but found length=0") $ pl @OneP ([] @())
   , expectPE (FailT "err(8)") $ pl @(Map (If (Lt 3) 'True (Failt _ "err")) Id) [1..10]
-  , expectPE (FailT "someval(8)") $ pl @(Map (If (Lt 3) 'True (Failt _ "someval")) Id) [1..10] -- use Guard ie Guard
+  , expectPE (FailT "someval(8)") $ pl @(Map (If (Lt 3) 'True (Failt _ "someval")) Id) [1..10]
   , expectPE (PresentT [True,True,False,False,False]) $ pl @(Map (If (Lt 3) 'True 'False) Id) [1..5]
   , expectPE (PresentT ["a","b","c"]) $ pl @(MaybeIn MEmptyP (Ones Id)) (Just @String "abc")
   , expectPE (FailT "someval") $ pl @(Guard "someval" (Len == 2) >> (ShowP Id &&& Id)) ([] @Int)
@@ -295,7 +298,7 @@   , expectPE (PresentT 17) $ pl @(FoldMap (SG.Max _) Id) [14 :: Int,8,17,13] -- cos Bounded!
   , expectPE FalseT $ pl @(Catch (Re "\\d+(" Id) 'False) "123"
   , expectPE TrueT $ pl @(Catch (Re "\\d+" Id) 'False) "123"
-  , expectPE (PresentT 3) $ pl @(Id !! Head' "d") (M.fromList $ zip "abcd" [0 ..])   -- use Char1 "d" instead of "d" >> Head'
+  , expectPE (PresentT 3) $ pl @(Id !! Head "d") (M.fromList $ zip "abcd" [0 ..])   -- use Char1 "d" instead of "d" >> Head
   , expectPE (PresentT 10) $ pl @(Id !! MEmptyT _) (Just 10)
   , expectPE (FailT "(!!) index not found") $ pl @(Id !! MEmptyT _) (Nothing @())
   , expectPE TrueT $ pl @((Len >> (Elem Id '[4,7,1] || (Mod Id 3 >> Same 0))) || (FoldMap (SG.Sum _) Id >> Gt 200)) [1..20]
@@ -303,15 +306,15 @@   , expectPE TrueT $ pl @((Len >> (Elem Id '[4,7,1] || (Mod Id 3 >> Same 0))) || (FoldMap (SG.Sum _) Id >> Gt 200)) []
   , expectPE (PresentT (False, 210)) $ pl @((Len >> (Elem Id '[4,7,1] || (Mod Id 3 >> Same 0))) &&& FoldMap (SG.Sum _) Id) [1..20]
   , expectPE (PresentT 'g') $ pl @(Id !! 6) ['a'..'z']
-  , expectPE (PresentT ([141,214,125,1,2,3333],(False,False))) $ pl @(Map (ReadP Int) (Resplit "\\." Id) >> '(Id, '(Len == 4, All (Between 0 255) Id))) "141.214.125.1.2.3333"
-  , expectPE (PresentT ([141,214,125,1,2,6],(False,True))) $ pl @(Map (ReadP Int) (Resplit "\\." Id) >> Id &&& ((Len == 4) &&& All (Between 0 255) Id)) "141.214.125.1.2.6"
-  , expectPE (FailT "ReadP Int () failed") $ pl @(Resplit "\\." Id >> Map (ReadP Int) Id >> Id &&& ((Len >> Same 4) &&& All (Between 0 255) Id)) "141.214.125."
+  , expectPE (PresentT ([141,214,125,1,2,3333],(False,False))) $ pl @(Map (ReadP Int Id) (Resplit "\\." Id) >> '(Id, '(Len == 4, All (Between 0 255) Id))) "141.214.125.1.2.3333"
+  , expectPE (PresentT ([141,214,125,1,2,6],(False,True))) $ pl @(Map (ReadP Int Id) (Resplit "\\." Id) >> Id &&& ((Len == 4) &&& All (Between 0 255) Id)) "141.214.125.1.2.6"
+  , expectPE (FailT "ReadP Int () failed") $ pl @(Resplit "\\." Id >> Map (ReadP Int Id) Id >> Id &&& ((Len == 4) &&& All (Between 0 255) Id)) "141.214.125."
   , expectPE (PresentT 9) $ pl @((Wrap _ Id *** Wrap (SG.Sum _) Id) >> Sapa >> Unwrap Id) (4,5)
   , expectPE (PresentT (SG.Sum 9)) $ pl @((Wrap _ Id *** Wrap _ Id) >> Sapa) (4,5)
   , expectPE (PresentT 9) $ pl @(Sapa' (SG.Sum _) >> Unwrap Id) (4,5)
   , expectPE (PresentT "abcde") $ pl @(ScanNA (Succ Id)) (4,'a')
-  , expectPE (PresentT ["abcd","bcd","cd","d",""]) $ pl @(ScanNA Tail) (4,"abcd" :: String)
-  , expectPE (PresentT ["abcd","bcd","cd","d",""]) $ pl @(Len &&& Id >> ScanNA Tail) "abcd"
+  , expectPE (PresentT ["abcd","bcd","cd","d",""]) $ pl @(ScanNA (Tail Id)) (4,"abcd" :: String)
+  , expectPE (PresentT ["abcd","bcd","cd","d",""]) $ pl @(Len &&& Id >> ScanNA (Tail Id)) "abcd"
   , expectPE (PresentT ["abcd","bcd","cd","d",""]) $ pl @Tails ("abcd" :: String)
   , expectPE (PresentT (-4,-2)) $ pl @(DivMod (Fst Id) (Snd Id)) (10,-3)
   , expectPE (PresentT (-3,1)) $ pl @(QuotRem (Fst Id) (Snd Id)) (10,-3)
@@ -323,52 +326,52 @@   , expectPE (FailT "len is bad") $ pl @Ip6 "FE80::203:Baff:FE77:326FF"
   , expectPE (FailT "not a hex") $ pl @Ip6 "FE80::203:Baff:GE77:326F"
   , expectPE (FailT "count is bad") $ pl @Ip6 "FE80::203:Baff:FE77:326F:::::"
-  , expectPE (PresentT 65504) $ pl @(ReadBaseInt 16) "fFe0"
-  , expectPE (PresentT "ffe0") $ pl @(ShowBase 16) 65504
-  , expectPE (FailT "invalid base 22") $ pl @(ReadBaseInt 22) "zzz"
-  , expectPE (PresentT ("ffe0","fFe0")) $ pl @((ReadBaseInt 16 &&& Id) >> First (ShowBase 16)) "fFe0"
+  , expectPE (PresentT 65504) $ pl @(ReadBaseInt 16 Id) "fFe0"
+  , expectPE (PresentT "ffe0") $ pl @(ShowBase 16 Id) 65504
+  , expectPE (FailT "invalid base 22") $ pl @(ReadBaseInt 22 Id) "zzz"
+  , expectPE (PresentT ("ffe0","fFe0")) $ pl @((ReadBaseInt 16 Id &&& Id) >> First (ShowBase 16 Id)) "fFe0"
   , expectPE FalseT $ pl @(Id == "Abc") "abc"
   , expectPE TrueT $ pl @("Abc" ==~ Id) "abc"
   , expectPE (PresentT LT) $ pl @("Abc" ==! Id) "abc"
   , expectPE (PresentT EQ) $ pl @("Abc" ===~ Id) "abc"
   , expectPE (PresentT 'd') $ pl @(Id !! 3) ('a','b','c','d','e')
   , expectPE (PresentT 99) $ pl @(Id !! "s") $ M.fromList [("t",1), ("s", 20), ("s", 99)]
-  , expectPE (PresentT 1) $ pl @(Head' Id) [1,2,3]
+  , expectPE (PresentT 1) $ pl @(Head Id) [1,2,3]
   , expectPE (PresentT (Just (1,[2,3,4,5]))) $ pl @Uncons [1..5] -- with Typeable would need to specify the type of [1..5]
   , expectPE (PresentT (Just ([1,2,3,4],5))) $ pl @Unsnoc [1..5]
   , expectPE (PresentT [(0,1),(1,2),(2,3),(3,4),(4,5)]) $ pl @(IToList _) [1..5]
   , expectPE (PresentT [(0,'a'),(1,'b'),(2,'c')]) $ pl @(IToList _) ['a','b','c']
-  , expectPE (PresentT [(1,'a'),(2,'b'),(3,'c'),(4,'d'),(5,'e')]) $ pl @(ZipTrunc (Fst Id) (Snd Id)) ([1..5],['a'..'z'])
   , expectPE (PresentT [1,2,3,8,8]) $ pl @(PadR 5 8 Id) [1..3]
   , expectPE (PresentT [1,2,3,4,5]) $ pl @(PadR 5 0 Id) [1..5]
   , expectPE (PresentT [1,2,3,4,5,6]) $ pl @(PadR 5 0 Id) [1..6]
   , expectPE (PresentT [0,0,1,2,3]) $ pl @(PadL 5 0 Id) [1..3]
   , expectPE (PresentT []) $ pl @(Catch (Resplit "\\d+(" Id) (Snd Id >> MEmptyP)) "123"
   , expectPE (FailT "someval(8)") $ pl @(Map (Guard "someval" (Lt 3) >> 'True) Id) [1::Int ..10]
-  , expectPE (FailT "3 < 3 | 4 < 3 | 5 < 3 | 6 < 3 | 7 < 3 | 8 < 3 | 9 < 3 | 10 < 3") $ pl @(Map (GuardSimple (Lt 3) >> 'True) Id) [1::Int ..10]
-  , expectPE (PresentT [True,True,True,True,True,True,True,True,True,True]) $ pl @(Map (GuardSimple (Ge 1) >> 'True) Id) [1::Int ..10]
+  , expectPE (FailT "(3 < 3) | (4 < 3) | (5 < 3) | (6 < 3) | (7 < 3) | (8 < 3) | (9 < 3) | (10 < 3)") $ pl @(Map (GuardSimple (Lt 3) >> 'True) Id) [1::Int .. 10]
+  , expectPE FalseT $ pl @(All (Lt 3) Id) [1::Int .. 10]
+  , expectPE (PresentT [True,True,True,True,True,True,True,True,True,True]) $ pl @(Map (GuardSimple (Ge 1) >> 'True) Id) [1::Int .. 10]
   , expectPE (PresentT [4,5,6]) $ pl @(ScanN 2 Id (Succ Id)) 4
   , expectPE (PresentT [4,4,4,4,4,4]) $ pl @(ScanN 5 Id Id) 4
-  , expectPE (PresentT [1,2,3,244]) $ pl @(Rescan Ip4RE Id >> OneP >> Map (ReadBaseInt 10) (Snd Id) >> Ip4guard) "1.2.3.244"
-  , expectPE (FailT "0-255") $ pl @(Rescan Ip4RE Id >> OneP >> Map (ReadBaseInt 10) (Snd Id) >> Ip4guard) "1.256.3.244"
-  , expectPE (FailT "0-255") $ pl @(Rescan "(\\d+)\\.?" Id >> ConcatMap (Snd Id) Id >> Map (ReadBaseInt 10) Id >> Ip4guard) "1.22.312.66"
-  , expectPE (FailT "4octets") $ pl @(Rescan "(\\d+)\\.?" Id >> ConcatMap (Snd Id) Id >> Map (ReadBaseInt 10) Id >> Ip4guard) "1.22.244.66.77"
-  , expectPE (PresentT [1,23,43,214]) $ pl @(Rescan "(\\d+)\\.?" Id >> ConcatMap (Snd Id) Id >> Map (ReadBaseInt 10) Id >> Ip4guard) "1.23.43.214"
-  , expectPE (PresentT (SG.Sum 123)) $ pl @(JustP Id) (Just (SG.Sum 123))
-  , expectPE (PresentT (SG.Sum 0)) $ pl @(JustP Id) (Nothing @(SG.Sum _))
+  , expectPE (PresentT [1,2,3,244]) $ pl @(Rescan Ip4RE Id >> OneP >> Map (ReadBaseInt 10 Id) (Snd Id) >> Ip4guard) "1.2.3.244"
+  , expectPE (FailT "0-255") $ pl @(Rescan Ip4RE Id >> OneP >> Map (ReadBaseInt 10 Id) (Snd Id) >> Ip4guard) "1.256.3.244"
+  , expectPE (FailT "0-255") $ pl @(Rescan "(\\d+)\\.?" Id >> ConcatMap (Snd Id) Id >> Map (ReadBaseInt 10 Id) Id >> Ip4guard) "1.22.312.66"
+  , expectPE (FailT "4octets") $ pl @(Rescan "(\\d+)\\.?" Id >> ConcatMap (Snd Id) Id >> Map (ReadBaseInt 10 Id) Id >> Ip4guard) "1.22.244.66.77"
+  , expectPE (PresentT [1,23,43,214]) $ pl @(Rescan "(\\d+)\\.?" Id >> ConcatMap (Snd Id) Id >> Map (ReadBaseInt 10 Id) Id >> Ip4guard) "1.23.43.214"
+  , expectPE (PresentT (SG.Sum 123)) $ pl @(JustDef (MEmptyT _) Id) (Just (SG.Sum 123))
+  , expectPE (PresentT (SG.Sum 0)) $ pl @(JustDef (MEmptyT _) Id) (Nothing @(SG.Sum _))
   , expectPE (PresentT (636 % 5)) $ pl @((ToRational 123 &&& Id) >> Fst Id + Snd Id) 4.2
   , expectPE (PresentT 127) $ pl @((123 &&& Id) >> Fst Id + Snd Id) 4
-  , expectPE (PresentT 256) $ pl @(Rescan "(?i)^\\\\x([0-9a-f]{2})$" Id >> OneP >> Snd Id >> OneP >> ReadBaseInt 16 >> Succ Id) "\\xfF"
-  , expectPE (PresentT 256) $ pl @(Rescan "(?i)^\\\\x(.{2})$" Id >> OneP >> Snd Id >> OneP >> ReadBaseInt 16 >> Succ Id) "\\xfF"
-  , expectPE (PresentT (("fF",(255,"ff")),False)) $ pl @(Rescan "(?i)^\\\\x([0-9a-f]{2})$" Id >> OneP >> Snd Id >> OneP >> (Id &&& (ReadBaseInt 16 >> (Id &&& ShowBase 16))) >> (Id &&& ((Id *** Snd Id) >> Fst Id == Snd Id))) "\\xfF"
-  , expectPE (PresentT [1,2,4,0]) $ pl @(Do '[Succ Id,Id,ShowP Id,Ones Id,Map (ReadBaseInt 8) Id]) 1239
-  , expectPE (FailT "invalid base 8") $ pl @(Do '[Pred Id,Id,ShowP Id,Ones Id,Map (ReadBaseInt 8) Id]) 1239
-  , expectPE (PresentT 47) $ pl @(ReadBaseInt 2) "101111"
+  , expectPE (PresentT 256) $ pl @(Rescan "(?i)^\\\\x([0-9a-f]{2})$" Id >> OneP >> Snd Id >> OneP >> ReadBaseInt 16 Id >> Succ Id) "\\xfF"
+  , expectPE (PresentT 256) $ pl @(Rescan "(?i)^\\\\x(.{2})$" Id >> OneP >> Snd Id >> OneP >> ReadBaseInt 16 Id >> Succ Id) "\\xfF"
+  , expectPE (PresentT (("fF",(255,"ff")),False)) $ pl @(Rescan "(?i)^\\\\x([0-9a-f]{2})$" Id >> OneP >> Snd Id >> OneP >> (Id &&& (ReadBaseInt 16 Id >> (Id &&& ShowBase 16 Id))) >> (Id &&& ((Id *** Snd Id) >> Fst Id == Snd Id))) "\\xfF"
+  , expectPE (PresentT [1,2,4,0]) $ pl @(Do '[Succ Id,Id,ShowP Id,Ones Id,Map (ReadBaseInt 8 Id) Id]) 1239
+  , expectPE (FailT "invalid base 8") $ pl @(Do '[Pred Id,Id,ShowP Id,Ones Id,Map (ReadBaseInt 8 Id) Id]) 1239
+  , expectPE (PresentT 47) $ pl @(ReadBaseInt 2 Id) "101111"
   , expectPE (PresentT [LT,EQ,GT,EQ,EQ,EQ,EQ,EQ,EQ,EQ]) $ pl @(ScanN 2 Id (Succ Id) >> PadR 10 (MEmptyT Ordering) Id) LT
   , expectPE (PresentT 12) $ pl @('This Id) (This 12)
   , expectPE (FailT "'This found That") $ pl @('This Id) (That @() 12)
-  , expectPE (PresentT (SG.Sum 12)) $ pl @(ThisP Id) (This @_ @() (SG.Sum 12))
-  , expectPE (PresentT ()) $ pl @(ThisP Id) (That 12)
+  , expectPE (PresentT (SG.Sum 12)) $ pl @(ThisDef (MEmptyT _) Id) (This @_ @() (SG.Sum 12))
+  , expectPE (PresentT ()) $ pl @(ThisDef (MEmptyT _) Id) (That 12)
   , expectPE (PresentT (SG.Sum 12)) $ pl @(ThisFail "sdf" Id) (This @_ @() (SG.Sum 12))
   , expectPE (FailT "sdf") $ pl @(ThisFail "sdf" Id) (That @() (SG.Sum 12))
   , expectPE (FailT "sdf") $ pl @(ThisFail "sdf" Id) (That @Int 12)
@@ -382,7 +385,7 @@   , expectPE (PresentT [("fe",["fe"]),("b1",["b1"]),("2a",["2a"])]) $ pl @(Rescan "([[:xdigit:]]{2})" Id) "wfeb12az"
   -- anchored means it has to start at the beginning: can have junk on the end which we cant detect but at least we know it starts at beginning
   , expectPE (FailT "Regex no results") $ pl @(Rescan' '[ 'Anchored ] "([[:xdigit:]]{2})" Id) "wfeb12az"
-  , expectPE (PresentT [('s',1),('d',2),('f',3),('x',4),('x',5)]) $ pl @(("sdf" &&& Id) >> ZipThese (Fst Id) (Snd Id) >> Map (TheseIn (Id &&& 0) (Head' "x" &&& Id) Id) Id) [1..5]
+  , expectPE (PresentT [('s',1),('d',2),('f',3),('x',4),('x',5)]) $ pl @(("sdf" &&& Id) >> ZipThese (Fst Id) (Snd Id) >> Map (TheseIn (Id &&& 0) (Head "x" &&& Id) Id) Id) [1..5]
   , expectPE (PresentT "abc") $ pl @"abc" ()
   , expectPE FalseT $ pl @(Not 'True) ()
   , expectPE TrueT $ pl @'True ()
@@ -395,34 +398,31 @@   , expectPE (PresentT "hhhhh") $ pl @(Do '["abc", "Def", "ggg", "hhhhh"]) ()
   , expectPE (PresentT GT) $ pl @(Do '[ 'LT, 'EQ, 'GT ]) ()
   , expectPE (PresentT (-3 % 1)) $ pl @(Do '[4 % 4,22 % 1 ,12 %- 4]) ()
-  , expectPE (PresentT [10,2,5,8]) $ pl @(GuardsQuickLax (Printf2 "guard(%d) %d is out of range") '[Between 0 11, Between 1 4,Between 3 5]) [10::Int,2,5,8]
-  , expectPE (PresentT [31,11,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP >> Map (ReadBaseInt 10) (Snd Id) >> Ddmmyyyyval) "31-11-1999"
-  , expectPE (PresentT [31,11,1999]) $ pl @(GuardsQuick (Printf2 "guard(%d) %d is out of range") '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11,1999::Int]
-  , expectPE (PresentT [31,11,1999,123,44]) $ pl @(GuardsQuickLax (Printf2 "guard(%d) %d is out of range") '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11,1999,123,44::Int]
-  , expectPE (FailT "Guards: data elements(2) /= predicates(3)") $ pl @(GuardsQuick (Printf2 "guard(%d) %d is out of range") '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11::Int]
-  , expectPE (FailT "guard(2) 13 is out of range") $ pl @(GuardsQuick (Printf2 "guard(%d) %d is out of range") '[Between 1 31, Between 1 12, Between 1990 2050]) [31,13,1999::Int]
-  , expectPE (FailT "guard(1) 0 is out of range") $ pl @(GuardsQuick (Printf2 "guard(%d) %d is out of range") '[Between 1 31, Between 1 12, Between 1990 2050]) [0,44,1999::Int]
-  , expectPE (PresentT (fromGregorian 1999 11 30)) $ pl @(ReadP Day) "1999-11-30"
-  , expectPE (FailT "ReadP Day (1999-02-29) failed") $ pl @(ReadP Day) "1999-02-29"
-  , expectPE (PresentT (TimeOfDay 14 59 20)) $ pl @(ReadP TimeOfDay) "14:59:20"
-  , expectPE (PresentT (TimeOfDay 26 61 61)) $ pl @(ReadP TimeOfDay) "26:61:61" -- yep: this is valid! need to do your own validation
+  , expectPE (PresentT [10,2,5]) $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 11, Between 1 4,Between 3 5]) [10::Int,2,5]
+  , expectPE (PresentT [31,11,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP >> Map (ReadBaseInt 10 Id) (Snd Id) >> Ddmmyyyyval) "31-11-1999"
+  , expectPE (PresentT [31,11,1999]) $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11,1999::Int]
+  , expectPE (FailT "Guards: data elements(2) /= predicates(3)") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11::Int]
+  , expectPE (FailT "guard(2) 13 is out of range") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]) [31,13,1999::Int]
+  , expectPE (FailT "guard(1) 0 is out of range") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]) [0,44,1999::Int]
+  , expectPE (PresentT (fromGregorian 1999 11 30)) $ pl @(ReadP Day Id) "1999-11-30"
+  , expectPE (FailT "ReadP Day (1999-02-29) failed") $ pl @(ReadP Day Id) "1999-02-29"
+  , expectPE (PresentT (TimeOfDay 14 59 20)) $ pl @(ReadP TimeOfDay Id) "14:59:20"
+  , expectPE (PresentT (TimeOfDay 26 61 61)) $ pl @(ReadP TimeOfDay Id) "26:61:61" -- yep: this is valid! need to do your own validation
   , expectPE (FailT "ParseTimeP TimeOfDay (%H:%M%S) failed to parse") $ pl @(ParseTimeP TimeOfDay "%H:%M%S" Id) "14:04:61"
-  , expectPE (PresentT (TimeOfDay 23 13 59)) $ pl @(Guard "hh:mm:ss regex failed" (Re HmsRE Id) >> ReadP TimeOfDay) "23:13:59"
-  , expectPE (FailT "hh:mm:ss regex failed") $ pl @(Guard "hh:mm:ss regex failed" (Re HmsRE Id) >> ReadP TimeOfDay) "23:13:60"
-  , expectPE (FailT "Guards: data elements(5) /= predicates(3)") $ pl @(GuardsQuick (Printf2 "guard(%d) %d is out of range") '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11,2000,1,2::Int]
-  , expectPE (PresentT [31,11,2000,1,2]) $ pl @(GuardsQuickLax (Printf2 "guard(%d) %d is out of range") '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11,2000,1,2::Int]
+  , expectPE (PresentT (TimeOfDay 23 13 59)) $ pl @(Guard "hh:mm:ss regex failed" (Re HmsRE Id) >> ReadP TimeOfDay Id) "23:13:59"
+  , expectPE (FailT "hh:mm:ss regex failed") $ pl @(Guard "hh:mm:ss regex failed" (Re HmsRE Id) >> ReadP TimeOfDay Id) "23:13:60"
+  , expectPE (FailT "Guards: data elements(5) /= predicates(3)") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11,2000,1,2::Int]
   , expectPE (PresentT [0,0,0,0,0,0,0,1,2,3]) $ pl @(PadL 10 0 Id) [1..3]
   , expectPE (PresentT (124,["1","2","2"])) $ pl @('Left Id >> (Succ Id &&& (Pred Id >> ShowP Id >> Ones Id))) (Left 123)
-  , expectPE (PresentT [1,2,3,4]) $ pl @(GuardsN (Printf2 "guard(%d) %d is out of range") 4 (Between 0 255)) [1,2,3,4::Int]
-  , expectPE (FailT "Guards: data elements(5) /= predicates(4)") $ pl @(GuardsN (Printf2 "guard(%d) %d is out of range") 4 (Between 0 255)) [1,2,3,4,5::Int]
-  , expectPE (FailT "Guards: data elements(3) /= predicates(4)") $ pl @(GuardsN (Printf2 "guard(%d) %d is out of range") 4 (Between 0 255)) [1,2,3::Int]
+  , expectPE (PresentT [1,2,3,4]) $ pl @(GuardsN (PrintT "guard(%d) %d is out of range" Id) 4 (Between 0 255)) [1,2,3,4::Int]
+  , expectPE (FailT "Guards: data elements(5) /= predicates(4)") $ pl @(GuardsN (PrintT "guard(%d) %d is out of range" Id) 4 (Between 0 255)) [1,2,3,4,5::Int]
+  , expectPE (FailT "Guards: data elements(3) /= predicates(4)") $ pl @(GuardsN (PrintT "guard(%d) %d is out of range" Id) 4 (Between 0 255)) [1,2,3::Int]
   , expectPE (PresentT (read "1999-01-01 12:12:12 Utc")) $ pl @(ParseTimeP UTCTime "%F %T" Id) "1999-01-01 12:12:12"
   , expectPE (PresentT 123) $ pl @(JustDef 0 Id) (Just 123)
   , expectPE (PresentT 0) $ pl @(JustDef 0 Id) Nothing
   , expectPE (PresentT 12) $ pl @(LastDef 0 Id) [1..12]
   , expectPE (PresentT 0) $ pl @(LastDef 0 Id) []
   , expectPE (PresentT (1,("asdf",True))) $ pl @'(1,'("asdf",'True)) ()
-  , expectPE (PresentT (1,("asdf",(True,())))) $ pl @(TupleI '[W 1,W "asdf",W 'True]) ()
   , expectPE (PresentT ("abc", True)) $ pl @(TheseId 'True "xyz") (This "abc")
   , expectPE (PresentT ("xyz", False)) $ pl @(TheseId 'True "xyz") (That False)
   , expectPE (PresentT ("abc", False)) $ pl @(TheseId 'True "xyz") (These "abc" False)
@@ -443,8 +443,8 @@   , expectPE (PresentT 3) $ pl @(Id !! FromStringP _ "d") (M.fromList $ zip (map T.singleton "abcd") [0 ..])
   -- use Fromstring
   , expectPE (PresentT 3) $ pl @(Id !! FromStringP _ "d") (M.fromList $ zip (map T.singleton "abcd") [0 ..])
-  , expectPE (PresentT [7,9,9,2,7,3,9,8,7,1,3]) $ pl @(Map (ReadP Int) (Ones Id) >> Guard "checkdigit fail" (Luhn Id)) "79927398713"
-  , expectPE (FailT "checkdigit fail") $ pl @(Map (ReadP Int) (Ones Id) >> Guard "checkdigit fail" (Luhn Id)) "79927398714"
+  , expectPE (PresentT [7,9,9,2,7,3,9,8,7,1,3]) $ pl @(Map (ReadP Int Id) (Ones Id) >> Guard "checkdigit fail" (Luhn Id)) "79927398713"
+  , expectPE (FailT "checkdigit fail") $ pl @(Map (ReadP Int Id) (Ones Id) >> Guard "checkdigit fail" (Luhn Id)) "79927398714"
   , expectPE (PresentT [10,14,15,9]) $ pl @(MM1 16 >> MM2 16) "aef9"
   , expectPE (FailT "invalid base 16") $ pl @(MM1 16 >> MM2 16) "aef9g"
   , expectPE (FailT "found empty") $ pl @(MM1 16 >> MM2 16) ""
@@ -458,12 +458,12 @@ -- works but way to difficult: use Guard to do all the work
 --  >pl @(((Rescan "([[:xdigit:]])" >> Map (Snd Id) >> (Id &&& Len)) &&& Len) >> Guard "notallmatched" ((Snd Id *** Id) >> Fst Id == Snd Id)) "134F"
 -- have to check the length of the match vs input to see that are the same
-  , expectPE (PresentT [1,3,4,15]) $ pl @(((Rescan "([[:xdigit:]])" Id >> Map (Snd Id >> OneP >> ReadBase Int 16) Id) &&& Id) >> Guard "notallmatched" ((Len *** Len) >> Fst Id == Snd Id) >> Fst Id) "134F"
-  , expectPE (FailT "notallmatched") $ pl @(((Rescan "([[:xdigit:]])" Id >> Map (Snd Id >> OneP >> ReadBase Int 16) Id) &&& Id) >> Guard "notallmatched" ((Len *** Len) >> Fst Id == Snd Id) >> Fst Id) "134g"
+  , expectPE (PresentT [1,3,4,15]) $ pl @(((Rescan "([[:xdigit:]])" Id >> Map (Snd Id >> OneP >> ReadBase Int 16 Id) Id) &&& Id) >> Guard "notallmatched" ((Len *** Len) >> Fst Id == Snd Id) >> Fst Id) "134F"
+  , expectPE (FailT "notallmatched") $ pl @(((Rescan "([[:xdigit:]])" Id >> Map (Snd Id >> OneP >> ReadBase Int 16 Id) Id) &&& Id) >> Guard "notallmatched" ((Len *** Len) >> Fst Id == Snd Id) >> Fst Id) "134g"
   , expectPE (PresentT True) $ pl @(FoldMap SG.Any Id) [False,False,True,False]
   , expectPE (PresentT False) $ pl @(FoldMap SG.All Id) [False,False,True,False]
-  , expectPE TrueT $ pl @(Map (ReadP _) (Ones Id) >> Luhn Id) "12345678903"
-  , expectPE FalseT $ pl @(Map (ReadP _) (Ones Id) >> Luhn Id) "12345678904"
+  , expectPE TrueT $ pl @(Map (ReadP _ Id) (Ones Id) >> Luhn Id) "12345678903"
+  , expectPE FalseT $ pl @(Map (ReadP _ Id) (Ones Id) >> Luhn Id) "12345678904"
   , expectPE (FailT "incorrect number of digits found 10 but expected 11 in [1234567890]") $ pl @(Luhn' 11) "1234567890"
   , expectPE (PresentT ([1,2],[3,4,5,6,7,8])) $ pl @(Break (If (Gt 2) 'True (If (Gt 4) (Failt _ "ASfd") 'False)) Id) [1..8]
   , expectPE (PresentT ([1,2],[3,4,5,6,7,8])) $ pl @(Break (Case 'False '[Gt 2,Gt 4] '[ W 'True, Failt _ "ASfd"] Id) Id) [1..8]  -- case version
@@ -478,10 +478,6 @@   , expectPE (PresentT (111,'b')) $ pl @('(123,Char1 "c") >> (Id - 12 *** Pred Id)) ()
   , expectPE (PresentT (SG.Min 19)) $ pl @((FromInteger _ 12 &&& Id) >> Fst Id + Snd Id) (SG.Min 7)
   , expectPE (PresentT (SG.Product 84)) $ pl @((FromInteger _ 12 &&& Id) >> Sapa) (SG.Product 7)
-  , expectPE (PresentT (123,((),()))) $ pl @(TupleI '[W 123,()]) 99
-  , expectPE (PresentT (4,(5,(6,(7,()))))) $ pl @(TupleI '[4,5,6,7]) 99
-  , expectPE (PresentT ("ss",(4,(SG.Min 9223372036854775807,())))) $ pl @(TupleI '[W "ss",W 4,MEmptyT (SG.Min Int)]) 99
-  , expectPE (PresentT ("ss",(4,(SG.Sum 0,())))) $ pl @(TupleI '[W "ss",W 4,MEmptyT (SG.Sum _)]) 99
   , expectPE (PresentT "xyxyxyxy") $ pl @(STimes (Fst Id) (Snd Id)) (4,['x','y'])
   , expectPE (PresentT (concat (replicate 16 "abc"))) $ pl @(FoldN 4 Id ((Id &&& Id) >> Sapa)) "abc"
   , expectPE (PresentT (concat (replicate 4 "abc"))) $ pl @(STimes (Fst Id) (Snd Id)) (4,"abc")
@@ -491,7 +487,7 @@   , expectPE (PresentT ([2,3,5,7,11,13], [1,4,6,8,9,10,12,14,15])) $ pl @(Partition (Prime Id) Id) [1..15]
   , expectPE (FailT "'Nothing found Just") $ pl @'Nothing (Just 12)
   , expectPE (PresentT (Just 10,((),()))) $ pl @(Id &&& '() &&& ()) (Just 10)
-  , expectPE (PresentT [(-999) % 1,10 % 1,20 % 1,(-999) % 1,30 % 1]) $ pl @(Map (Wrap (MM.First _) Id &&& (Pure Maybe (999 %- 1 ) >> Wrap (MM.First _) Id)) Id >> Map Sapa Id >> Map (Just' (Unwrap Id)) Id) [Nothing,Just 10,Just 20,Nothing,Just 30]
+  , expectPE (PresentT [(-999) % 1,10 % 1,20 % 1,(-999) % 1,30 % 1]) $ pl @(Map (Wrap (MM.First _) Id &&& (Pure Maybe (999 %- 1 ) >> Wrap (MM.First _) Id)) Id >> Map Sapa Id >> Map (Just (Unwrap Id)) Id) [Nothing,Just 10,Just 20,Nothing,Just 30]
   , expectPE (PresentT 12) $ pl @(MaybeIn 99 Id) (Just 12)
   , expectPE (PresentT 12) $ pl @(JustDef 99 Id) (Just 12)
   , expectPE (PresentT 99) $ pl @(MaybeIn 99 Id) Nothing
@@ -500,14 +496,14 @@   , expectPE (PresentT (-99)) $ pl @(JustDef (99 %- 1 ) Id) Nothing
   , expectPE (PresentT [1,2,3,4,12]) $ pl @(ParaN 5 (Guard "0-255" (Between 0 255))) [1,2,3,4,12]
   , expectPE (FailT "0-255") $ pl @(ParaN 5 (Guard "0-255" (Between 0 255))) [1,2,3,400,12]
-  , expectPE (PresentT ["141","021","003","000"]) $ pl @(ParaN 4 (Printf "%03d" Id)) [141,21,3,0::Int]
-  , expect3 (Right (unsafeRefined3 [1,2,3,4] "001.002.003.004")) $ eval3 @Ip4A @Ip4B @(ParaN 4 (Printf "%03d" Id) >> Concat (Intercalate '["."] Id)) ol "1.2.3.4"
-  , expect3 (Right (unsafeRefined3 [1,2,3,4] "abc__002__3__zzz")) $ eval3 @Ip4A @Ip4B @(Para '[W "abc",Printf "%03d" Id,Printf "%d" Id,W "zzz"] >> Concat (Intercalate '["__"] Id)) ol "1.2.3.4"
-  , expect3 (Right (unsafeRefined [1,2,3,4], "001.002.003.004")) $ eval3PX (Proxy @'(Ip4A, Ip4B, ParaN 4 (Printf "%03d" Id) >> Concat (Intercalate '["."] Id), _)) ol "1.2.3.4"
-  , expect3 (Right (unsafeRefined [1,2,3,4], "001.002.003.004")) $ eval3PX (mkProxy3 @Ip4A @Ip4B @(ParaN 4 (Printf "%03d" Id) >> Concat (Intercalate '["."] Id))) ol "1.2.3.4"
+  , expectPE (PresentT ["141","021","003","000"]) $ pl @(ParaN 4 (PrintF "%03d" Id)) [141,21,3,0::Int]
+  , expect3 (Right (unsafeRefined3 [1,2,3,4] "001.002.003.004")) $ eval3 @Ip4A @Ip4B @(ParaN 4 (PrintF "%03d" Id) >> Concat (Intercalate '["."] Id)) ol "1.2.3.4"
+  , expect3 (Right (unsafeRefined3 [1,2,3,4] "abc__002__3__zzz")) $ eval3 @Ip4A @Ip4B @(Para '[W "abc",PrintF "%03d" Id,PrintF "%d" Id,W "zzz"] >> Concat (Intercalate '["__"] Id)) ol "1.2.3.4"
+  , expect3 (Right (unsafeRefined [1,2,3,4], "001.002.003.004")) $ eval3PX (Proxy @'(Ip4A, Ip4B, ParaN 4 (PrintF "%03d" Id) >> Concat (Intercalate '["."] Id), _)) ol "1.2.3.4"
+  , expect3 (Right (unsafeRefined [1,2,3,4], "001.002.003.004")) $ eval3PX (mkProxy3' @_ @Ip4A @Ip4B @(ParaN 4 (PrintF "%03d" Id) >> Concat (Intercalate '["."] Id))) ol "1.2.3.4"
 
   -- keep the original value
-  , expect3 (Right $ unsafeRefined3 ("1.2.3.4", [1,2,3,4]) "001.002.003.004") $ eval3 @(Id &&& Ip4A) @(Snd Id >> Ip4B) @(Snd Id >> ParaN 4 (Printf "%03d" Id) >> Concat (Intercalate '["."] Id)) ol "1.2.3.4"
+  , expect3 (Right $ unsafeRefined3 ("1.2.3.4", [1,2,3,4]) "001.002.003.004") $ eval3 @(Id &&& Ip4A) @(Snd Id >> Ip4B) @(Snd Id >> ParaN 4 (PrintF "%03d" Id) >> Concat (Intercalate '["."] Id)) ol "1.2.3.4"
 
   -- need to fill in the types for both even in ghci
   , expectPE (PresentT (Just (SG.Sum 10))) $ pl @(Coerce2 (SG.Sum Int)) (Just (10 :: Int))
@@ -523,18 +519,18 @@   , expectPE (PresentT (Just [1,2,3,4,5])) $ pl @(Traverse (MaybeBool (Id >= 0) Id) Id) [1..5]
   , expectPE (PresentT Nothing) $ pl @(Traverse (MaybeBool (Id <= 3) Id) Id) [1..5]
 
-  , expectPE (FailT "Printf (IO e=printf: bad formatting char 's')") $ pl @(Printf "%-6s" Id) (1234 :: Int)
-  , expectPE (PresentT "0004d2") $ pl @(Printf "%06x" Id) (1234 :: Int)
+  , expectPE (FailT "PrintF (IO e=printf: bad formatting char 's')") $ pl @(PrintF "%-6s" Id) (1234 :: Int)
+  , expectPE (PresentT "0004d2") $ pl @(PrintF "%06x" Id) (1234 :: Int)
   , expectPE (PresentT (Left 123)) $ pl @(Pure (Either String) Id >> Swap) 123
-  , expectPE (PresentT [13,2,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP >> Map (ReadP Int) (Snd Id)) "13-02-1999"
-  , expectPE (PresentT [3,2,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP >> Map (ReadP Int) (Snd Id) >> Ddmmyyyyval) "03-02-1999"
-  , expectPE (FailT "guard(2) month 13 is out of range") $ pl @(Rescan DdmmyyyyRE Id >> OneP >> Map (ReadP Int) (Snd Id) >> Ddmmyyyyval) "12-13-1999"
+  , expectPE (PresentT [13,2,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP >> Map (ReadP Int Id) (Snd Id)) "13-02-1999"
+  , expectPE (PresentT [3,2,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP >> Map (ReadP Int Id) (Snd Id) >> Ddmmyyyyval) "03-02-1999"
+  , expectPE (FailT "guard(2) month 13 is out of range") $ pl @(Rescan DdmmyyyyRE Id >> OneP >> Map (ReadP Int Id) (Snd Id) >> Ddmmyyyyval) "12-13-1999"
   , expectPE (PresentT [[1],[2,3,4],[5,6,7,8],[9,10,11,12]]) $ pl @(SplitAts '[1,3,4] Id) [1..12]
-  , expectPE (PresentT [[1,2,3],[4]]) $ pl @(SplitAts '[3,1,1,1] Id >> FilterBy (Not Null) Id) [1..4]
-  , expectPE (PresentT 1) $ pl @(Msg (Printf "digits=%d" Len) (Head' Id)) [1..4]
+  , expectPE (PresentT [[1,2,3],[4]]) $ pl @(SplitAts '[3,1,1,1] Id >> Filter (Not Null) Id) [1..4]
+  , expectPE (PresentT 1) $ pl @(Msg (PrintF "digits=%d" Len) (Head Id)) [1..4]
   , expectPE (PresentT 10) $ pl @(Luhn' 4) "1230"
   , expectPE (FailT "expected 14 mod 10 = 0 but found 4") $ pl @(Luhn' 4) "1234"
-  , expectPE (PresentT "lhs = 123 rhs = asdf") $ pl @(Printf2 "lhs = %d rhs = %s") (123::Int,"asdf"::String)
+  , expectPE (PresentT "lhs = 123 rhs = asdf") $ pl @(PrintT "lhs = %d rhs = %s" Id) (123::Int,"asdf"::String)
   , expectPE TrueT $ pl @(DirExists ".") ()
   , expectPE FalseT $ pl @(DirExists "xxy") ()
   , expectPE TrueT $ pl @(FileExists ".ghci") ()
@@ -555,18 +551,14 @@   , expectPE (PresentT 24) $ pl @((Id <> Id) >> Unwrap Id) (SG.Sum 12)
   , expectPE (PresentT "abcdef") $ pl @(Fst Id <> (Snd Id >> Fst Id)) ("abc",("def",12))
   , expectPE (PresentT (SG.Sum 25)) $ pl @(Wrap _ 13 <> Id) (SG.Sum @Int 12)
-  , expectPE (PresentT 23) $ pl @(Fst Id + Last' (Snd Id)) (10,[12,13])
-  , expectPE (PresentT (-1,12)) $ pl @(DivMod (9 - Fst Id) (Last' (Snd Id))) (10,[12,13])
+  , expectPE (PresentT 23) $ pl @(Fst Id + Last (Snd Id)) (10,[12,13])
+  , expectPE (PresentT (-1,12)) $ pl @(DivMod (9 - Fst Id) (Last (Snd Id))) (10,[12,13])
   , expectPE (PresentT [True,False,False,True]) $ pl @(Para '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99,-999]
   , expectPE (FailT "Para: data elements(3) /= predicates(4)") $ pl @(Para '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99]
-  , expectPE (PresentT [True, False, False]) $ pl @(ParaLax '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99]
   , expectPE (FailT "Para: data elements(7) /= predicates(4)") $ pl @(Para '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99,-999,1,1,2]
-  , expectPE (FailT "guard(2) err 002") $ pl @(GuardsQuick (Printf2 "guard(%d) err %03d") '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99,-999]
-  , expectPE (FailT "Guards: data elements(3) /= predicates(4)") $ pl @(GuardsQuick (Printf2 "guard(%d) err %03d") '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99]
-  , expectPE (FailT "Guards: data elements(7) /= predicates(4)") $ pl @(GuardsQuick (Printf2 "guard(%d) err %03d") '[ W 'True, Ge 12, W 'True, Lt 2 ]) [1,22,-99,-999,1,1,2]
-  , expectPE (PresentT [1,22,-99,-999,1,1,2]) $ pl @(GuardsQuickLax (Printf2 "guard(%d) err %03d") '[ W 'True, Ge 12, W 'True, Lt 2 ]) [1,22,-99,-999,1,1,2]
-  , expectPE (PresentT [1,22]) $ pl @(GuardsQuickLax (Printf2 "guard(%d) err %03d") '[ W 'True, Ge 12, W 'True, Lt 2 ]) [1,22]
-  , expectPE (PresentT [1,22,-99,-999]) $ pl @(GuardsQuickLax (Printf2 "guard(%d) err %03d") '[ W 'True, Ge 12, W 'True, Lt 2 ]) [1,22,-99,-999]
+  , expectPE (FailT "guard(2) err 002") $ pl @(GuardsQuick (PrintT "guard(%d) err %03d" Id) '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99,-999]
+  , expectPE (FailT "Guards: data elements(3) /= predicates(4)") $ pl @(GuardsQuick (PrintT "guard(%d) err %03d" Id) '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99]
+  , expectPE (FailT "Guards: data elements(7) /= predicates(4)") $ pl @(GuardsQuick (PrintT "guard(%d) err %03d" Id) '[ W 'True, Ge 12, W 'True, Lt 2 ]) [1,22,-99,-999,1,1,2]
   , expectPE TrueT $ pl @(Fst Id /= Snd Id) ("ab","xyzabw")
   , expectPE FalseT $ pl @(Fst Id == Snd Id) ("ab","xyzabw")
   , expectPE (PresentT 157) $ pl @(Fst Id * (Snd Id >> Fst Id) + (Snd Id >> Snd Id) `Div` 2) (12,(13,3))
@@ -579,16 +571,16 @@   , expectPE (PresentT LT) $ pl @(Snd Id ==! Fst Id) ("aBc","AbC")
   , expectPE TrueT $ pl @(Fst Id ==~ Snd Id && Fst Id == Snd Id) ("Abc","Abc")
   , expectPE (PresentT (EQ,EQ)) $ pl @(Fst Id ===~ Snd Id &&& Fst Id ==! Snd Id) ("abc","abc")
-  , expectPE (PresentT "ask%dfas%kef00035 hey %") $ pl @(Printf "ask%%dfas%%kef%05d hey %%" Id) (35 :: Int)
+  , expectPE (PresentT "ask%dfas%kef00035 hey %") $ pl @(PrintF "ask%%dfas%%kef%05d hey %%" Id) (35 :: Int)
   , expectPE (PresentT 100) $ pl @(Id !! 2 !! 0) [[1..5],[10..14],[100..110]]
   , expectPE (FailT "(!!) index not found") $ pl @(Id !! 1 !! 7) [[1..5],[10..14],[100..110]]
   , expectPE (PresentT '2') $ pl @(IxL Id 1 (Char1 "x")) ("123" :: T.Text)
   , expectPE (PresentT 'x') $ pl @(IxL Id 15 (Char1 "x")) ("123" :: T.Text)
-  , expectPE (FailT "someval int=45") $ pl @(Fail () (Printf "someval int=%d" Id)) (45 :: Int)
-  , expectPE (FailT "failing with 45") $ pl @(If (Gt 4) (Fail (Hole _) (Printf "failing with %d" Id)) ()) 45
-  , expectPE (PresentT 21) $ pl @(If (Gt 4) (Fail (Hole _) (Printf "failing with %d" Id)) (Id * 7)) 3
-  , expectPE (PresentT ["2","1"]) $ pl @(If (Gt 4) (Fail (Hole _) (Printf "failing with %d" Id)) (Id * 7 >> ShowP Id >> Ones Id)) 3
-  , expectPE (FailT "failing with 19") $ pl @(If (Gt 4) (Fail (Hole _) (Printf "failing with %d" Id)) (ShowP (Id * 7) >> Ones Id)) 19
+  , expectPE (FailT "someval int=45") $ pl @(Fail () (PrintF "someval int=%d" Id)) (45 :: Int)
+  , expectPE (FailT "failing with 45") $ pl @(If (Gt 4) (Fail (Hole _) (PrintF "failing with %d" Id)) ()) 45
+  , expectPE (PresentT 21) $ pl @(If (Gt 4) (Fail (Hole _) (PrintF "failing with %d" Id)) (Id * 7)) 3
+  , expectPE (PresentT ["2","1"]) $ pl @(If (Gt 4) (Fail (Hole _) (PrintF "failing with %d" Id)) (Id * 7 >> ShowP Id >> Ones Id)) 3
+  , expectPE (FailT "failing with 19") $ pl @(If (Gt 4) (Fail (Hole _) (PrintF "failing with %d" Id)) (ShowP (Id * 7) >> Ones Id)) 19
   , expectPE (PresentT 31) $ pl @(DoN 4 (Id + 7)) 3
   , expectPE (PresentT 9) $ pl @(DoN 4 9) ()
   , expectPE (PresentT 3) $ pl @(Do '[1,2,3]) ()
@@ -601,36 +593,30 @@   , expectPE (PresentT (These 'x' True)) $ pl @(MkThese Id 'True) 'x'
   , expectPE (PresentT 123) $ pl @(MaybeIn 123 Id) (Nothing @Int)
   , expectPE (PresentT 9) $ pl @(MaybeIn 123 Id) (Just 9)
-  , expectPE (PresentT [1,2,3]) $ pl @(Just' Id) (Just [1,2,3])
-  , expectPE (FailT "expected Just") $ pl @(Just' Id) (Nothing @[Int])
-  , expectPE (PresentT (66788,26232)) $ pl @(Last' Id >> Id * 123 >> Dup >> (Pred Id *** (ShowP Id >> Rescan "(\\d{2})" Id >> Concat (ConcatMap (Snd Id) Id) >> ReadBase Int 16))) [12,13,543::Int]
-  , expectPE (PresentT "d=009 s=ab") $ pl @(Printfn "d=%03d s=%s" Id) (9::Int,("ab"::String,()))
-  , expectPE (PresentT "d=009 s=ab c=x f=1.54") $ pl @(Printfn "d=%03d s=%s c=%c f=%4.2f" Id) (9::Int,("ab"::String,('x',(1.54::Float,()))))
-  , expectPE (FailT "Printfn(4)(IO e=printf: formatting string ended prematurely)") $ pl @(Printfn "d=%03d s=%s" Id) (9::Int,("ab"::String,('x',(1.54::Float,()))))
-  , expectPE (PresentT "lhs = 123 rhs = asdf c=120") $ pl @(Printf3 "lhs = %d rhs = %s c=%d") (123::Int,"asdf"::String,'x')
+  , expectPE (PresentT [1,2,3]) $ pl @(Just Id) (Just [1,2,3])
+  , expectPE (FailT "Just(empty)") $ pl @(Just Id) (Nothing @[Int])
+  , expectPE (PresentT (66788,26232)) $ pl @(Last Id >> Id * 123 >> Dup >> (Pred Id *** (ShowP Id >> Rescan "(\\d{2})" Id >> Concat (ConcatMap (Snd Id) Id) >> ReadBase Int 16 Id))) [12,13,543::Int]
+  , expectPE (PresentT "d=009 s=ab") $ pl @(PrintT "d=%03d s=%s" Id) (9::Int,"ab"::String)
+  , expectPE (PresentT "d=009 s=ab c=x f=1.54") $ pl @(PrintT "d=%03d s=%s c=%c f=%4.2f" Id) (9::Int,"ab"::String,'x',1.54::Float)
+  , expectPE (FailT "PrintT(IO e=printf: formatting string ended prematurely)") $ pl @(PrintT "d=%03d s=%s" Id) (9::Int, "ab"::String,'x',1.54::Float)
+  , expectPE (PresentT "lhs = 123 rhs = asdf c=120") $ pl @(PrintT "lhs = %d rhs = %s c=%d" Id) (123::Int,"asdf"::String,'x')
   , expectPE (PresentT (1,('x',(True,())))) $ pl @(Fst Id &&& Snd Id &&& Thd Id &&& ()) (1,'x',True)
   , expectPE (PresentT (1,('x',(True,())))) $ pl @(Fst Id &&& Snd Id &&& Thd Id &&& ()) (1,'x',True)
   , expectPE (PresentT (1,(1.4,("aaa",())))) $ pl @(Fst Id &&& Snd Id &&& Thd Id &&& ()) (1,1.4,"aaa")
-  , (@?=) ("xx",(True,('x',(1,())))) (reverseTupleC (1,('x',(True,("xx",())))))
-  , expectPE (PresentT "hello d=12 z someval") $ pl @(TupleI '[W 12, Char1 "z", W "someval"] >> Printfn "hello d=%d %c %s" Id) ()
-  , expectPE (PresentT "ipaddress 001.002.003.004") $ pl @(TupleI '[1,2,3,4] >> Printfn "ipaddress %03d.%03d.%03d.%03d" Id) ()
-  , expectPE (PresentT (1,(2,(3,(4,()))))) $ pl @(TupleI '[1,2,3,4]) 4
-  , expectPE (PresentT (4,(3,(2,(1,()))))) $ pl @(TupleI '[1,2,3,4] >> ReverseTupleN) 4
-  , expectPE (PresentT (1,(2,(3,(4,()))))) $ pl @(TupleI '[1,2,3,4] >> ReverseTupleN >> ReverseTupleN) 4
+  , expectPE (PresentT "hello d=12 z someval") $ pl @(PrintT "hello d=%d %c %s" '(12, Char1 "z", "someval")) ()
+  , expectPE (PresentT "ipaddress 001.002.003.004") $ pl @(PrintT "ipaddress %03d.%03d.%03d.%03d" '(1,2,3,4)) ()
 
-  , expectPE (PresentT "001.002.003.004") $ pl @(Printfnt 4 "%03d.%03d.%03d.%03d") [1,2,3,4::Int]
-  , expectPE (FailT "TupleList(4) is strict and has 1 extra element") $ pl @(Printfnt 4 "%03d.%03d.%03d.%03d") [1,2,3,4,5::Int]
-  , expectPE (FailT "TupleList(4) no data left") $ pl @(Printfnt 4 "%03d.%03d.%03d.%03d") [1,2,3::Int]
+  , expectPE (PresentT "001.002.003.004") $ pl @(PrintL 4 "%03d.%03d.%03d.%03d" Id) [1,2,3,4::Int]
+  , expectPE (FailT "PrintL(4) arg count=5") $ pl @(PrintL 4 "%03d.%03d.%03d.%03d" Id) [1,2,3,4,5::Int]
+  , expectPE (FailT "PrintL(4) arg count=3") $ pl @(PrintL 4 "%03d.%03d.%03d.%03d" Id) [1,2,3::Int]
 
-  , expectPE (PresentT "001.002.003.004") $ pl @(PrintfntLax 4 "%03d.%03d.%03d.%03d") [1,2,3,4::Int]
-  , expectPE (PresentT "001.002.003.004") $ pl @(PrintfntLax 4 "%03d.%03d.%03d.%03d") [1,2,3,4,5::Int]
-  , expectPE (FailT "TupleListLax(4) no data left") $ pl @(PrintfntLax 4 "%03d.%03d.%03d.%03d") [1,2,3::Int]
+  , expectPE (PresentT "001.002.003.004") $ pl @(PrintL 4 "%03d.%03d.%03d.%03d" Id) [1,2,3,4::Int]
   , expectPE (FailT "Pairs no data found") $ pl @Pairs ([] @())
   , expectPE (FailT "Pairs only one element found") $ pl @Pairs [1]
   , expectPE (PresentT [(1,2)]) $ pl @Pairs [1,2]
   , expectPE (PresentT [(1,2),(2,3)]) $ pl @Pairs [1,2,3]
   , expectPE (PresentT [(1,2),(2,3),(3,4)]) $ pl @Pairs [1,2,3,4]
-  , expectPE (PresentT "1    2 3 004") $ pl @(PrintfntLax 4 "%d %4d %-d %03d") [1..10::Int]
+  , expectPE (PresentT "1    2 3 004") $ pl @(PrintL 4 "%d %4d %-d %03d" Id) [1..4::Int]
   , expectPE (PresentT "2019-08-17") $ pl @(FormatTimeP "%Y-%m-%d" Id) (read "2019-08-17" :: Day)
   , expectPE (PresentT (20,20)) $ pl @(Dup << Fst Id * Snd Id) (4,5)
   , expectPE (PresentT (20,20)) $ pl @(Fst Id * Snd Id >> Dup) (4,5)
@@ -660,9 +646,7 @@   , expectPE (PresentT False) $ pl @(FromList (M.Map _ _) >> I !! Char1 "y") [('x',True),('y',False)]
   , expectPE (PresentT (Just False)) $ pl @(FromList (M.Map _ _) >> Lookup Id (Char1 "y")) [('x',True),('y',False)]
   , expectPE (PresentT Nothing) $ pl @(FromList (M.Map _ _) >> Lookup Id (Char1 "z")) [('x',True),('y',False)]
-  , expectPE (FailT "index('z') not found") $ pl @(FromList (M.Map _ _) >> (Char1 "z" &&& Lookup Id (Char1 "z")) >> If (Snd Id >> IsNothing) (ShowP (Fst Id) >> Fail I (Printf "index(%s) not found" Id) >> 'False) (Snd Id >> 'Just Id)) [('x',True),('y',False)]
-  , expectPE (PresentT True) $ pl @(FromList (M.Map _ _) >> (Char1 "z" &&& Lookup Id (Char1 "x")) >> If (Snd Id >> IsNothing) (ShowP (Fst Id) >> Fail I (Printf "index(%s) not found" Id) >> 'False) (Snd Id >> 'Just Id)) [('x',True),('y',False)]
-  , expectPE (FailT "index('z') not found") $ pl @(FromList (M.Map _ _) >> Lookup' _ Id (Char1 "z")) [('x',True),('y',False)]
+  , expectPE (FailT "(!!) index not found") $ pl @(FromList (M.Map _ _) >> Id !! Char1 "z") [('x',True),('y',False)]
   , expectPE (PresentT ["abc","bcd","cde","def","efg","fgh","ghi","hi","i"]) $ pl @(Unfoldr (If Null (MkNothing _) ('(Take 3 Id, Drop 1 Id) >> MkJust Id)) Id) "abcdefghi"
   , expectPE (PresentT [[1,2],[3,4],[5]]) $ pl @(Unfoldr (If Null (MkNothing _) (Pure _ (SplitAt 2 Id))) Id) [1..5]
   , expectPE (PresentT [[1,2],[3,4],[5]]) $ pl @(Unfoldr (MaybeBool (Not Null) (SplitAt 2 Id)) Id) [1..5]
@@ -696,11 +680,9 @@   , expectPE (PresentT (0.8 :: Float)) $ pl @(FromRational Float (4 % 5)) ()
   , expectPE (PresentT (14 % 1)) $ pl @(ToRational 14) ()
   , expectPE (PresentT ('y',3)) $ pl @(Id !! 1) [('x',14),('y',3),('z',5)]
-  , expectPE (PresentT ('y',3)) $ pl @(Id !!! 1) [('x',14),('y',3),('z',5)]
   , expectPE (PresentT (Just ('y',3))) $ pl @(Lookup Id 1) [('x',14),('y',3),('z',5)]
   , expectPE (PresentT Nothing) $ pl @(Lookup Id 14) [('x',14),('y',3),('z',5)]
-  , expectPE (PresentT ('y',3)) $ pl @(Lookup' _ Id 1) [('x',14),('y',3),('z',5)]
-  , expectPE (FailT "index(14) not found") $ pl @(Lookup' _ Id 14) [('x',14),('y',3),('z',5)]
+  , expectPE (FailT "(!!) index not found") $ pl @(Id !! 14) [('x',14),('y',3),('z',5)]
   , expectPE (PresentT 99) $ pl @(Fst Id) (99,'a',False,1.3)
   , expectPE (PresentT 'a') $ pl @(Snd Id) (99,'a',False,1.3)
   , expectPE (PresentT False) $ pl @(Thd Id) (99,'a',False,1.3)
@@ -716,21 +698,21 @@   , expectPE (PresentT (-5 % 3)) $ pl @(5 %- 1 / Fst Id) (3,'x')
   , expectPE (PresentT (-5 % 3)) $ pl @(Snd Id / Fst Id) (-3,5)
   , expectPE (FailT "(/) zero denominator") $ pl @(Snd Id / Fst Id) (0,5)
-  , expectPE (PresentT 16) $ pl @(Foldl (Guard "someval" (Fst Id < Snd Id) >> Snd Id) (Head' Id) Tail) [1,4,7,9,16]
-  , expectPE (FailT "7 not less than 6") $ pl @(Foldl (Guard (Printf2 "%d not less than %d") (Fst Id < Snd Id) >> Snd Id) (Head' Id) Tail) [1,4,7,6,16::Int]
-  , expectPE (PresentT (True,16)) $ pl @(Foldl (If ((Fst Id >> Fst Id) && (Snd Id > Snd (Fst Id))) '( 'True, Snd Id ) '( 'False, Snd (Fst Id) )) '( 'True, Head' Id ) Tail) [1,4,7,9,16]
-  , expectPE (PresentT (False,16)) $ pl @(Foldl (If ((Fst Id >> Fst Id) && (Snd Id > Snd (Fst Id))) '( 'True, Snd Id ) '( 'False, Snd (Fst Id) )) '( 'True, Head' Id ) Tail) [1,4,7,9,16,2]
+  , expectPE (PresentT 16) $ pl @(Foldl (Guard "someval" (Fst Id < Snd Id) >> Snd Id) (Head Id) (Tail Id)) [1,4,7,9,16]
+  , expectPE (FailT "7 not less than 6") $ pl @(Foldl (Guard (PrintT "%d not less than %d" Id) (Fst Id < Snd Id) >> Snd Id) (Head Id) (Tail Id)) [1,4,7,6,16::Int]
+  , expectPE (PresentT (True,16)) $ pl @(Foldl (If ((Fst Id >> Fst Id) && (Snd Id > Snd (Fst Id))) '( 'True, Snd Id ) '( 'False, Snd (Fst Id) )) '( 'True, Head Id ) (Tail Id)) [1,4,7,9,16]
+  , expectPE (PresentT (False,16)) $ pl @(Foldl (If ((Fst Id >> Fst Id) && (Snd Id > Snd (Fst Id))) '( 'True, Snd Id ) '( 'False, Snd (Fst Id) )) '( 'True, Head Id ) (Tail Id)) [1,4,7,9,16,2]
   , expectPE (PresentT (False,7))
      $ pl @(Foldl (If (Fst (Fst Id))
                     (If (Snd Id > Snd (Fst Id))
                        '( 'True, Snd Id )
                        '( 'False, Snd (Fst Id) )
                     ) (Fst Id))
-                   '( 'True, Head' Id) Tail) [1,4,7,6,16]
-  , expectPE (PresentT [1,2,3,4]) $ pl @(Init' Id) [1..5]
-  , expectPE (FailT "Init(empty)") $ pl @(Init' Id) ([] @())
-  , expectPE (PresentT [2,3,4,5]) $ pl @(Tail' Id) [1..5]
-  , expectPE (FailT "Tail(empty)") $ pl @(Tail' Id) ([] @())
+                   '( 'True, Head Id) (Tail Id)) [1,4,7,6,16]
+  , expectPE (PresentT [1,2,3,4]) $ pl @(Init Id) [1..5]
+  , expectPE (FailT "Init(empty)") $ pl @(Init Id) ([] @())
+  , expectPE (PresentT [2,3,4,5]) $ pl @(Tail Id) [1..5]
+  , expectPE (FailT "Tail(empty)") $ pl @(Tail Id) ([] @())
   , expectPE (PresentT [10,12,13]) $ pl @(CatMaybes Id) [Just 10, Just 12, Nothing, Just 13]
   , expectPE (PresentT [5,4,3,2,1]) $ pl @(Foldl (Snd Id :+ Fst Id) (MEmptyT [_]) Id) [1..5]
   , expectPE (PresentT (map SG.Min [9,10,11,12,13])) $ pl @(EnumFromTo (Pure SG.Min 9) (Pure _ 13)) ()
@@ -751,11 +733,11 @@   -- check for infinite loops
   , expectPE (FailT "Unfoldr (9999,1):failed at i=100") $ pl @(IterateNUntil 9999 'False I) 1
   , expectPE (FailT "Scanl:failed at i=100") $ pl @(Foldl (Fst Id) '() (EnumFromTo 1 9999)) ()
-  , expectPE (PresentT "a=9 b=rhs") $ pl @(TheseX (Printf "a=%d" (Succ (Snd Id))) ("b=" <> Snd Id) (Snd Id >> Printf2 "a=%d b=%s") Id) (These @Int 9 "rhs")
-  , expectPE (PresentT "a=10") $ pl @(TheseX (Printf "a=%d" (Succ (Snd Id))) ("b=" <> Snd Id) (Snd Id >> Printf2 "a=%d b=%s") Id) (This @Int 9)
-  , expectPE (PresentT "b=rhs") $ pl @(TheseX (Printf "a=%d" (Succ (Snd Id))) ("b=" <> Snd Id) (Snd Id >> Printf2 "a=%d b=%s") Id) (That @Int "rhs")
-  , expectPE (PresentT ([] @Int)) $ pl @(HeadP Id) (map (:[]) ([] @Int))
-  , expectPE (PresentT ([10] :: [Int])) $ pl @(HeadP Id) (map (:[]) ([10..14] :: [Int]))
+  , expectPE (PresentT "a=9 b=rhs") $ pl @(TheseX (PrintF "a=%d" (Succ (Snd Id))) ("b=" <> Snd Id) (PrintT "a=%d b=%s" (Snd Id)) Id) (These @Int 9 "rhs")
+  , expectPE (PresentT "a=10") $ pl @(TheseX (PrintF "a=%d" (Succ (Snd Id))) ("b=" <> Snd Id) (PrintT "a=%d b=%s" (Snd Id)) Id) (This @Int 9)
+  , expectPE (PresentT "b=rhs") $ pl @(TheseX (PrintF "a=%d" (Succ (Snd Id))) ("b=" <> Snd Id) (PrintT "a=%d b=%s" (Snd Id)) Id) (That @Int "rhs")
+  , expectPE (PresentT ([] @Int)) $ pl @(HeadDef (MEmptyT _) Id) (map (:[]) ([] @Int))
+  , expectPE (PresentT ([10] :: [Int])) $ pl @(HeadDef (MEmptyT _) Id) (map (:[]) ([10..14] :: [Int]))
   , expectPE (PresentT 10) $ pl @(HeadDef (Fst Id) (Snd Id)) (99,[10..14])
   , expectPE (PresentT 99) $ pl @(HeadDef (Fst Id) (Snd Id)) (99,[] @Int)
   , expectPE (PresentT 43) $ pl @(HeadDef 43 (Snd Id)) (99,[] @Int)
@@ -767,20 +749,20 @@   , expectPE (PresentT 23) $ pl @(LookupDef '[1,2,3,4,5,6] 99 (Fst Id)) (23,'x')
   , expectPE (PresentT 5) $ pl @(LookupDef '[1,2,3,4,5,6] 4 999) (23,'x')
   , expectPE (PresentT 999) $ pl @(LookupDef '[1,2,3,4,5,6] 40 999) (23,'x')
-  , expectPE (PresentT (SG.Min 5)) $ pl @(LookupP (Fst Id) 4) (map SG.Min [1::Int .. 10],'x')
-  , expectPE (PresentT (mempty @(SG.Min _))) $ pl @(LookupP (Fst Id) 999) (map SG.Min [1::Int .. 10],'x')
+  , expectPE (PresentT (SG.Min 5)) $ pl @(LookupDef (Fst Id) 4 (MEmptyT _)) (map SG.Min [1::Int .. 10],'x')
+  , expectPE (PresentT (mempty @(SG.Min _))) $ pl @(LookupDef (Fst Id) 999 (MEmptyT _)) (map SG.Min [1::Int .. 10],'x')
   , expectPE (FailT "someval") $ pl @(LookupFail "someval" (Fst Id) 999) (map SG.Min [1::Int .. 10],'x')
   , expectPE (FailT "abcsomeval") $ pl @(Fail (Snd Id >> Unproxy) (Fst Id <> "someval")) ("abc",Proxy @Int)
-  , expectPE (FailT "char=x") $ pl @(LookupFail (Printf "char=%c" (Snd Id)) (Fst Id) 49) (map SG.Min [1::Int ..10],'x')
-  , expectPE (FailT "someval=13") $ pl @(LeftFail (Printf "someval=%d" (Fst Id)) (Snd Id)) (13::Int,Right @(SG.Sum Int) "abc")
-  , expectPE (FailT "someval=Right \"abc\"") $ pl @(LeftFail (Printf "someval=%s" (ShowP Id)) Id) (Right @(SG.Sum Int) "abc")
-  , expectPE (FailT "msg=Abc def") $ pl @(HeadFail (Printf "msg=%s def" (Fst Id)) (Snd Id)) ("Abc" :: String,[]::[Int])
+  , expectPE (FailT "char=x") $ pl @(LookupFail (PrintF "char=%c" (Snd Id)) (Fst Id) 49) (map SG.Min [1::Int ..10],'x')
+  , expectPE (FailT "someval=13") $ pl @(LeftFail (PrintF "someval=%d" (Fst (Snd Id))) (Snd Id)) (13::Int,Right @(SG.Sum Int) "abc")
+  , expectPE (FailT "someval=abc") $ pl @(LeftFail (PrintF "someval=%s" (Fst Id)) Id) (Right @(SG.Sum Int) ("abc" :: String))
+  , expectPE (FailT "msg=Abc def") $ pl @(HeadFail (PrintF "msg=%s def" (Fst Id)) (Snd Id)) ("Abc" :: String,[]::[Int])
   , expectPE (PresentT 'c') $ pl @(LookupDef' (Fst Id) (Snd Id) (Char1 "xx") Id) (['a'..'e'],2)
   , expectPE (PresentT 'x') $ pl @(LookupDef' (Fst Id) (Snd Id) (Char1 "xx") Id) (['a'..'e'],999)
   , expectPE (PresentT 'x') $ pl @(LookupDef' (Fst Id) (Snd Id) (Char1 "xx") Id) ([],2)
   , expectPE (PresentT 'x') $ pl @(LookupDef' (Fst Id) (Snd Id) (Char1 "xx") (Snd Id)) ('w',([],2))
   , expectPE (PresentT 'c') $ pl @(LookupDef' (Fst Id) (Snd Id) (Fst Id) (Snd Id)) ('x',(['a'..'e'],2))
-  , expectPE (PresentT(SG.Min 13)) $ pl @(LookupP' (Fst Id) (Snd Id) (Snd Id)) ('x',(map SG.Min [10..15::Int], 3))
+  , expectPE (PresentT(SG.Min 13)) $ pl @(LookupDef' (Fst Id) (Snd Id) (MEmptyT _) (Snd Id)) ('x',(map SG.Min [10..15::Int], 3))
 
   , expectPE (PresentT 9) $ pl @(HeadDef 9 (Fst Id)) ([],True)
   , expectPE (PresentT 1) $ pl @(HeadDef 9 (Fst Id)) ([1..5],True)
@@ -793,45 +775,27 @@   , expectPE (PresentT [9,7]) $ pl @(InitDef '[9,7] (Fst Id)) ([],True)
   , expectPE (PresentT [1,2,3,4]) $ pl @(InitDef '[9,7] (Fst Id)) ([1..5],True)
   , expectPE (PresentT [10,11,12,13,14]) $ pl @(InitDef '[3] (Fst Id)) ([10..15],True)
-  , expectPE (PresentT [10,11,12,13,14]) $ pl @(InitP (Fst Id)) ([10..15],True)
-  , expectPE (PresentT []) $ pl @(InitP (Fst Id)) ([] @Int,True)
 
   , expectPE (PresentT [9,7]) $ pl @(TailDef '[9,7] (Fst Id)) ([],True)
   , expectPE (PresentT [2,3,4,5]) $ pl @(TailDef '[9,7] (Fst Id)) ([1..5],True)
   , expectPE (PresentT [11,12,13,14,15]) $ pl @(TailDef '[3] (Fst Id)) ([10..15],True)
-  , expectPE (PresentT [11,12,13,14,15]) $ pl @(TailP (Fst Id)) ([10..15],True)
-  , expectPE (PresentT []) $ pl @(TailP (Fst Id)) ([] @Int,True)
 
-  , expectPE (FailT "a=4 b=someval") $ pl @(TailFail (Snd Id >> Printf2 "a=%d b=%s") (Fst Id)) ([]::[()],(4::Int,"someval" :: String))
-  , expectPE (PresentT 3) $ pl @(JustDef' 44 (Fst Id >> Fst Id >> Fst Id) (Snd Id)) (3,Just 20)
-  , expectPE (PresentT 999) $ pl @(JustDef' 44 999 (Snd Id)) ("xxx",Just 20)
-  , expectPE (PresentT "xxabcd") $ pl @(JustDef' "dd" (Fst (Fst (Fst Id)) <> Snd Id) (Snd Id)) ("xx",Just "abcd")
-  , expectPE (PresentT "dd") $ pl @(JustDef' "dd" (Fst (Fst (Fst Id)) <> Snd Id) (Snd Id)) ("xx",Nothing)
-  , expectPE (PresentT "xx") $ pl @(JustDef' (Fst Id) (Fst (Fst (Fst Id)) <> Snd Id) (Snd Id)) ("xx",Nothing)
-
-  , expectPE (PresentT 3) $ pl @(JustDef' 44 (Snd (Fst (Fst Id))) (Fst Id)) (Just 20,3)
-  , expectPE (PresentT 999) $ pl @(JustDef' 44 999 (Fst Id)) (Just 20,"xxx")
-  , expectPE (PresentT "xxabcd") $ pl @(JustDef' "dd" (Snd (Fst (Fst Id)) <> Snd Id) (Fst Id)) (Just "abcd","xx")
-  , expectPE (PresentT "dd")   $ pl @(JustDef' "dd" (Snd (Fst (Fst Id)) <> Snd Id) (Fst Id)) (Nothing,"xx")
-  , expectPE (PresentT "xx")   $ pl @(JustDef' (Snd Id) (Snd (Fst (Fst Id)) <> Snd Id) (Fst Id)) (Nothing,"xx")
-
-  , expectPE (PresentT "aabb") $ pl @(JustDef''' (Fst Id) (Fst (Fst Id) <> Snd Id) (Snd Id)) ("aa", Just "bb")
-  , expectPE (PresentT "aa") $ pl @(JustDef''' (Fst Id) (Fst (Fst Id) <> Snd Id) (Snd Id)) ("aa", Nothing)
-  , expectPE (PresentT "ssbb") $ pl @(JustDef''' (Fst Id) ("ss" <> Snd Id) (Snd Id)) ("aa", Just "bb")
+  , expectPE (FailT "a=4 b=someval") $ pl @(TailFail (PrintT "a=%d b=%s" (Snd Id)) (Fst Id)) ([]::[()],(4::Int,"someval" :: String))
 
-  , expectPE (PresentT (Just 1)) $ pl @Fmap_1 (Just (1,'x'))
-  , expectPE (PresentT (Just 'x')) $ pl @Fmap_2 (Just (1,'x'))
-  , expectPE (PresentT (Nothing @Int)) $ pl @Fmap_2 (Nothing @(Char,Int))
-  , expectPE (PresentT [1,2,3]) $ pl @Fmap_1 [(1,'x'), (2,'y'), (3,'z')]
-  , expectPE (PresentT (Right 'x')) $ pl @Fmap_2 (Right @() (1,'x'))
-  , expectPE (PresentT (Left @_ @Double "x")) $ pl @Fmap_2 (Left @_ @(Int,Double) "x")
+  , expectPE (PresentT (Just 1)) $ pl @FMapFst (Just (1,'x'))
+  , expectPE (PresentT (Just 'x')) $ pl @FMapSnd (Just (1,'x'))
+  , expectPE (PresentT (Nothing @Int)) $ pl @FMapSnd (Nothing @(Char,Int))
+  , expectPE (PresentT [1,2,3]) $ pl @FMapFst [(1,'x'), (2,'y'), (3,'z')]
+  , expectPE (PresentT (Right 'x')) $ pl @FMapSnd (Right @() (1,'x'))
+  , expectPE (PresentT (Left @_ @Double "x")) $ pl @FMapSnd (Left @_ @(Int,Double) "x")
 
   , expectPE (PresentT [1,10,99]) $ pl @Thiss [This 1, This 10,That 'x', This 99, That 'y']
   , expectPE (PresentT "xy") $ pl @Thats [This 1, This 10,That 'x', This 99, That 'y']
   , expectPE (PresentT ("xabz",[1,10])) $ pl @PartitionEithers [Left 'x', Right 1,Left 'a', Left 'b',Left 'z', Right 10]
-  , expectPE (FailT "found rhs=Right 10") $ pl @(LeftFail (Printf "found rhs=%s" (ShowP Id)) Id) (Right @String 10)
-  , expectPE (FailT "found rhs=23") $ pl @(LeftFail (Printf "found rhs=%d" (Snd Id >> Snd Id)) (Snd Id >> Fst Id)) ('x',(Right @() 10,23::Int))
-  , expectPE (PresentT "abc") $ pl @(LeftFail (Printf "found rhs=%d" (Snd Id >> Snd Id)) (Snd Id >> Fst Id)) ('x',(Left @_ @() "abc",23::Int))
+  -- need Either a b to be fully typed unfortunately
+  , expectPE (FailT "found rhs=10") $ pl @(LeftFail (PrintF "found rhs=%d" (Fst Id)) Id) (Right @String @Int 10)
+  , expectPE (FailT "found rhs=23") $ pl @(LeftFail (PrintF "found rhs=%d" (Snd Id >> Snd Id >> Snd Id)) (Snd Id >> Fst Id)) ('x',(Right @() 10,23::Int))
+  , expectPE (PresentT "abc") $ pl @(LeftFail (PrintF "found rhs=%d" (Snd (Snd (Snd Id)))) (Fst (Snd Id))) ('x',(Left @_ @() "abc",23::Int))
   , expectPE (PresentT ([1,4,10],"xy",[(9,'z'),(8,'y')])) $ pl @PartitionThese [This 1,That 'x',This 4,That 'y',These 9 'z',This 10,These 8 'y']
   , expectPE (PresentT [('a',1),('a',10),('z',14),('m',22)]) $ pl @(SortOn (Snd Id) (Snd Id)) ((),[('z',14),('a',10),('m',22),('a',1)])
   , expectPE (PresentT [('z',1),('m',22),('a',10)]) $ pl @(SortOnDesc (Fst Id) (Snd Id)) ((),[('z',1),('a',10),('m',22)])
@@ -840,10 +804,10 @@   , expectPE (PresentT ["aa","cx","by","az"]) $ pl @(SortBy (OrdA Reverse) Id) ["az","by","cx","aa"]
   , expectPE (PresentT [('a',10),('a',9),('m',22),('m',10),('z',1)]) $ pl @(SortOn (Fst Id) Id) [('z',1),('a',10),('m',22),('a',9),('m',10)]
   , expectPE (PresentT [('a',9),('a',10),('m',10),('m',22),('z',1)]) $ pl @(SortOn Id Id) [('z',1),('a',10),('m',22),('a',9),('m',10)]
-  , expectPE (PresentT (False,9)) $ pl @(Just' Uncons >> Foldl (If (Fst (Fst Id)) (If (Snd (Fst Id) < Snd Id) '( 'True,Snd Id) '( 'False, Snd Id)) (Fst Id)) '( 'True,Fst Id) (Snd Id)) [-10,-2,2,3,4,10,9,11]
-  , expectPE (PresentT (True,11)) $ pl @(Just' Uncons >> Foldl (If (Fst (Fst Id)) (If (Snd (Fst Id) < Snd Id) '( 'True,Snd Id) '( 'False, Snd Id)) (Fst Id)) '( 'True,Fst Id) (Snd Id)) [-10,2,3,4,10,11]
-  , expectPE (FailT "pivot=5 value=3(2)") $ pl @(SortBy (If (Fst Id==5 && Snd Id==3) (FailPrt2 _ "pivot=%d value=%d") 'GT) (Snd Id)) ((), [5,7,3,1,6,2,1,3])
-  , expectPE (PresentT [1,1,2,3,3,5,6,7]) $ pl @(SortBy (If (Fst Id==50 && Snd Id==3) (FailPrt2 _ "pivot=%d value=%d") (OrdA Id)) (Snd Id)) ((), [5,7,3,1,6,2,1,3])
+  , expectPE (PresentT (False,9)) $ pl @(Just Uncons >> Foldl (If (Fst (Fst Id)) (If (Snd (Fst Id) < Snd Id) '( 'True,Snd Id) '( 'False, Snd Id)) (Fst Id)) '( 'True,Fst Id) (Snd Id)) [-10,-2,2,3,4,10,9,11]
+  , expectPE (PresentT (True,11)) $ pl @(Just Uncons >> Foldl (If (Fst (Fst Id)) (If (Snd (Fst Id) < Snd Id) '( 'True,Snd Id) '( 'False, Snd Id)) (Fst Id)) '( 'True,Fst Id) (Snd Id)) [-10,2,3,4,10,11]
+  , expectPE (FailT "pivot=5 value=3(2)") $ pl @(SortBy (If (Fst Id==5 && Snd Id==3) (Failt _ (PrintT "pivot=%d value=%d" Id)) 'GT) (Snd Id)) ((), [5,7,3,1,6,2,1,3])
+  , expectPE (PresentT [1,1,2,3,3,5,6,7]) $ pl @(SortBy (If (Fst Id==50 && Snd Id==3) (Failt _ (PrintT "pivot=%d value=%d" Id)) (OrdA Id)) (Snd Id)) ((), [5,7,3,1,6,2,1,3])
   , expectPE TrueT $ pl @(Between' (Fst Id >> Fst Id) (Fst Id >> Snd Id) (Snd Id)) ((1,4),3)
   , expectPE FalseT $ pl @(Between' (Fst Id >> Fst Id) (Fst Id >> Snd Id) (Snd Id)) ((1,4),10)
   , expectPE (FailT "no match on [03/29/0x7]") $ pl @(Map (ParseTimes Day '["%Y-%m-%d", "%m/%d/%y", "%b %d %Y"] Id) Id) ["2001-01-01", "Jan 24 2009", "03/29/0x7"]
@@ -854,32 +818,32 @@   , expectPE (PresentT "eq3") $ pl @(Case (Snd Id >> Failp "xx") '[Gt 3, Lt 2, Same 3] '["gt3","lt2","eq3"] Id) 3
 
   , expectPE (FailT "no match") $ pl @(Case (Snd Id >> Failp "no match") '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15
-  , expectPE (FailT "no match for 015") $ pl @(Case (Fail (Snd Id >> Unproxy) (Printf "no match for %03d" (Fst Id))) '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15
-  , expectPE (FailT "no match for 015") $ pl @(Case'' (Printf "no match for %03d" Id) '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15
-  , expectPE (FailT "no match for 015") $ pl @(Case'' (Printf "no match for %03d" Id) '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15
+  , expectPE (FailT "no match for 015") $ pl @(Case (Fail (Snd Id >> Unproxy) (PrintF "no match for %03d" (Fst Id))) '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15
+  , expectPE (FailT "no match for 015") $ pl @(Case'' (PrintF "no match for %03d" Id) '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15
+  , expectPE (FailT "no match for 015") $ pl @(Case'' (PrintF "no match for %03d" Id) '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15
   , expectPE (PresentT "other") $ pl @(Case "other" '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15
   , expectPE (PresentT "151515") $ pl @(Case (ShowP (Fst Id) >> Id <> Id <> Id) '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15
   , expectPE (FailT "Case:no match") $ pl @(Case' '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15
-  , expectPE (FailT "no match for -012") $ pl @(Case'' (Printf "no match for %04d" Id) '[Between 0 5, Same 6, Between 7 10] '[ 'LT, 'EQ, 'GT] Id) (-12)
+  , expectPE (FailT "no match for -012") $ pl @(Case'' (PrintF "no match for %04d" Id) '[Between 0 5, Same 6, Between 7 10] '[ 'LT, 'EQ, 'GT] Id) (-12)
   , expectPE (PresentT [Left 1,Left 2,Right "fizz",Left 4,Right "buzz",Right "fizz",Left 7,Left 8,Right "fizz",Right "buzz",Left 11,Right "fizz",Left 13,Left 14,Right "fizzbuzz"]) $ pl @(Map Fizzbuzznew Id) [1..15]
   , expectPE (PresentT (Left 'x')) $ pl @(EitherBool (Fst Id > 10) (Snd Id >> Fst Id) (Snd Id >> Snd Id)) (7,('x',99))
   , expectPE (PresentT (Right 99)) $ pl @(EitherBool (Fst Id > 10) (Snd Id >> Fst Id) (Snd Id >> Snd Id)) (11,('x',99))
   , expectPE (PresentT (Right 99)) $ pl @(EitherBool (Gt 10) "found left" 99) 12
   , expectPE (PresentT (Left "found left")) $ pl @(EitherBool (Gt 10) "found left" 99) 7
 
-  , expectPE (FailT "msg=someval caught(044)") $ pl @(Catch' (Failt Int "someval") (Printf2 "msg=%s caught(%03d)")) (44 :: Int)
-  , expectPE (FailT "msg=expected list of length 1 but found length=3 caught([10,12,13])") $ pl @(Catch' OneP (Second (ShowP Id) >> Printf2 "msg=%s caught(%s)")) [10,12,13]
-  , expectPE (PresentT 10) $ pl @(Catch' OneP (Second (ShowP Id) >> Printf2 "msg=%s caught(%s)")) [10]
-  , expectPE (FailT "msg=expected list of length 1 but found length=2 err s=[10,11]") $ pl @(Catch' OneP (Second (ShowP Id) >> Printf2 "msg=%s err s=%s")) [10,11]
+  , expectPE (FailT "msg=someval caught(044)") $ pl @(Catch' (Failt Int "someval") (PrintT "msg=%s caught(%03d)" Id)) (44 :: Int)
+  , expectPE (FailT "msg=expected list of length 1 but found length=3 caught([10,12,13])") $ pl @(Catch' OneP (Second (ShowP Id) >> PrintT "msg=%s caught(%s)" Id)) [10,12,13]
+  , expectPE (PresentT 10) $ pl @(Catch' OneP (PrintT "msg=%s caught(%s)" (Second (ShowP Id)))) [10]
+  , expectPE (FailT "msg=expected list of length 1 but found length=2 err s=[10,11]") $ pl @(Catch' OneP (PrintT "msg=%s err s=%s" (Second (ShowP Id)))) [10,11]
   , expectPE (PresentT 99) $ pl @(Catch OneP 99) [10,11]
   , expectPE (PresentT 10) $ pl @(Catch OneP 99) [10]
   , expectPE (PresentT False) $ pl @(Catch OneP 'True) [False]  -- cant know that this is FalseT cos is driven by type of the list not the 'True part
   , expectPE FalseT $ pl @(Catch OneP 'False) [True,True,False]
   , expectPE TrueT $ pl @(Catch OneP 'True) []
-  , expectPE (PresentT (-255)) $ pl @(ReadBase Int 16) "-ff"
-  , expectPE (PresentT 255) $ pl @(ReadBase Int 16) "ff"
-  , expectPE (PresentT "-7b") $ pl @(ShowBase 16) (-123)
-  , expectPE (PresentT "7b") $ pl @(ShowBase 16) 123
+  , expectPE (PresentT (-255)) $ pl @(ReadBase Int 16 Id) "-ff"
+  , expectPE (PresentT 255) $ pl @(ReadBase Int 16 Id) "ff"
+  , expectPE (PresentT "-7b") $ pl @(ShowBase 16 Id) (-123)
+  , expectPE (PresentT "7b") $ pl @(ShowBase 16 Id) 123
   , expectPE (PresentT "abc") $ pl @(Thd (Snd (Fst Id))) (('x',(13,False,"abc")),True,'y')
   , expectPE (PresentT 9.3) $ pl @(Fst (Snd (Thd Id))) ('x',True,(13,(9.3,False),"def"))
   , expectPE (PresentT (4,"helo|oleh")) $ pl @'(Len, Id <> "|" <> Reverse) "helo"
test/TestRefined.hs view
@@ -49,8 +49,8 @@ unnamedTests :: [IO ()]
 unnamedTests = [
     (@?=) (unsafeRefined @'True ("1.2.3.4" :: String)) $$(refinedTH "1.2.3.4")
-  , (@?=) (unsafeRefined @((Len >> Same 4) && Luhn Id) [1,2,3,0]) $$(refinedTH [1,2,3,0])
-  , (@?=) (unsafeRefined @(Not ((Len >> Same 4) && Luhn Id)) [1,2,3,1]) $$(refinedTH [1,2,3,1])
+  , (@?=) (unsafeRefined @((Len == 4) && Luhn Id) [1,2,3,0]) $$(refinedTH [1,2,3,0])
+  , (@?=) (unsafeRefined @(Not ((Len == 4) && Luhn Id)) [1,2,3,1]) $$(refinedTH [1,2,3,1])
 
   , (@?=) [(unsafeRefined 7, "")] (reads @(Refined (Between 2 10) Int) "Refined {unRefined = 7}")
   , (@?=) [] (reads @(Refined (Between 2 10) Int) "Refined {unRefined = 0}")
@@ -61,8 +61,6 @@   , expectJ (Right (unsafeRefined 22)) (toFrom (unsafeRefined @(Between 4 7 || Gt 14) 22))
   , expectJ (Left ["Error in $: Refined:FailP \"someval\""]) (toFrom (unsafeRefined @(Between 4 7 || Gt 14 || Failt _ "someval") 12))
 
-  , (fst $ unRavelTI (tst1 ol 10 200)) @?= Right (10,200)
-  , (fst $ unRavelTI (tst1 ol 11 12)) @?= Left "FalseP"
   , (fst <$> unRavelT (tst2 ol 10 200)) >>= (@?= Right (10,200))
   , (fst <$> unRavelT (tst2 ol 11 12)) >>= (@?= Left "FalseP")
   ]
@@ -77,9 +75,9 @@ 
 type Ip4RE = "^(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})$"
 
-type Ip4 = Rescan Ip4RE Id >> OneP >> Map (ReadBaseInt 10) (Snd Id) >> Ip4guard
+type Ip4 = Rescan Ip4RE Id >> OneP >> Map (ReadBaseInt 10 Id) (Snd Id) >> Ip4guard
 
-type Ip4guard = Guard "4octets" (Len >> Same 4) >> Guard "0-255" (All (Between 0 255) Id)
+type Ip4guard = Guard "4octets" (Len == 4) >> Guard "0-255" (All (Between 0 255) Id)
 
 type Ip6 = Resplit ":" Id
         >> Guard "count is bad" (Between' 0 8 Len)
@@ -87,7 +85,7 @@         >> Guard "len is bad" (All (Len >> Le 4) Id)
 
 type Ip6A = Map (If (Id == "") "0" Id) (Resplit ":" Id)
-         >> Map (ReadBaseInt 16) Id
+         >> Map (ReadBaseInt 16 Id) Id
 
 type Ip6B = Guard "count is bad" (Len >> Between 0 8)
          >> Guard "out of bounds" (All (Between 0 65535) Id)
@@ -95,25 +93,31 @@ 
 type Ip6A' = Resplit ":" Id
          >> Map (If (Id == "") "0" Id) Id
-         >> Map (ReadBaseInt 16) Id
+         >> Map (ReadBaseInt 16 Id) Id
          >> PadL 8 0 Id
 
-type Ip6A'' = Map (If (Id == "") 0 (ReadBaseInt 16)) (Resplit ":" Id) >> PadL 8 0 Id
+type Ip6A'' = Map (If (Id == "") 0 (ReadBaseInt 16 Id)) (Resplit ":" Id) >> PadL 8 0 Id
 
-type Ip6B' = Guard "count is bad" (Len >> Same 8)
+type Ip6B' = Guard "count is bad" (Len == 8)
          >> Guard "out of bounds" (All (Between 0 65535) Id)
          >> 'True
 
-type Ip4A = Map (ReadBaseInt 10) (Resplit "\\." Id)
-type Ip4B = Guard "expected 4 numbers" (Len >> Same 4)
+type Ip6B'' = Msg "count is bad:" (Len == 8)
+         && Msg "out of bounds:" (All (Between 0 65535) Id)
+
+type Ip4A = Map (ReadBaseInt 10 Id) (Resplit "\\." Id)
+type Ip4B = Guard "expected 4 numbers" (Len == 4)
          >> Guard "each number must be between 0 and 255" (All (Between 0 255) Id)
          >> 'True
 
-type Ip4C = Printfnt 4 "%03d.%03d.%03d.%03d"
+type Ip4B' = Msg "expected 4 numbers:" (Len == 4)
+          && All (Between 0 255) Id
 
+type Ip4C = PrintL 4 "%03d.%03d.%03d.%03d" Id
+
 -- base n number of length x and then convert to a list of length x of (0 to (n-1))
 -- checks that each digit is between 0 and n-1
-type MM1 (n :: Nat) = Map (ReadBase Int n) (Ones Id)
+type MM1 (n :: Nat) = Map (ReadBase Int n Id) (Ones Id)
 type MM2 (n :: Nat) = ExitWhen "found empty" IsEmpty >> Guard "0<=x<n" (All (Ge 0 && Lt n) Id)
 
 -- prtRefinedT tst1
@@ -135,7 +139,7 @@    -> a
    -> Either String (Refined p a)
 testRefinedJ opts a =
-   let ((bp,e),mr) = runIdentity $ newRefined @p opts a
+   let ((bp,(e,_top)),mr) = runIdentity $ newRefined @p opts a
    in case mr of
         Nothing -> error $ show bp ++ "\n" ++ e
         Just r -> eitherDecode @(Refined p a) $ encode r
test/TestRefined3.hs view
@@ -55,7 +55,7 @@   , testCase "datetime utctime" $ (@?=) ($$(refined3TH "2019-01-04 23:00:59") :: MakeR3 (DateTime1 UTCTime)) (unsafeRefined3 (read "2019-01-04 23:00:59 UTC") "2019-01-04 23:00:59")
   , testCase "datetime localtime" $ (@?=) ($$(refined3TH "2019-01-04 09:12:30") :: MakeR3 (DateTime1 LocalTime)) (unsafeRefined3 (read "2019-01-04 09:12:30") "2019-01-04 09:12:30")
   , testCase "hms" $ (@?=) ($$(refined3TH "12:0:59") :: MakeR3 Hms) (unsafeRefined3 [12,0,59] "12:00:59")
-  , testCase "between5and9" $ (@?=) ($$(refined3TH "7") :: Refined3 (ReadP Int) (Between 5 9) (Printf "%03d" Id) String) (unsafeRefined3 7 "007")
+  , testCase "between5and9" $ (@?=) ($$(refined3TH "7") :: Refined3 (ReadP Int Id) (Between 5 9) (PrintF "%03d" Id) String) (unsafeRefined3 7 "007")
   , testCase "ssn" $ (@?=) ($$(refined3TH "123-45-6789") :: MakeR3 Ssn) (unsafeRefined3 [123,45,6789] "123-45-6789")
   , testCase "base16" $ (@?=) ($$(refined3TH "12f") :: MakeR3 (BaseN 16)) (unsafeRefined3 303 "12f")
   , testCase "daten1" $ (@?=) ($$(refined3TH "June 25 1900") :: MakeR3 DateN) (unsafeRefined3 (read "1900-06-25") "1900-06-25")
@@ -67,9 +67,9 @@ 
 unnamedTests :: [IO ()]
 unnamedTests = [
-    (@?=) [(unsafeRefined3 255 "ff", "")] (reads @(Refined3 (ReadBase Int 16) (Between 0 255) (ShowBase 16) String) "Refined3 {r3In = 255, r3Out = \"ff\"}") -- escape quotes cos read instance for String
-  , (@?=) [] (reads @(Refined3 (ReadBase Int 16) (Between 0 255) (ShowBase 16) String) "Refined3 {r3In = 256, r3Out = \"100\"}")
-  , (@?=) [(unsafeRefined3 (-1234) "-4d2", "")] (reads @(Refined3 (ReadBase Int 16) (Id < 0) (ShowBase 16) String) "Refined3 {r3In = -1234, r3Out = \"-4d2\"}")
+    (@?=) [(unsafeRefined3 255 "ff", "")] (reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255) (ShowBase 16 Id) String) "Refined3 {r3In = 255, r3Out = \"ff\"}") -- escape quotes cos read instance for String
+  , (@?=) [] (reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255) (ShowBase 16 Id) String) "Refined3 {r3In = 256, r3Out = \"100\"}")
+  , (@?=) [(unsafeRefined3 (-1234) "-4d2", "")] (reads @(Refined3 (ReadBase Int 16 Id) (Id < 0) (ShowBase 16 Id) String) "Refined3 {r3In = -1234, r3Out = \"-4d2\"}")
 
   , (@?=) (unsafeRefined3 [1,2,3,4] "001.002.003.004") ($$(refined3TH "1.2.3.4") :: MakeR3 Ip)
 
@@ -87,47 +87,44 @@   , expectRight (testRefined3P (Proxy @(Ccn '[1,2,1])) ol "1-23-0")
 
   , expect3 (Left $ XF "Regex no results")
-                  $ eval3 @(Rescan Ip4RE Id >> HeadFail "failedn" Id >> Map (ReadP Int) (Snd Id))
-                          @((Len >> Same 4) && All (Between 0 255) Id)
-                          @(Printfnt 4 "%03d.%03d.%03d.%03d")
+                  $ eval3 @(Rescan Ip4RE Id >> HeadFail "failedn" Id >> Map (ReadP Int Id) (Snd Id))
+                          @((Len == 4) && All (Between 0 255) Id)
+                          @(PrintL 4 "%03d.%03d.%03d.%03d" Id)
                           ol "1.21.x31.4"
 
   , expect3 (Right $ unsafeRefined3 [1,21,31,4] "001.021.031.004")
-                  $ eval3 @(Rescan Ip4RE Id >> HeadFail "failedn" Id >> Map (ReadP Int) (Snd Id))
-                          @((Len >> Same 4) && All (Between 0 255) Id)
-                          @(Printfnt 4 "%03d.%03d.%03d.%03d")
+                  $ eval3 @(Rescan Ip4RE Id >> HeadFail "failedn" Id >> Map (ReadP Int Id) (Snd Id))
+                          @((Len == 4) && All (Between 0 255) Id)
+                          @(PrintL 4 "%03d.%03d.%03d.%03d" Id)
                           ol "1.21.31.4"
 
   , expect3 (Left $ XTFalse (-6.3))
-                  $ eval3 @(ReadP Double)
+                  $ eval3 @(ReadP Double Id)
                           @(Cmp 'Cgt (ToRational Id) (7 %- 3))
-                          @(Printf "%5.3f" Id)
+                          @(PrintF "%5.3f" Id)
                           ol "-6.3"
 
   , expect3 (Right $ unsafeRefined3 4.123 "")
-                  $ eval3 @(ReadP Double) @(Cmp 'Cgt (ToRational Id) (7 %- 3)) @""
+                  $ eval3 @(ReadP Double Id) @(Cmp 'Cgt (ToRational Id) (7 %- 3)) @""
                   ol "4.123"
 
   , expect3 (Right $ unsafeRefined3 4.123 (4123 % 1000))
-                  $ eval3 @Id @(Gt (7 %- 3)) @(4123 % 1000)
-                  ol 4.123
+                  $ eval3 @Id @(Gt (7 %- 3)) @(4123 % 1000) ol 4.123
 
   , expect3 (Right $ unsafeRefined3 [1,2,3,4] "")
-                  $ eval3 @(Map (ReadP Int) (Resplit "\\." Id)) @(All (Between 0 255) Id && (Len >> Same 4)) @""
+                  $ eval3 @(Map (ReadP Int Id) (Resplit "\\." Id)) @(All (Between 0 255) Id && (Len == 4)) @""
                   ol "1.2.3.4"
 
   , expect3 (Left $ XTF [291,1048319,4387,17,1] "out of bounds")
-                  $ eval3 @Ip6A @Ip6B @""
-                  ol "123:Ffeff:1123:11:1"
+                  $ eval3 @Ip6A @Ip6B @"" ol "123:Ffeff:1123:11:1"
 
   , expect3 (Right $ unsafeRefined3 [12,2,0,255] "abc")
-                  $ eval3 @Ip4A @Ip4B @"abc"
-                  ol "12.2.0.255"
+                  $ eval3 @Ip4A @Ip4B @"abc" ol "12.2.0.255"
 
   , expect3 (Right $ unsafeRefined3 [123,45,6789] "def")
                   $ eval3
-                  @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP >> Map (ReadBaseInt 10) (Snd Id))
-                  @(Guard "expected 3" (Len >> Same 3)
+                  @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP >> Map (ReadBaseInt 10 Id) (Snd Id))
+                  @(Guard "expected 3" (Len == 3)
                  >> Guard "3 digits" (Ix' 0 >> Between 0 999)
                  >> Guard "2 digits" (Ix' 1 >> Between 0 99)
                  >> Guard "4 digits" (Ix' 2 >> Between 0 9999)
@@ -137,8 +134,8 @@ 
   , expect3 (Right $ unsafeRefined3 [123,45,6789] "xyz")
                   $ eval3
-                  @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP >> Map (ReadBaseInt 10) (Snd Id))
-                  @(GuardsQuick (Printf2 "guard(%d) %d is out of range") '[Between 0 999, Between 0 99, Between 0 9999] >> 'True)
+                  @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP >> Map (ReadBaseInt 10 Id) (Snd Id))
+                  @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 999, Between 0 99, Between 0 9999] >> 'True)
                   @"xyz"
                   ol "123-45-6789"
 
@@ -146,6 +143,10 @@                   $ eval3 @Ip6A'' @Ip6B' @"xyz"
                   ol "123:Ffeff:1123:11:1"
 
+  , expect3 (Left $ XTFalse [0,0,0,291,1048319,4387,17,1])
+                  $ eval3 @Ip6A'' @Ip6B'' @"xyz"
+                  ol "123:Ffeff:1123:11:1"
+
   , expect3 (Right $ unsafeRefined3 [0,0,0,291,65535,4387,17,1] "xyz")
                   $ eval3 @Ip6A'' @Ip6B' @"xyz"
                   ol "123:Ffff:1123:11:1"
@@ -154,14 +155,18 @@                   $ eval3 @Ip6A'' @Ip6B' @"xyz"
                   ol "123::Ffff:::11"
 
+  , expect3 (Right $ unsafeRefined3 [0,0,291,0,65535,0,0,17] "xyz")
+                  $ eval3 @Ip6A'' @Ip6B'' @"xyz"
+                  ol "123::Ffff:::11"
+
   , expect3 (Right $ unsafeRefined3 [31,11,1999] "xyz")
-                  $ eval3 @(Rescan DdmmyyyyRE Id >> OneP >> Map (ReadBaseInt 10) (Snd Id))
+                  $ eval3 @(Rescan DdmmyyyyRE Id >> OneP >> Map (ReadBaseInt 10 Id) (Snd Id))
                            @(Ddmmyyyyval >> 'True)
                            @"xyz"
                            ol "31-11-1999"
   , expect3 (Right $ unsafeRefined3 [123,45,6789] "xyz") $ eval3
-                  @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP >> Map (ReadBaseInt 10) (Snd Id))
-                  @(GuardsQuick (Printf2 "guard(%d) %d is out of range") '[Between 0 999, Between 0 99, Between 0 9999] >> 'True)
+                  @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP >> Map (ReadBaseInt 10 Id) (Snd Id))
+                  @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 999, Between 0 99, Between 0 9999] >> 'True)
                   @"xyz"
                   ol "123-45-6789"
 
@@ -169,6 +174,7 @@   , expect3 (Left $ XF "invalid base 10") $ eval3P ip4 ol "1.2.3x.4"
   , expect3 (Left $ XTF [1,2,3,4,5] "expected 4 numbers") $ eval3P ip4 ol "1.2.3.4.5"
   , expect3 (Left $ XTF [1,2,300,4] "each number must be between 0 and 255") $ eval3P ip4 ol "1.2.300.4"
+  , expect3 (Left $ XTFalse [1,2,300,4]) $ eval3P ip4' ol "1.2.300.4"
   , expect3 (Right $ unsafeRefined3 [1,2,3,4,5,6,7,8,9,0,3] "1234-5678-903") $ eval3P cc ol "12345678903"
   , expect3 (Left $ XTFalse [1,2,3,4,5,6,7,8,9,0,1]) $ eval3P cc ol "12345678901"
 --  , expect3 (Right $ unsafeRefined3 True ["T","r","ue","Tr","ue"]) $ eval3P (Proxy @'(Id, Id, Do '[ShowP Id, Dup, Sapa, SplitAts '[1,1,2,2]], Bool)) True
@@ -179,16 +185,16 @@ allProps :: [TestTree]
 allProps =
   [
-    testProperty "base16" $ forAll (arbRefined3 (mkProxy3P @'(ReadBase Int 16, 'True, ShowBase 16, String)) ol) (\r -> evalQuick @(ReadBase Int 16) (r3Out r) === Right (r3In r))
-  , testProperty "readshow" $ forAll (arbRefined3 Proxy ol :: Gen HexLtR3) (\r -> read @HexLtR3 (show r) === r)
-  , testProperty "jsonroundtrip" $ forAll (arbRefined3 Proxy ol :: Gen HexLtR3) (\r -> testRefined3PJ Proxy ol (r3Out r) === Right r)
+    testProperty "base16" $ forAll (arbRefined3 (mkProxy3 @'(ReadBase Int 16 Id, 'True, ShowBase 16 Id, String))) (\r -> evalQuick @(ReadBase Int 16 Id) (r3Out r) === Right (r3In r))
+  , testProperty "readshow" $ forAll (arbRefined3 Proxy :: Gen HexLtR3) (\r -> read @HexLtR3 (show r) === r)
+  , testProperty "jsonroundtrip" $ forAll (arbRefined3 Proxy :: Gen HexLtR3) (\r -> testRefined3PJ Proxy ol (r3Out r) === Right r)
   ]
 
-type HexLtR3 = Refined3 (ReadBase Int 16) (Id < 500) (ShowBase 16) String
-type IntLtR3 = Refined3 (ReadP Int) (Id < 10) (ShowP Id) String
+type HexLtR3 = Refined3 (ReadBase Int 16 Id) (Id < 500) (ShowBase 16 Id) String
+type IntLtR3 = Refined3 (ReadP Int Id) (Id < 10) (ShowP Id) String
 
 -- printf breaks with negative numbers!
-type Tst1 = '(ReadP Int, Between 1 7, Printf "someval val=%03d" Id, String)
+type Tst1 = '(ReadP Int Id, Between 1 7, PrintF "someval val=%03d" Id, String)
 
 yy1, yy2, yy3, yy4 :: RefinedT Identity (MakeR3 Tst1)
 
@@ -198,101 +204,97 @@ yy3 = rapply3 o2 (*) yy1 yy2 -- fails
 yy4 = rapply3 o2 (+) yy1 yy2 -- pure ()
 
-type Ip4T = '(Ip4A, Ip4B, Ip4C, String)
+type Ip4T = '(Ip4A, Ip4B, Ip4C, String) -- guards
+type Ip4T' = '(Ip4A, Ip4B', Ip4C, String) -- boolean predicates
 
-ip4 :: Proxy Ip4T -- '(Ip4A, Ip4B, Ip4C, String)
-ip4 = mkProxy3 -- safer cos checks that ~ Bool etc
+ip4 :: Proxy Ip4T
+ip4 = mkProxy3'
 
+ip4' :: Proxy Ip4T'
+ip4' = mkProxy3'
+
 ip4expands :: Proxy '(Ip4A, Ip4B, Ip4C, String)
 ip4expands = mkProxy3
 
 -- this works but ParseTimeP is easier
 type DdmmyyyyRE = "^(\\d{2})-(\\d{2})-(\\d{4})$"
-type Ddmmyyyyval' = GuardsQuick (Printf2 "guard(%d) %d is out of range") '[Between 1 31, Between 1 12, Between 1990 2050]
+type Ddmmyyyyval' = GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]
 type Ddmmyyyyval =
-    Guards '[ '(Printf2 "guard(%d) day %d is out of range", Between 1 31)
-            , '(Printf2 "guard(%d) month %d is out of range", Between 1 12)
-            , '(Printf2 "guard(%d) year %d is out of range", Between 1990 2050) ]
+    Guards '[ '(PrintT "guard(%d) day %d is out of range" Id, Between 1 31)
+            , '(PrintT "guard(%d) month %d is out of range" Id, Between 1 12)
+            , '(PrintT "guard(%d) year %d is out of range" Id, Between 1990 2050) ]
 
 cc :: Proxy CC11
 cc = mkProxy3
 
-type Ipz1 = '(Id &&& Ip4A
-           , Snd Id >> Ip4B
-           , Snd Id >> Para (RepeatT 4 (Printf "%03d" Id)) >> Intercalate '["."] Id >> Concat
-           , String)
-type Ipz2 = '(Id, Ip4A, Ip4B, String) -- skips fmt and just uses the original input
-type Ipz3 = '(Ip4A, Ip4B, Id, String)
-
-
 -- need to add 'True to make it a predicate
 -- guards checks also that there are exactly 3 entries!
-type Hmsconv = Do '[Rescan HmsRE Id, Head, (Snd Id), Map (ReadBaseInt 10) Id]
+type Hmsconv = Do '[Rescan HmsRE Id, Head Id, (Snd Id), Map (ReadBaseInt 10 Id) Id]
 
 type Hmsz1 = '(Hmsconv &&& ParseTimeP TimeOfDay "%H:%M:%S" Id
-            , Fst Id >> Hmsop >> 'True
+            , Fst Id >> Hmsop
             , Snd Id
             , String)
 
 -- better error messages cos doesnt do a strict regex match
 type Hmsz2 = '(Hmsip &&& ParseTimeP TimeOfDay "%H:%M:%S" Id
-             , Fst Id >> Hmsop >> 'True
+             , Fst Id >> Hmsop
              , Snd Id
              , String)
 
 type Hmsip2 = Hmsip &&& ParseTimeP TimeOfDay "%H:%M:%S" Id
-type Hmsop2 = Fst Id >> Hmsop >> 'True
+type Hmsop2 = Fst Id >> Hmsop
 
 -- >mkProxy3 @Hmsip2 @Hmsop2 @((Snd Id) >> FormatTimeP "%F %T" Id) @String
 hms2E :: Proxy '(Hmsip2, Hmsop2, (Snd Id) >> FormatTimeP "%T" Id, String)
-hms2E = mkProxy3P
+hms2E = mkProxy3
 
 
 -- better to use Guard for op boolean check cos we get better errormessages
 -- 1. packaged up as a promoted tuple
-type Tst3 = '(Map (ReadP Int) (Resplit "\\." Id), (Len >> Same 4) && All (Between 0 255) Id, ConcatMap (Printf "%03d" Id) Id, String)
+type Tst3 = '(Map (ReadP Int Id) (Resplit "\\." Id), (Len == 4) && All (Between 0 255) Id, ConcatMap (PrintF "%03d" Id) Id, String)
 
 www1, www2 :: String -> Either Msg3 (MakeR3 Tst3)
-www1 = prtEval3P (Proxy :: MkProxy3T Tst3) o2
+www1 = prtEval3P (mkProxy3 @Tst3) o2
 www2 = prtEval3P tst3 o2
 
 -- just pass in an ipaddress as a string: eg 1.2.3.4 or 1.2.3.4.5 (invalid) 1.2.3.400 (invalid)
 
 -- 2. packaged as a proxy
 tst3 :: Proxy
-        '(Map (ReadP Int) (Resplit "\\." Id)
-        ,(Len >> Same 4) && All (Between 0 255) Id
-        ,ConcatMap (Printf "%03d" Id) Id
+        '(Map (ReadP Int Id) (Resplit "\\." Id)
+        ,(Len == 4) && All (Between 0 255) Id
+        ,ConcatMap (PrintF "%03d" Id) Id
         ,String)
 tst3 = mkProxy3
 
 
 -- 3. direct
 ww3 :: String -> Either Msg3 (Refined3
-                               (Map (ReadP Int) (Resplit "\\." Id))
-                               ((Len >> Same 4) && All (Between 0 255) Id)
-                               (ConcatMap (Printf "%03d" Id) Id)
+                               (Map (ReadP Int Id) (Resplit "\\." Id))
+                               ((Len == 4) && All (Between 0 255) Id)
+                               (ConcatMap (PrintF "%03d" Id) Id)
                                String)
 ww3 = prtEval3 o2
 {-
 ww3 = prtEval3
-        @(Map (ReadP Int) (Resplit "\\." Id))
-        @((Len >> Same 4) && All (Between 0 255))
-        @(ConcatMap (Printf "%03d" Id) Id)
+        @(Map (ReadP Int Id) (Resplit "\\." Id))
+        @((Len == 4) && All (Between 0 255))
+        @(ConcatMap (PrintF "%03d" Id) Id)
         o2
 -}
 data G4 = G4 { g4Age :: MakeR3 Age
              , g4Ip :: MakeR3 Ip9
              } deriving (Show,Generic,Eq)
 
-type MyAge = Refined3 (ReadP Int) (Gt 4) (ShowP Id) String
+type MyAge = Refined3 (ReadP Int Id) (Gt 4) (ShowP Id) String
 
-type Age = '(ReadP Int, Gt 4, ShowP Id, String)
+type Age = '(ReadP Int Id, Gt 4, ShowP Id, String)
 
 type Ip9 = '(
-            Map (ReadP Int) (Resplit "\\." Id) -- split String on "." then convert to [Int]
-           ,(Len >> Same 4) && All (Between 0 255) Id -- process [Int] and make sure length==4 and each octet is between 0 and 255
-           ,Printfnt 4 "%03d.%03d.%03d.%03d" -- printf [Int]
+            Map (ReadP Int Id) (Resplit "\\." Id) -- split String on "." then convert to [Int]
+           ,(Len == 4) && All (Between 0 255) Id -- process [Int] and make sure length==4 and each octet is between 0 and 255
+           ,PrintL 4 "%03d.%03d.%03d.%03d" Id -- printf [Int]
            ,String -- input type is string which is also the output type
            )
 
@@ -307,14 +309,14 @@ 
 -- prtRefinedT tst1a
 tst1a :: Monad m => POpts -> RefinedT m ((Int,String),(Int,String))
-tst1a opts = withRefined3T @(ReadBase Int 16) @(Between 100 200) @(ShowBase 16) @String opts "a3"
-  $ \r1 -> withRefined3T @(ReadP Int) @'True @(ShowP Id) @String opts "12"
+tst1a opts = withRefined3T @(ReadBase Int 16 Id) @(Between 100 200) @(ShowBase 16 Id) @String opts "a3"
+  $ \r1 -> withRefined3T @(ReadP Int Id) @'True @(ShowP Id) @String opts "12"
      $ \r2 -> return ((r3In r1, r3Out r1), (r3In r2, r3Out r2))
 
 -- prtRefinedTIO tst2a
 tst2a :: MonadIO m => POpts -> RefinedT m ((Int,String),(Int,String))
-tst2a opts = withRefined3TIO @(ReadBase Int 16) @(Stderr "start" |> Between 100 200 >| Stdout "end") @(ShowBase 16) @String opts "a3"
-  $ \r1 -> withRefined3TIO @(ReadP Int) @'True @(ShowP Id) @String opts "12"
+tst2a opts = withRefined3TIO @(ReadBase Int 16 Id) @(Stderr "start" |> Between 100 200 >| Stdout "end") @(ShowBase 16 Id) @String opts "a3"
+  $ \r1 -> withRefined3TIO @(ReadP Int Id) @'True @(ShowP Id) @String opts "12"
      $ \r2 -> return ((r3In r1, r3Out r1), (r3In r2, r3Out r2))
 
 -- have to use 'i' as we dont hold onto the input
@@ -397,31 +399,31 @@ type LuhnR' (n :: Nat) = MakeR3 (LuhnX n)
 
 type LuhnX (n :: Nat) =
-   '(Map (ReadP Int) (Ones Id)
+   '(Map (ReadP Int Id) (Ones Id)
    , Luhn'' n >> 'True
    , ConcatMap (ShowP Id) Id
    , String)
 
 type Luhn'' (n :: Nat) =
-         Guard (Printfn "incorrect number of digits found %d but expected %d in [%s]" (TupleI '[Len, W n, ShowP Id])) (Len >> Same n)
+         Guard (PrintT "incorrect number of digits found %d but expected %d in [%s]" '(Len, n, ShowP Id)) (Len == n)
       >> Do '[
               Reverse
-             ,ZipL [1,2] Id
+             ,Zip (Cycle n [1,2]) Id
              ,Map (Fst Id * Snd Id >> If (Id >= 10) (Id - 9) Id) Id
              ,FoldMap (SG.Sum Int) Id
              ]
-        >> Guard (Printfn "expected %d mod 10 = 0 but found %d" (TupleI '[Id, Id `Mod` 10])) (Mod Id 10 >> Same 0)
+        >> Guard (PrintT "expected %d mod 10 = 0 but found %d" '(Id, Id `Mod` 10)) (Mod Id 10 == 0)
 
 type Luhn' (n :: Nat) =
        Msg "Luhn'" (Do
-       '[Guard (Printfn "incorrect number of digits found %d but expected %d in [%s]" (TupleI '[Len, W n, Id])) (Len >> Same n)
+       '[Guard (PrintT "incorrect number of digits found %d but expected %d in [%s]" '(Len, n, Id)) (Len == n)
         ,Do
             '[Ones Id
-            ,Map (ReadP Int) Id
+            ,Map (ReadP Int Id) Id
             ,Reverse
-            ,ZipL [1,2] Id
+            ,Zip (Cycle n [1,2]) Id
             ,Map (Fst Id * Snd Id >> If (Id >= 10) (Id - 9) Id) Id
             ,FoldMap (SG.Sum Int) Id
            ]
-        ,Guard (Printfn "expected %d mod 10 = 0 but found %d" (TupleI '[Id, Id `Mod` 10])) (Mod Id 10 >> Same 0)
+        ,Guard (PrintT "expected %d mod 10 = 0 but found %d" '(Id, Id `Mod` 10)) (Mod Id 10 == 0)
         ])