predicate-typed 0.6.2.1 → 0.7.0.0

raw patch · 21 files changed

+13346/−12925 lines, 21 filesdep −ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies removed: ghc-prim

API changes (from Hackage documentation)

Files

• doctest/doctests.hs +2/−6
• predicate-typed.cabal +14/−23
• src/Predicate.hs +6/−2
• src/Predicate/Core.hs +100/−130
• src/Predicate/Examples/Common.hs +16/−1
• src/Predicate/Examples/Refined1.hs +56/−0
• src/Predicate/Examples/Refined2.hs +91/−98
• src/Predicate/Examples/Refined3.hs +153/−139
• src/Predicate/Prelude.hs +10658/−10745
• src/Predicate/Refined.hs +235/−177
• src/Predicate/Refined1.hs +377/−357
• src/Predicate/Refined2.hs +242/−196
• src/Predicate/Refined3.hs +390/−342
• src/Predicate/TH_Orphans.hs +13/−8
• src/Predicate/Util.hs +478/−229
• src/Predicate/Util_TH.hs +129/−116
• test/TestJson.hs +30/−20
• test/TestPredicate.hs +18/−0
• test/TestRefined.hs +35/−38
• test/TestRefined2.hs +154/−152
• test/TestRefined3.hs +149/−146

@@ -1,14 +1,10 @@-{-# LANGUAGE CPP #-}
 import Test.DocTest
 -- main = doctest ["src", "--verbose"]
 main :: IO ()
 
-#if __GLASGOW_HASKELL__ >= 806
 main = doctest ["src","-XNoStarIsType"]
-#else
-main = doctest ["src"]
-#endif
+--main = doctest ["src","--verbose","-XNoStarIsType"]
 
 
--- stack exec doctest -- "src/Predicate.hs"
+-- stack exec doctest -- "src/Predicate/Prelude.hs"
 -- stack exec doctest -- src

@@ -4,18 +4,18 @@ -- -- see: https://github.com/sol/hpack ----- hash: 97e6093ee31d1133d96d8a48d583c2214c64f0c07e1888a89ae874ccde82f8ed+-- hash: 50c224873b64d409685fdae3dead9b051e87bbe0a62f23783507eda242b4884d  name:           predicate-typed-version:        0.6.2.1+version:        0.7.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 homepage:       https://github.com/gbwey/predicate-typed#readme bug-reports:    https://github.com/gbwey/predicate-typed/issues-author:         Grant Weyburne <gbwey9@gmail.com>-maintainer:     Grant Weyburne <gbwey9@gmail.com>-copyright:      Copyright 2019, Grant Weyburne+author:         gbwey+maintainer:     gbwey+copyright:      2019 Grant Weyburne license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -29,6 +29,7 @@       Predicate       Predicate.Core       Predicate.Examples.Common+      Predicate.Examples.Refined1       Predicate.Examples.Refined2       Predicate.Examples.Refined3       Predicate.Prelude@@ -43,7 +44,7 @@       Paths_predicate_typed   hs-source-dirs:       src-  ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wmissing-export-lists -Wpartial-fields -Wredundant-constraints+  ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wpartial-fields -Wredundant-constraints   build-depends:       QuickCheck     , aeson@@ -54,7 +55,6 @@     , containers     , deepseq     , directory-    , ghc-prim     , hashable     , lens     , mtl@@ -69,6 +69,8 @@     , these     , time     , tree-view >=0.5+  if impl(ghc >= 8.8)+    ghc-options: -fwrite-ide-info -hiedir=.hie   default-language: Haskell2010  test-suite doctests@@ -78,6 +80,7 @@       Predicate       Predicate.Core       Predicate.Examples.Common+      Predicate.Examples.Refined1       Predicate.Examples.Refined2       Predicate.Examples.Refined3       Predicate.Prelude@@ -104,7 +107,6 @@     , deepseq     , directory     , doctest-    , ghc-prim     , hashable     , lens     , mtl@@ -120,25 +122,14 @@     , these     , time     , tree-view >=0.5+  if impl(ghc >= 8.8)+    ghc-options: -fwrite-ide-info -hiedir=.hie   default-language: Haskell2010  test-suite predicate-typed-test   type: exitcode-stdio-1.0   main-is: TestSpec.hs   other-modules:-      Predicate-      Predicate.Core-      Predicate.Examples.Common-      Predicate.Examples.Refined2-      Predicate.Examples.Refined3-      Predicate.Prelude-      Predicate.Refined-      Predicate.Refined1-      Predicate.Refined2-      Predicate.Refined3-      Predicate.TH_Orphans-      Predicate.Util-      Predicate.Util_TH       TastyExtras       TestJson       TestPredicate@@ -147,7 +138,6 @@       TestRefined3       Paths_predicate_typed   hs-source-dirs:-      src       test   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:@@ -160,7 +150,6 @@     , containers     , deepseq     , directory-    , ghc-prim     , hashable     , lens     , mtl@@ -180,4 +169,6 @@     , these     , time     , tree-view >=0.5+  if impl(ghc >= 8.8)+    ghc-options: -fwrite-ide-info -hiedir=.hie   default-language: Haskell2010

@@ -1,16 +1,20 @@ {- |
      Provides a type-level Dsl for refinement types
 
-     "Predicate.Refined2" and "Predicate.Refined3" contain the advanced refinement types where you can convert the input type
+     "Predicate.Refined2" and "Predicate.Refined3" hold the more advanced refinement types allowing changes to the input type
 
 -}
 module Predicate (
    module Predicate.Core
  , module Predicate.Prelude
  , module Predicate.Util
+ , module Predicate.Util_TH
  , module Predicate.Refined
+ , module Predicate.TH_Orphans
  ) where
 import Predicate.Core
 import Predicate.Util
+import Predicate.Util_TH
 import Predicate.Prelude
-import Predicate.Refined+import Predicate.Refined
+import Predicate.TH_Orphans ()

@@ -29,20 +29,15 @@   , Msg
 
   -- ** display evaluation tree
-  , pe
-  , pe2
-  , pe2a
-  , pe2n
+  , pan
+  , pa
   , pu
-  , pua
-  , pun
-  , pe3
+  , pab
+  , pub
   , pl
-  , plc
   , pz
-  , peWith
+  , run
 
-  -- ** P class
   , P(..)
 
   -- ** evaluation methods
@@ -50,7 +45,7 @@   , runPQBool
   , evalBool
   , evalQuick
---  , prtTreeX
+  , prtTree'
   ) where
 import Predicate.Util
 import GHC.TypeLits (Symbol,Nat,KnownSymbol,KnownNat)
@@ -75,20 +70,19 @@ 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) ol i))
+evalQuick i = getValLRFromTT (runIdentity (eval (Proxy @p) (getOptT @'OL) i))
 
 
 -- | identity function
 --
 -- >>> pz @I 23
--- Present 23
 -- PresentT 23
 data I
 instance P I a where
   type PP I a = a
   eval _ opts a =
     let msg0 = "I"
-    in pure $ mkNode opts (PresentT a) [msg0] []
+    in pure $ mkNode opts (PresentT a) msg0 []
 
 
 -- | identity function that displays the input unlike 'I'
@@ -96,21 +90,19 @@ -- even more constraints than 'I' so we might need to add explicit type signatures
 --
 -- >>> pz @Id 23
--- Present 23
 -- PresentT 23
 data Id
 instance Show a => P Id a where
   type PP Id a = a
   eval _ opts a =
     let msg0 = "Id"
-    in pure $ mkNode opts (PresentT a) [msg0 <> show0 opts " " a] []
+    in pure $ mkNode opts (PresentT a) (msg0 <> show0 opts " " a) []
 
 
 -- even more constraints than 'Id' so we might need to explicitly add types (Typeable)
 -- | identity function that also displays the type information for debugging
 --
 -- >>> pz @IdT 23
--- Present 23
 -- PresentT 23
 data IdT
 instance (Typeable a, Show a) => P IdT a where
@@ -118,16 +110,14 @@   eval _ opts a =
     let msg0 = "IdT(" <> t <> ")"
         t = showT @a
-    in pure $ mkNode opts (PresentT a) [msg0 <> show0 opts " " 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.Core.Do'
 --
 -- >>> pz @'[W 123, Id] 99
--- Present [123,99]
 -- PresentT [123,99]
 --
 -- >>> pz @'[W "abc", W "def", Id, Id] "ghi"
--- Present ["abc","def","ghi","ghi"]
 -- PresentT ["abc","def","ghi","ghi"]
 --
 data W (p :: k)
@@ -137,11 +127,11 @@ 
 -- | add a message to give more context to the evaluation tree
 --
--- >>> pe @(Msg "[somemessage] " Id) 999
+-- >>> pan @(Msg "[somemessage] " Id) 999
 -- P [somemessage] Id 999
 -- PresentT 999
 --
--- >>> pe @(Msg Id 999) "info message:"
+-- >>> pan @(Msg Id 999) "info message:"
 -- P info message:'999
 -- PresentT 999
 --
@@ -161,20 +151,19 @@ -- | 'const' () function
 --
 -- >>> pz @() "Asf"
--- Present ()
 -- PresentT ()
 --
 instance P () a where
   type PP () a = ()
   eval _ opts _ =
     let msg0 = "()"
-    in pure $ mkNode opts (PresentT ()) [msg0] []
+    in pure $ mkNode opts (PresentT ()) msg0 []
 
 instance P (Proxy t) a where
   type PP (Proxy t) a = Proxy t
   eval _ opts _ =
     let msg0 = "Proxy"
-    in pure $ mkNode opts (PresentT Proxy) [msg0] []
+    in pure $ mkNode opts (PresentT Proxy) msg0 []
 
 -- Start non-Type kinds
 -----------------------
@@ -182,33 +171,29 @@ -- | pulls the type level 'Bool' to the value level
 --
 -- >>> pz @'True "not used"
--- True
 -- TrueT
 --
 -- >>> pz @'False ()
--- False
 -- FalseT
 instance GetBool b => P (b :: Bool) a where
   type PP b a = Bool
   eval _ opts _ =
     let b = getBool @b
-    in pure $ mkNodeB opts b ["'" <> show b] []
+    in pure $ mkNodeB opts b ("'" <> show b) []
 
 -- | pulls the type level 'Symbol' to the value level as a 'GHC.Base.String'
 --
 -- >>> pz @"hello world" ()
--- Present "hello world"
 -- PresentT "hello world"
 instance KnownSymbol s => P (s :: Symbol) a where
   type PP s a = String
   eval _ opts _ =
     let s = symb @s
-    in pure $ mkNode opts (PresentT s) ["'" <> showLit0 opts "" s] []
+    in pure $ mkNode opts (PresentT s) ("'" <> showLit0 opts "" s) []
 
 -- | run the predicates in a promoted 2-tuple; similar to 'Control.Arrow.&&&'
 --
 -- >>> pz @'(Id, 4) "hello"
--- Present ("hello",4)
 -- PresentT ("hello",4)
 --
 instance (P p a, P q a) => P '(p,q) a where
@@ -219,15 +204,14 @@     pure $ case lr of
        Left e -> e
        Right (p,q,pp,qq) ->
-         mkNode opts (PresentT (p,q)) [msg] [hh pp, hh qq]
+         mkNode opts (PresentT (p,q)) msg [hh pp, hh qq]
 
 -- | run the predicates in a promoted 3-tuple
 --
 -- >>> pz @'(4, Id, "goodbye") "hello"
--- Present (4,"hello","goodbye")
 -- PresentT (4,"hello","goodbye")
 --
--- >>> pe @'( 'True, 'False, 123) True
+-- >>> pan @'( 'True, 'False, 123) True
 -- P '(,,)
 -- |
 -- +- True 'True
@@ -254,12 +238,11 @@            Left e -> e
            Right r ->
              let hhs1 = hhs0 <> [hh rr]
-             in mkNode opts (PresentT (p,q,r)) [msg] hhs1
+             in mkNode opts (PresentT (p,q,r)) msg hhs1
 
 -- | run the predicates in a promoted 4-tuple
 --
 -- >>> pz @'(4, Id, "inj", 999) "hello"
--- Present (4,"hello","inj",999)
 -- PresentT (4,"hello","inj",999)
 --
 instance (P p a
@@ -280,12 +263,11 @@           Left e -> e
           Right (r,s,rr,ss) ->
             let hhs1 = hhs0 ++ [hh rr, hh ss]
-            in mkNode opts (PresentT (p,q,r,s)) [msg] hhs1
+            in mkNode opts (PresentT (p,q,r,s)) msg hhs1
 
 -- | run the predicates in a promoted 5-tuple
 --
 -- >>> pz @'(4, Id, "inj", 999, 'LT) "hello"
--- Present (4,"hello","inj",999,LT)
 -- PresentT (4,"hello","inj",999,LT)
 --
 instance (P p a
@@ -312,12 +294,11 @@               Left e -> e
               Right t ->
                 let hhs2 = hhs1 <> [hh tt]
-                in mkNode opts (PresentT (p,q,r,s,t)) [msg] hhs2
+                in mkNode opts (PresentT (p,q,r,s,t)) msg hhs2
 
 -- | run the predicates in a promoted 6-tuple
 --
 -- >>> pz @'(4, Id, "inj", 999, 'LT, 1) "hello"
--- Present (4,"hello","inj",999,LT,1)
 -- PresentT (4,"hello","inj",999,LT,1)
 --
 instance (P p a
@@ -345,12 +326,11 @@               Left e -> e
               Right (t,u,tt,uu) ->
                 let hhs2 = hhs1 ++ [hh tt, hh uu]
-                in mkNode opts (PresentT (p,q,r,s,t,u)) [msg] hhs2
+                in mkNode opts (PresentT (p,q,r,s,t,u)) msg hhs2
 
 -- | run the predicates in a promoted 7-tuple
 --
 -- >>> pz @'(4, Id, "inj", 999, 'LT, 1, 2) "hello"
--- Present (4,"hello","inj",999,LT,1,2)
 -- PresentT (4,"hello","inj",999,LT,1,2)
 --
 instance (P p a
@@ -384,12 +364,11 @@                   Left e -> e
                   Right v ->
                     let hhs3 = hhs2 ++ [hh vv]
-                    in mkNode opts (PresentT (p,q,r,s,t,u,v)) [msg] hhs3
+                    in mkNode opts (PresentT (p,q,r,s,t,u,v)) msg hhs3
 
 -- | run the predicates in a promoted 8-tuple
 --
 -- >>> pz @'(4, Id, "inj", 999, 'LT, 1, 2, 3) "hello"
--- Present (4,"hello","inj",999,LT,1,2,3)
 -- PresentT (4,"hello","inj",999,LT,1,2,3)
 --
 instance (P p a
@@ -424,64 +403,57 @@                   Left e -> e
                   Right (v,w,vv,ww) ->
                      let hhs3 = hhs2 ++ [hh vv, hh ww]
-                     in mkNode opts (PresentT (p,q,r,s,t,u,v,w)) [msg] hhs3
+                     in mkNode opts (PresentT (p,q,r,s,t,u,v,w)) msg hhs3
 
 
 -- | extracts the value level representation of the promoted 'Ordering'
 --
 -- >>> pz @'LT "not used"
--- Present LT
 -- PresentT LT
 --
 -- >>> pz @'EQ ()
--- Present EQ
 -- PresentT EQ
 instance GetOrdering cmp => P (cmp :: Ordering) a where
   type PP cmp a = Ordering
   eval _ opts _a =
     let cmp = getOrdering @cmp
         msg = "'" <> show cmp
-    in pure $ mkNode opts (PresentT cmp) [msg] []
+    in pure $ mkNode opts (PresentT cmp) msg []
 
 -- | extracts the value level representation of the type level 'Nat'
 --
 -- >>> pz @123 ()
--- Present 123
 -- PresentT 123
 instance KnownNat n => P (n :: Nat) a where
   type PP n a = Int
   eval _ opts _ =
     let n = nat @n
-    in pure $ mkNode opts (PresentT n) ["'" <> show n] []
+    in pure $ mkNode opts (PresentT n) ("'" <> show n) []
 
 -- | extracts the value level representation of the type level '()
 --
 -- >>> pz @'() ()
--- Present ()
 -- PresentT ()
 instance P '() a where
   type PP '() a = ()
-  eval _ opts _ = pure $ mkNode opts (PresentT ()) ["'()"] []
+  eval _ opts _ = pure $ mkNode opts (PresentT ()) "'()" []
 
 -- 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 '[]
 --
 -- >>> pz @'[] False
--- Present []
 -- PresentT []
 instance P ('[] :: [k]) a where
   type PP ('[] :: [k]) a = [a]
-  eval _ opts _ = pure $ mkNode opts (PresentT mempty) ["'[]"] []
+  eval _ opts _ = pure $ mkNode opts (PresentT mempty) "'[]" []
 
 -- | runs each predicate in turn from the promoted list
 --
 -- >>> pz @'[1, 2, 3] 999
--- Present [1,2,3]
 -- PresentT [1,2,3]
 --
 -- >>> pz @'[W 1, W 2, W 3, Id] 999
--- Present [1,2,3,999]
 -- PresentT [1,2,3,999]
 --
 instance (Show (PP p a), Show a, P p a) => P '[p] a where
@@ -491,7 +463,7 @@     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]
+       Right b -> mkNode opts (PresentT [b]) ("'" <> show0 opts "" [b] <> show1 opts " | " a) [hh pp]
 
 instance (Show (PP p a)
         , Show a
@@ -509,20 +481,17 @@       Right (p,q,pp,qq) ->
         let ret = p:q
         -- no gap between ' and ret!
-        in mkNode opts (PresentT ret) ["'" <> show0 opts "" ret <> show1 opts " | " a] [hh pp, hh qq]
+        in mkNode opts (PresentT ret) ("'" <> show0 opts "" ret <> show1 opts " | " a) [hh pp, hh qq]
 
 -- | extracts the \'a\' from type level \'Maybe a\' if the value exists
 --
 -- >>> pz @('Just Id) (Just 123)
--- Present 123
 -- PresentT 123
 --
 -- >>> pz @('Just Id) (Just True)
--- Present True
 -- PresentT True
 --
 -- >>> pz @('Just Id) Nothing
--- Error 'Just found Nothing
 -- FailT "'Just found Nothing"
 --
 instance (Show (PP p a)
@@ -537,18 +506,16 @@         pp <- eval (Proxy @p) opts a
         pure $ case getValueLR opts msg0 pp [] of
           Left e -> e
-          Right b -> mkNode opts (PresentT b) [show01 opts msg0 b ma] [hh pp]
-      Nothing -> pure $ mkNode opts (FailT (msg0 <> " found Nothing")) [msg0 <> " found Nothing"] []
+          Right b -> mkNode opts (PresentT b) (show01 opts msg0 b ma) [hh pp]
+      Nothing -> pure $ mkNode opts (FailT (msg0 <> " found Nothing")) (msg0 <> " found Nothing") []
 
 -- | expects Nothing otherwise it fails
 -- if the value is Nothing then it returns \'Proxy a\' as this provides more information than '()'
 --
 -- >>> pz @'Nothing Nothing
--- Present Proxy
 -- PresentT Proxy
 --
 -- >>> pz @'Nothing (Just True)
--- Error 'Nothing found Just
 -- FailT "'Nothing found Just"
 --
 instance P 'Nothing (Maybe a) where
@@ -556,18 +523,16 @@   eval _ opts ma =
     let msg0 = "'Nothing"
     in pure $ case ma of
-         Nothing -> mkNode opts (PresentT Proxy) [msg0] []
-         Just _ -> mkNode opts (FailT (msg0 <> " found Just")) [msg0 <> " found Just"] []
+         Nothing -> mkNode opts (PresentT Proxy) msg0 []
+         Just _ -> mkNode opts (FailT (msg0 <> " found Just")) (msg0 <> " found Just") []
 
 -- omitted Show x so we can have less ambiguity
 -- | extracts the \'a\' from type level \'Either a b\' if the value exists
 --
 -- >>> pz @('Left Id) (Left 123)
--- Present 123
 -- PresentT 123
 --
 -- >>> pz @('Left Id) (Right "aaa")
--- Error 'Left found Right
 -- FailT "'Left found Right"
 --
 instance (Show a
@@ -578,21 +543,19 @@   eval _ opts lr =
     let msg0 = "'Left"
     in case lr of
-         Right _ -> pure $ mkNode opts (FailT (msg0 <> " found Right")) [msg0 <> " found Right"] []
+         Right _ -> pure $ mkNode opts (FailT (msg0 <> " found Right")) (msg0 <> " found Right") []
          Left a -> do
             pp <- eval (Proxy @p) opts a
             pure $ case getValueLR opts msg0 pp [] of
                  Left e -> e
-                 Right b -> mkNode opts (_tBool pp) [show01' opts msg0 b "Left " a] [hh pp]
+                 Right b -> mkNode opts (_tBool pp) (show01' opts msg0 b "Left " a) [hh pp]
 
 -- | extracts the \'b\' from type level \'Either a b\' if the value exists
 --
 -- >>> pz @('Right Id) (Right 123)
--- Present 123
 -- PresentT 123
 --
 -- >>> pz @('Right Id) (Left "aaa")
--- Error 'Right found Left
 -- FailT "'Right found Left"
 --
 instance (Show a
@@ -603,27 +566,24 @@   eval _ opts lr = do
     let msg0 = "'Right"
     case lr of
-         Left _ -> pure $ mkNode opts (FailT (msg0 <> " found Left")) [msg0 <> " found Left"] []
+         Left _ -> pure $ mkNode opts (FailT (msg0 <> " found Left")) (msg0 <> " found Left") []
          Right a -> do
             pp <- eval (Proxy @p) opts a
             pure $ case getValueLR opts msg0 pp [] of
                  Left e -> e
-                 Right b -> mkNode opts (_tBool pp) [show01' opts msg0 b "Right " a] [hh pp]
+                 Right b -> mkNode opts (_tBool pp) (show01' opts msg0 b "Right " a) [hh pp]
 
 -- removed Show x: else ambiguity errors in TestPredicate
 
 -- | extracts the \'a\' from type level \'These a b\' if the value exists
 --
 -- >>> pz @('This Id) (This 123)
--- Present 123
 -- PresentT 123
 --
 -- >>> pz @('This Id) (That "aaa")
--- Error 'This found That
 -- FailT "'This found That"
 --
 -- >>> pz @('This Id) (These 999 "aaa")
--- Error 'This found These
 -- FailT "'This found These"
 --
 instance (Show a
@@ -638,21 +598,18 @@             pp <- eval (Proxy @p) opts a
             pure $ case getValueLR opts msg0 pp [] of
                  Left e -> e
-                 Right b -> mkNode opts (_tBool pp) [show01' opts msg0 b "This " a] [hh pp]
-         _ -> pure $ mkNode opts (FailT (msg0 <> " found " <> showThese th)) [msg0 <> " found " <> showThese th] []
+                 Right b -> mkNode opts (_tBool pp) (show01' opts msg0 b "This " a) [hh pp]
+         _ -> pure $ mkNode opts (FailT (msg0 <> " found " <> showThese th)) (msg0 <> " found " <> showThese th) []
 
 -- | extracts the \'b\' from type level \'These a b\' if the value exists
 --
 -- >>> pz @('That Id) (That 123)
--- Present 123
 -- PresentT 123
 --
 -- >>> pz @('That Id) (This "aaa")
--- Error 'That found This
 -- FailT "'That found This"
 --
 -- >>> pz @('That Id) (These 44 "aaa")
--- Error 'That found These
 -- FailT "'That found These"
 --
 instance (Show a
@@ -667,26 +624,22 @@             pp <- eval (Proxy @p) opts a
             pure $ case getValueLR opts msg0 pp [] of
                  Left e -> e
-                 Right b -> mkNode opts (_tBool pp) [show01' opts msg0 b "That " a] [hh pp]
-         _ -> pure $ mkNode opts (FailT (msg0 <> " found " <> showThese th)) [msg0 <> " found " <> showThese th] []
+                 Right b -> mkNode opts (_tBool pp) (show01' opts msg0 b "That " a) [hh pp]
+         _ -> pure $ mkNode opts (FailT (msg0 <> " found " <> showThese th)) (msg0 <> " found " <> showThese th) []
 
 
 -- | extracts the (a,b) from type level 'These a b' if the value exists
 --
 -- >>> pz @('These Id Id) (These 123 "abc")
--- Present (123,"abc")
 -- PresentT (123,"abc")
 --
 -- >>> pz @('These Id 5) (These 123 "abcde")
--- Present (123,5)
 -- PresentT (123,5)
 --
 -- >>> pz @('These Id Id) (This "aaa")
--- Error 'These found This
 -- FailT "'These found This"
 --
 -- >>> pz @('These Id Id) (That "aaa")
--- Error 'These found That
 -- FailT "'These found That"
 --
 instance (Show a
@@ -710,71 +663,66 @@                     Left e -> e
                     Right q ->
                       let ret =(p,q)
-                      in  mkNode opts (PresentT ret) [show01 opts msg0 ret (These a b)] [hh pp, hh qq]
-         _ -> pure $ mkNode opts (FailT (msg0 <> " found " <> showThese th)) [msg0 <> " found " <> showThese th] []
+                      in  mkNode opts (PresentT ret) (show01 opts msg0 ret (These a b)) [hh pp, hh qq]
+         _ -> pure $ mkNode opts (FailT (msg0 <> " found " <> showThese th)) (msg0 <> " found " <> showThese th) []
 
 -- | converts the value to the corresponding 'Proxy'
 --
 -- >>> pz @'Proxy 'x'
--- Present Proxy
 -- PresentT Proxy
 --
 instance Show a => P 'Proxy a where
   type PP 'Proxy a = Proxy a
   eval _ opts a =
     let b = Proxy @a
-    in pure $ mkNode opts (PresentT b) ["'Proxy" <> show1 opts " | " a] []
+    in pure $ mkNode opts (PresentT b) ("'Proxy" <> show1 opts " | " a) []
 
-pe, pe2, pe2a, pe2n, pu, pua, 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 without background colors
-pe2 = peWith @p o2
--- | displays the evaluation tree using colors with background colors
-pe2a = peWith @p o2 { oColor = color1 }
--- | same as 'pe2' but truncates the display tree width: see 'o2n'
-pe2n = peWith @p o2n
--- | same as 'pe2' but allows for wider data
-pe3 = peWith @p o3
+pan, pa, pu, pl, pz, pab, pub :: forall p a . (Show (PP p a), P p a) => a -> IO (BoolT (PP p a))
 -- | skips the evaluation tree and just displays the end result
-pz = peWith @p oz
+pz = run @'OZ @p
 -- | same as 'pz' but adds context to the end result
-pl = peWith @p ol
--- | same as 'pz' but with colors
-plc = peWith @p olc
+pl = run @'OL @p
+-- | displays the evaluation tree in plain text without colors
+pan  = run @'OAN @p
+-- | displays the evaluation tree using colors without background colors
+pa = run @'OA @p
+-- | displays the evaluation tree using background colors
+pab = run @'OAB @p
 -- | display the evaluation tree using unicode and colors
 -- @
 --   pu @'(Id, "abc", 123) [1..4]
 -- @
-pu = peWith @p ou
+pu = run @'OU @p
 -- | displays the evaluation tree using unicode and colors with background colors
-pua = peWith @p ou { oColor = color1 }
--- | same as 'pu' but truncates the display tree width: see 'ou'
-pun = peWith @p oun
+-- | displays the evaluation tree using background colors
+pub = run @'OUB @p
 
-peWith :: forall p a
-        . (Show (PP p a), P p a)
-        => POpts
-        -> a
+run :: forall opts p a
+        . ( OptTC opts
+          , Show (PP p a)
+          , P p a)
+        => a
         -> IO (BoolT (PP p a))
-peWith opts a = do
+run a = do
+  let opts = getOptT @opts
   pp <- eval (Proxy @p) opts a
   let r = pp ^. tBool
-  putStr $ prtTreeX opts pp
+  putStr $ prtTree' opts pp
   return r
 
-prtTreeX :: Show x => POpts -> TT x -> String
-prtTreeX opts pp =
+prtTree' :: Show x => POpts -> TT x -> String
+prtTree' 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)
+  in case oDebug opts of
+       DZero -> ""
+       DLite ->
+             formatOMsg opts " >>> "
+          <> colorBoolT' opts r
+          <> " "
+          <> topMessage pp
+          <> "\n"
+       _ -> formatOMsg opts "\n"
+         <> prtTreePure opts (fromTT pp)
 
 runPQ :: (P p a, P q a, MonadEval m)
    => String
@@ -812,4 +760,26 @@            Left e -> Left e
            Right q -> Right (p, q, pp, qq)
 
-
+-- | typelevel 'BoolT'
+--
+-- >>> pz @'TrueT ()
+-- TrueT
+--
+-- >>> pz @'FalseT ()
+-- FalseT
+--
+-- >>> pz @('PresentT 123) ()
+-- PresentT False
+--
+-- >>> pz @('FailT '[]) ()
+-- FailT "'FailT _"
+--
+instance GetBoolT x b => P (b :: BoolT x) a where
+  type PP b a = Bool
+  eval _ opts _ = do
+    let msg0 = "'BoolT"
+    let ret = getBoolT @x @b
+    pure $ case ret of
+      Left b -> mkNodeB opts b (if b then "TrueT" else "FalseT") []
+      Right True -> mkNode opts (PresentT False) (msg0 <> " PresentT") []
+      Right False -> mkNode opts (FailT "'FailT _") (msg0 <> " FailT") []

@@ -29,7 +29,7 @@   , DdmmyyyyRE
   , Ddmmyyyyop
   , Ddmmyyyyop'
-
+  , JsonMicrosoftDateTime
   -- *** time checkers
   , Hmsip
   , Hmsop
@@ -216,3 +216,18 @@            ]
         ,Guard (PrintT "expected %d mod 10 = 0 but found %d" '(Id, Id `Mod` 10)) (Mod Id 10 == 0)
         ])
+
+-- convert json microsoft datetime to zonedtime
+--type JsonMicrosoftDateTime = Rescan "^Date\\((\\d+[+-]\\d{4})\\)" Id >> Head Id >> Snd Id >> Id !! 0 >> ReplaceOneString 'RPrepend "\\d{3}[+-]" "." Id >> ParseTimeP ZonedTime "%s%Q%z" Id
+
+-- type JsonMicrosoftDateTime = Rescan "^Date\\((\\d+)(\\d{3}[+-]\\d{4})\\)" Id >> Head Id >> Snd Id >> (Id !! 0 <> "." <> Id !! 1)  >> ParseTimeP ZonedTime "%s%Q%z" Id
+
+-- jam the values together
+-- eg pu @JsonMicrosoftDateTime "Date(1593460089052+0800)"
+type JsonMicrosoftDateTime =
+  Do '[ Rescan "^Date\\((\\d+)(\\d{3}[+-]\\d{4})\\)" Id
+      , Head Id
+      , Snd Id
+      , Id !! 0 <> "." <> Id !! 1
+      , ParseTimeP ZonedTime "%s%Q%z" Id
+      ]

@@ -0,0 +1,56 @@+{-# OPTIONS -Wall #-}
+{-# OPTIONS -Wcompat #-}
+{-# OPTIONS -Wincomplete-record-updates #-}
+{-# OPTIONS -Wincomplete-uni-patterns #-}
+{-# OPTIONS -Wredundant-constraints #-}
+{-# OPTIONS -Wincomplete-record-updates #-}
+{-# OPTIONS -Wno-unused-imports #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE NoStarIsType #-}
+{- |
+     Contains imports needed for 'Refined1'
+-}
+module Predicate.Examples.Refined1 where
+import Predicate.Examples.Common
+import Predicate.Refined
+import Predicate.Refined1
+import Predicate.Refined3
+import Predicate.Examples.Refined3
+import Predicate.Core
+import Predicate.Prelude
+import Predicate.Util
+import Predicate.Util_TH
+import Predicate.TH_Orphans ()
+import Data.Proxy
+import GHC.TypeLits (KnownNat, Nat)
+import Data.Kind (Type)
+import Data.Time
+
+-- $setup
+-- >>> :set -XDataKinds
+-- >>> :set -XTypeApplications
+-- >>> :set -XTypeOperators
+-- >>> :set -XTemplateHaskell
+
+-- | tests
+--
+-- >>> :m + Data.Ratio
+-- >>> newRefined1P (readshow @'OZ @Rational) "13 % 3"
+-- Right (Refined1 (13 % 3))
+--
+-- >>> newRefined1P (readshow @'OZ @Rational) "13x % 3"
+-- Left "Step 1. Initial Conversion(ip) Failed | ReadP Ratio Integer (13x % 3)"
+--
+-- >>> newRefined1P (Proxy @(ReadShow' 'OZ Rational (11 -% 2 <..> 3 -% 1))) "-13 % 3"
+-- Right (Refined1 ((-13) % 3))
+--

@@ -3,6 +3,7 @@ {-# OPTIONS -Wincomplete-record-updates #-}
 {-# OPTIONS -Wincomplete-uni-patterns #-}
 {-# OPTIONS -Wredundant-constraints #-}
+{-# OPTIONS -Wno-unused-imports #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -16,7 +17,7 @@ {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE NoStarIsType #-}
 {- |
-     Contains prepackaged 3-tuples to use with 'Refined2'
+     Contains prepackaged 4-tuples to use with 'Refined2'
 -}
 module Predicate.Examples.Refined2 (
   -- ** date time checkers
@@ -34,7 +35,7 @@   , Hms
   , HmsR
 
-  , hms'
+--  , hms'
   , Hms'
   , HmsR'
 
@@ -69,10 +70,13 @@   , BaseIJip
    ) where
 import Predicate.Core
+import Predicate.Refined
 import Predicate.Refined2
 import Predicate.Examples.Common
 import Predicate.Prelude
---import Predicate.Util
+import Predicate.Util
+import Predicate.Util_TH
+import Predicate.TH_Orphans ()
 import GHC.TypeLits (Nat)
 import Data.Time
 import Data.Kind
@@ -82,178 +86,168 @@ -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
 -- >>> :set -XTypeOperators
--- >>> :m + Predicate.Refined2
--- >>> :m + Predicate.Util
+-- >>> :set -XTemplateHaskell
 
 -- | credit card with luhn algorithm
 --
--- >>> prtEval2 @Ccip @(Ccop 11) oz "1234-5678-901"
--- Left Step 2. False Boolean Check(op) | FalseP
+-- >>> newRefined2 @'OZ @Ccip @(Ccop 11) "1234-5678-901"
+-- Left "Step 2. False Boolean Check(op) | FalseP"
 --
--- >>> prtEval2 @Ccip @(Ccop 11) oz "1234-5678-903"
+-- >>> newRefined2 @'OZ @Ccip @(Ccop 11) "1234-5678-903"
 -- Right (Refined2 {r2In = [1,2,3,4,5,6,7,8,9,0,3], r2Out = "1234-5678-903"})
 --
 -- >>> pz @(Ccip >> Ccop 11) "79927398713"
--- True
 -- TrueT
 --
 -- >>> pz @(Ccip >> Ccop 10) "79927398713"
--- Error expected 10 digits but found 11
 -- FailT "expected 10 digits but found 11"
 --
-type Ccn (n :: Nat) = '(Ccip, Ccop n, String)
+type Ccn (opts :: OptT) (n :: Nat) = '(opts, Ccip, Ccop n, String)
 
 -- | read in a valid datetime
 --
--- >>> prtEval2 @(Dtip LocalTime) @'True ol "2018-09-14 02:57:04"
+-- >>> newRefined2 @'OL @(Dtip LocalTime) @'True "2018-09-14 02:57:04"
 -- Right (Refined2 {r2In = 2018-09-14 02:57:04, r2Out = "2018-09-14 02:57:04"})
 --
--- >>> prtEval2 @(Dtip LocalTime) @'True ol "2018-09-99 12:12:12"
--- Left Step 1. Initial Conversion(ip) Failed | ParseTimeP LocalTime (%F %T) failed to parse
+-- >>> newRefined2 @'OL @(Dtip LocalTime) @'True "2018-09-99 12:12:12"
+-- Left "Step 1. Initial Conversion(ip) Failed | ParseTimeP LocalTime (%F %T) failed to parse"
 --
-type DateTime1 (t :: Type) = '(Dtip t, 'True, String)
-
-datetime1 :: Proxy (DateTime1 t)
+datetime1 :: Proxy (DateTime1 opts t)
 datetime1 = mkProxy2
 
+type DateTime1 (opts :: OptT) (t :: Type) = '(opts, Dtip t, 'True, String)
 
-datetimen :: Proxy DateTimeN
+datetimen :: OptTC opts => Proxy (DateTimeN opts)
 datetimen = mkProxy2'
 
 -- valid dates for for DateFmts are "2001-01-01" "Jan 24 2009" and "03/29/07"
-type DateN = '(ParseTimes Day DateFmts Id, 'True, String)
+type DateN (opts :: OptT) = '(opts,ParseTimes Day DateFmts Id, 'True, String)
 
-daten :: Proxy DateN
+daten :: OptTC opts => Proxy (DateN opts)
 daten = mkProxy2'
 
-type DateTimeNR = MakeR2 DateTimeN
-type DateTimeN = '(ParseTimes UTCTime DateTimeFmts Id, 'True, String)
-
--- fixed in time-1.9
--- 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 DateTimeNR (opts :: OptT) = MakeR2 (DateTimeN opts)
+type DateTimeN (opts :: OptT) = '(opts, ParseTimes UTCTime DateTimeFmts Id, 'True, String)
 
 -- | read in an ssn
 --
--- >>> prtEval2 @Ssnip @Ssnop oz "134-01-2211"
+-- >>> newRefined2 @'OZ @Ssnip @Ssnop "134-01-2211"
 -- Right (Refined2 {r2In = [134,1,2211], r2Out = "134-01-2211"})
 --
--- >>> prtEval2 @Ssnip @Ssnop ol "666-01-2211"
--- Left Step 2. False Boolean Check(op) | {Bool(0) [number for group 0 invalid: found 666] (True && False | (666 /= 666))}
+-- >>> newRefined2 @'OL @Ssnip @Ssnop "666-01-2211"
+-- Left "Step 2. False Boolean Check(op) | {Bool(0) [number for group 0 invalid: found 666] (True && False | (666 /= 666))}"
 --
--- >>> prtEval2 @Ssnip @Ssnop ol "667-00-2211"
--- Left Step 2. False Boolean Check(op) | {Bool(1) [number for group 1 invalid: found 0] (1 <= 0)}
+-- >>> newRefined2 @'OL @Ssnip @Ssnop "667-00-2211"
+-- Left "Step 2. False Boolean Check(op) | {Bool(1) [number for group 1 invalid: found 0] (1 <= 0)}"
 --
 
-ssn :: Proxy Ssn
+ssn :: OptTC opts => Proxy (Ssn opts)
 ssn = mkProxy2'
 
-type SsnR = MakeR2 Ssn
-type Ssn = '(Ssnip, Ssnop, String)
+type SsnR (opts :: OptT) = MakeR2 (Ssn opts)
+type Ssn (opts :: OptT) = '(opts, Ssnip, Ssnop, String)
 
 
 -- | read in a time and validate it
 --
--- >>> prtEval2 @Hmsip @Hmsop' ol "23:13:59"
+-- >>> newRefined2 @'OL @Hmsip @Hmsop' "23:13:59"
 -- Right (Refined2 {r2In = [23,13,59], r2Out = "23:13:59"})
 --
--- >>> prtEval2 @Hmsip @Hmsop' ol "23:13:60"
--- Left Step 2. False Boolean Check(op) | {Bool(2) [seconds] (60 <= 59)}
+-- >>> newRefined2 @'OL @Hmsip @Hmsop' "23:13:60"
+-- Left "Step 2. False Boolean Check(op) | {Bool(2) [seconds] (60 <= 59)}"
 --
--- >>> prtEval2 @Hmsip @Hmsop' ol "26:13:59"
--- Left Step 2. False Boolean Check(op) | {Bool(0) [hours] (26 <= 23)}
+-- >>> newRefined2 @'OL @Hmsip @Hmsop' "26:13:59"
+-- Left "Step 2. False Boolean Check(op) | {Bool(0) [hours] (26 <= 23)}"
 --
-hms :: Proxy Hms
+hms :: OptTC opts => Proxy (Hms opts)
 hms = mkProxy2'
 
-type HmsR = MakeR2 Hms
-type Hms = '(Hmsip, Hmsop >> 'True, String)
+type HmsR (opts :: OptT) = MakeR2 (Hms opts)
+type Hms (opts :: OptT) = '(opts, Hmsip, Hmsop >> 'True, String)
 
-hms' :: Proxy Hms'
-hms' = mkProxy2'
+--hms' :: Proxy (Hms' 'OZ)
+--hms' = mkProxy2'
 
-type HmsR' = MakeR2 Hms'
-type Hms' = '(Hmsip, Hmsop', String)
+type HmsR' (opts :: OptT) = MakeR2 (Hms' opts)
+type Hms' (opts :: OptT) = '(opts, Hmsip, Hmsop', String)
 
 -- | read in an ipv4 address and validate it
 --
--- >>> prtEval2 @Ip4ip @Ip4op' oz "001.223.14.1"
+-- >>> newRefined2 @'OZ @Ip4ip @Ip4op' "001.223.14.1"
 -- Right (Refined2 {r2In = [1,223,14,1], r2Out = "001.223.14.1"})
 --
--- >>> prtEval2 @Ip4ip @Ip4op' ol "001.223.14.999"
--- Left Step 2. False Boolean Check(op) | {Bool(3) [octet 3 out of range 0-255 found 999] (999 <= 255)}
+-- >>> newRefined2 @'OL @Ip4ip @Ip4op' "001.223.14.999"
+-- Left "Step 2. False Boolean Check(op) | {Bool(3) [octet 3 out of range 0-255 found 999] (999 <= 255)}"
 --
--- >>> prtEval2P ip4 ol "001.223.14.999"
--- Left Step 2. Failed Boolean Check(op) | octet 3 out of range 0-255 found 999
+-- >>> newRefined2P (ip4 @'OL) "001.223.14.999"
+-- Left "Step 2. Failed Boolean Check(op) | octet 3 out of range 0-255 found 999"
 --
--- >>> prtEval2P ip4 ol "001.223.14.999.1"
--- Left Step 2. Failed Boolean Check(op) | Guards:invalid length(5) expected 4
+-- >>> newRefined2P (ip4 @'OL) "001.223.14.999.1"
+-- Left "Step 2. Failed Boolean Check(op) | Guards:invalid length(5) expected 4"
 --
--- >>> prtEval2P ip4 ol "001.257.14.1"
--- Left Step 2. Failed Boolean Check(op) | octet 1 out of range 0-255 found 257
+-- >>> newRefined2P (ip4 @'OL) "001.257.14.1"
+-- Left "Step 2. Failed Boolean Check(op) | octet 1 out of range 0-255 found 257"
 --
-type Ip4R = MakeR2 Ip4
-type Ip4 = '(Ip4ip, Ip4op >> 'True, String) -- guards
+type Ip4R (opts :: OptT) = MakeR2 (Ip4 opts)
+type Ip4 (opts :: OptT) = '(opts, Ip4ip, Ip4op >> 'True, String) -- guards
 
-ip4 :: Proxy Ip4
+ip4 :: Proxy (Ip4 opts)
 ip4 = Proxy
 
-type Ip4R' = MakeR2 Ip4'
-type Ip4' = '(Ip4ip, Ip4op', String) -- boolean predicates
+type Ip4R' (opts :: OptT) = MakeR2 (Ip4' opts)
+type Ip4' (opts :: OptT) = '(opts, Ip4ip, Ip4op', String) -- boolean predicates
 
-ip4' :: Proxy Ip4'
+ip4' :: Proxy (Ip4' opts)
 ip4' = Proxy
 
-type Ip6R = MakeR2 Ip6
-type Ip6 = '(Ip6ip, Ip6op, String) -- guards
+type Ip6R (opts :: OptT) = MakeR2 (Ip6 opts)
+type Ip6 (opts :: OptT) = '(opts, Ip6ip, Ip6op, String) -- guards
 
-ip6 :: Proxy Ip6
+ip6 :: Proxy (Ip6 opts)
 ip6 = Proxy
 
 
-cc11 :: Proxy (Ccn 11)
+cc11 :: Proxy (Ccn opts 11)
 cc11 = Proxy
 
 -- | convert a string from a given base \'i\' and store it internally as an base 10 integer
 --
--- >>> prtEval2 @(ReadBase Int 16 Id) @'True oz "00fe"
+-- >>> newRefined2 @'OZ @(ReadBase Int 16 Id) @'True "00fe"
 -- Right (Refined2 {r2In = 254, r2Out = "00fe"})
 --
--- >>> prtEval2 @(ReadBase Int 16 Id) @(Between 100 400 Id) oz "00fe"
+-- >>> newRefined2 @'OZ @(ReadBase Int 16 Id) @(Between 100 400 Id) "00fe"
 -- Right (Refined2 {r2In = 254, r2Out = "00fe"})
 --
--- >>> prtEval2 @(ReadBase Int 16 Id) @(GuardSimple (Id < 400) >> 'True) oz "f0fe"
--- Left Step 2. Failed Boolean Check(op) | (61694 < 400)
+-- >>> newRefined2 @'OZ @(ReadBase Int 16 Id) @(GuardSimple (Id < 400) >> 'True) "f0fe"
+-- Left "Step 2. Failed Boolean Check(op) | (61694 < 400)"
 --
--- >>> prtEval2 @(ReadBase Int 16 Id) @(Id < 400) ol "f0fe" -- todo: why different parens vs braces
--- Left Step 2. False Boolean Check(op) | {61694 < 400}
+-- >>> newRefined2 @'OL @(ReadBase Int 16 Id) @(Id < 400) "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 Id, p, String)
+type BaseN (opts :: OptT) (n :: Nat) = BaseN' opts n 'True
+type BaseN' (opts :: OptT) (n :: Nat) p = '(opts,ReadBase Int n Id, p, String)
 
 
 -- | Luhn check
 --
--- >>> prtEval2 @Luhnip @(Luhnop 4) oz "1230"
+-- >>> newRefined2 @'OZ @Luhnip @(Luhnop 4) "1230"
 -- Right (Refined2 {r2In = [1,2,3,0], r2Out = "1230"})
 --
--- >>> prtEval2 @Luhnip @(Luhnop 4) ol "1234"
--- Left Step 2. False Boolean Check(op) | {True && False | (Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])}
+-- >>> newRefined2 @'OL @Luhnip @(Luhnop 4) "1234"
+-- 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'
 
 -- | convert a string from a given base \'i\' and store it internally as a base \'j\' string
 --
--- >>> prtEval2 @(BaseIJip 16 2) @'True oz "fe"
+-- >>> newRefined2 @'OZ @(BaseIJip 16 2) @'True "fe"
 -- Right (Refined2 {r2In = "11111110", r2Out = "fe"})
 --
--- >>> prtEval2 @(BaseIJip 16 2) @'True oz "fge"
--- Left Step 1. Initial Conversion(ip) Failed | invalid base 16
+-- >>> newRefined2 @'OZ @(BaseIJip 16 2) @'True "fge"
+-- Left "Step 1. Initial Conversion(ip) Failed | invalid base 16"
 --
--- >>> prtEval2 @(BaseIJip 16 2) @(ReadBase Int 2 Id < 1000) ol "ffe"
--- Left Step 2. False Boolean Check(op) | {4094 < 1000}
+-- >>> newRefined2 @'OL @(BaseIJip 16 2) @(ReadBase Int 2 Id < 1000) "ffe"
+-- Left "Step 2. False Boolean Check(op) | {4094 < 1000}"
 --
 type BaseIJip (i :: Nat) (j :: Nat) = ReadBase Int i Id >> ShowBase j Id
 
@@ -263,37 +257,36 @@ -- | take any valid Read/Show instance and turn it into a valid 'Predicate.Refined2.Refined2'
 --
 -- >>> :m + Data.Ratio
--- >>> prtEval2 @(ReadP Rational Id) @'True oz "13 % 3"
+-- >>> newRefined2 @'OZ @(ReadP Rational Id) @'True "13 % 3"
 -- Right (Refined2 {r2In = 13 % 3, r2Out = "13 % 3"})
 --
--- >>> prtEval2 @(ReadP Rational Id) @'True oz "13x % 3"
--- Left Step 1. Initial Conversion(ip) Failed | ReadP Ratio Integer (13x % 3)
+-- >>> newRefined2 @'OZ @(ReadP Rational Id) @'True "13x % 3"
+-- Left "Step 1. Initial Conversion(ip) Failed | ReadP Ratio Integer (13x % 3)"
 --
--- >>> prtEval2 @(ReadP Rational Id) @(3 % 1 <..> 5 % 1) oz "13 % 3"
+-- >>> newRefined2 @'OZ @(ReadP Rational Id) @(3 % 1 <..> 5 % 1) "13 % 3"
 -- Right (Refined2 {r2In = 13 % 3, r2Out = "13 % 3"})
 --
--- >>> prtEval2 @(ReadP Rational Id) @(11 -% 2 <..> 3 -% 1) oz "-13 % 3"
+-- >>> newRefined2 @'OZ @(ReadP Rational Id) @(11 -% 2 <..> 3 -% 1) "-13 % 3"
 -- Right (Refined2 {r2In = (-13) % 3, r2Out = "-13 % 3"})
 --
--- >>> prtEval2 @(ReadP Rational Id) @(Id > (15 % 1)) oz "13 % 3"
--- Left Step 2. False Boolean Check(op) | FalseP
+-- >>> newRefined2 @'OZ @(ReadP Rational Id) @(Id > (15 % 1)) "13 % 3"
+-- Left "Step 2. False Boolean Check(op) | FalseP"
 --
--- >>> prtEval2 @(ReadP Rational Id) @(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}
+-- >>> newRefined2 @'OL @(ReadP Rational Id) @(Msg (PrintF "invalid=%3.2f" (FromRational Double Id)) (Id > (15 % 1))) "13 % 3"
+-- Left "Step 2. False Boolean Check(op) | {invalid=4.3313 % 3 > 15 % 1}"
 --
--- >>> prtEval2 @(ReadP Rational Id) @(Id > (11 % 1)) oz "13 % 3"
--- Left Step 2. False Boolean Check(op) | FalseP
+-- >>> newRefined2 @'OZ @(ReadP Rational Id) @(Id > (11 % 1)) "13 % 3"
+-- Left "Step 2. False Boolean Check(op) | FalseP"
 --
 -- >>> let tmString = "2018-10-19 14:53:11.5121359 UTC"
 -- >>> let tm = read tmString :: UTCTime
--- >>> prtEval2 @(ReadP UTCTime Id) @'True oz tmString
+-- >>> newRefined2 @'OZ @(ReadP UTCTime Id) @'True tmString
 -- Right (Refined2 {r2In = 2018-10-19 14:53:11.5121359 UTC, r2Out = "2018-10-19 14:53:11.5121359 UTC"})
 --
 -- >>> :m + Data.Aeson
--- >>> prtEval2 @(ReadP Value Id) @'True oz "String \"jsonstring\""
+-- >>> newRefined2 @'OZ @(ReadP Value Id) @'True "String \"jsonstring\""
 -- Right (Refined2 {r2In = String "jsonstring", r2Out = "String \"jsonstring\""})
 --
--- >>> prtEval2 @(ReadP Value Id) @'True oz "Number 123.4"
+-- >>> newRefined2 @'OZ @(ReadP Value Id) @'True "Number 123.4"
 -- Right (Refined2 {r2In = Number 123.4, r2Out = "Number 123.4"})
 --
-

@@ -3,6 +3,8 @@ {-# OPTIONS -Wincomplete-record-updates #-}
 {-# OPTIONS -Wincomplete-uni-patterns #-}
 {-# OPTIONS -Wredundant-constraints #-}
+{-# OPTIONS -Wincomplete-record-updates #-}
+{-# OPTIONS -Wno-unused-imports #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -16,7 +18,7 @@ {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE NoStarIsType #-}
 {- |
-     Contains prepackaged 4-tuples and proxies to use with 'Refined3'
+     Contains prepackaged 5-tuples and proxies to use with 'Refined3'
 -}
 module Predicate.Examples.Refined3 (
   -- ** date time checkers
@@ -34,7 +36,7 @@   , Hms
   , HmsR
 
-  , hms'
+--  , hms'
   , Hms'
   , HmsR'
 
@@ -43,7 +45,7 @@   , ccn'
   , Ccn
   , cc11
-  , CC11
+  , Cc11
   , LuhnR
   , LuhnT
 
@@ -98,12 +100,16 @@   , oknot
   , OkNot
   , OkNotR
+
    ) where
 import Predicate.Examples.Common
+import Predicate.Refined
 import Predicate.Refined3
 import Predicate.Core
 import Predicate.Prelude
 import Predicate.Util
+import Predicate.Util_TH
+import Predicate.TH_Orphans ()
 import Data.Proxy
 import GHC.TypeLits (KnownNat, Nat)
 import Data.Kind (Type)
@@ -113,51 +119,54 @@ -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
 -- >>> :set -XTypeOperators
+-- >>> :set -XTemplateHaskell
 
 -- | credit card with luhn algorithm
 --
--- >>> prtEval3P cc11 oz "1234-5678-901"
--- Left Step 2. False Boolean Check(op) | FalseP
+-- >>> newRefined3P (cc11 @'OZ) "1234-5678-901"
+-- Left "Step 2. False Boolean Check(op) | FalseP"
 --
--- >>> prtEval3P cc11 oz "1234-5678-903"
+-- >>> newRefined3P (cc11 @'OZ) "1234-5678-903"
 -- Right (Refined3 {r3In = [1,2,3,4,5,6,7,8,9,0,3], r3Out = "1234-5678-903"})
 --
 -- >>> pz @(Ccip >> Ccop 11) "79927398713"
--- True
 -- TrueT
 --
 -- >>> pz @(Ccip >> Ccop 10) "79927398713"
--- Error expected 10 digits but found 11
 -- FailT "expected 10 digits but found 11"
 --
 
-type Ccn (ns :: [Nat]) = '(Ccip, Ccop (SumT ns), Ccfmt ns, String)
+type Ccn (opts :: OptT) (ns :: [Nat]) = '(opts, Ccip, Ccop (SumT ns), Ccfmt ns, String)
 
-type CC11 = Ccn '[4,4,3]
+type Cc11 (opts :: OptT) = Ccn opts '[4,4,3]
 
-ccn :: Proxy (Ccn ns)
+ccn :: Proxy (Ccn opts ns)
 ccn = mkProxy3
 
 -- works but have to add all the constraints
-ccn' :: (PP ns String ~ [Integer], KnownNat (SumT ns), P ns String) => Proxy (Ccn ns)
+ccn' :: ( OptTC opts
+        , PP ns String ~ [Integer]
+        , KnownNat (SumT ns)
+        , P ns String
+        ) => Proxy (Ccn opts ns)
 ccn' = mkProxy3'
 
-cc11 :: Proxy (Ccn '[4,4,3])   -- or Proxy CC11
+cc11 :: OptTC opts => Proxy (Ccn opts '[4,4,3])   -- or Proxy Cc11
 cc11 = mkProxy3'
 
 -- | read in a valid datetime
 --
--- >>> prtEval3P (datetime1 @LocalTime) ol "2018-09-14 02:57:04"
+-- >>> newRefined3P (datetime1 @'OL @LocalTime) "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) ol "2018-09-99 12:12:12"
--- Left Step 1. Initial Conversion(ip) Failed | ParseTimeP LocalTime (%F %T) failed to parse
+-- >>> newRefined3P (datetime1 @'OL @LocalTime) "2018-09-99 12:12:12"
+-- Left "Step 1. Initial Conversion(ip) Failed | ParseTimeP LocalTime (%F %T) failed to parse"
 --
-datetime1 :: Proxy (DateTime1 t)
+datetime1 :: Proxy (DateTime1 opts t)
 datetime1 = mkProxy3
 
 -- now that time is actually validated we dont need Dtop*
-type DateTime1 (t :: Type) = '(Dtip t, 'True, Dtfmt, String)
+type DateTime1 (opts :: OptT) (t :: Type) = '( opts, Dtip t, 'True, Dtfmt, String)
 
 -- fixed in time-1.9
 -- extra check to validate the time as parseTime doesnt validate the time component
@@ -165,148 +174,131 @@ -- 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
 
-ssn :: Proxy Ssn
+-- valid dates for for DateFmts are "2001-01-01" "Jan 24 2009" and "03/29/07"
+type DateN (opts :: OptT) = '( opts, ParseTimes Day DateFmts Id, 'True, FormatTimeP "%Y-%m-%d" Id, String)
+
+type DateTimeNR (opts :: OptT) = MakeR3 (DateTimeN opts)
+type DateTimeN (opts :: OptT) = '(opts, ParseTimes UTCTime DateTimeFmts Id, 'True, FormatTimeP "%Y-%m-%d %H:%M:%S" Id, String)
+
+ssn :: OptTC opts => Proxy (Ssn opts)
 ssn = mkProxy3'
 
 -- | read in an ssn
 --
--- >>> prtEval3P ssn oz "134-01-2211"
+-- >>> newRefined3P (ssn @'OZ) "134-01-2211"
 -- Right (Refined3 {r3In = [134,1,2211], r3Out = "134-01-2211"})
 --
--- >>> prtEval3P ssn ol "666-01-2211"
--- Left Step 2. False Boolean Check(op) | {Bool(0) [number for group 0 invalid: found 666] (True && False | (666 /= 666))}
+-- >>> newRefined3P (ssn @'OL) "666-01-2211"
+-- Left "Step 2. False Boolean Check(op) | {Bool(0) [number for group 0 invalid: found 666] (True && False | (666 /= 666))}"
 --
--- >>> prtEval3P ssn ol "667-00-2211"
--- Left Step 2. False Boolean Check(op) | {Bool(1) [number for group 1 invalid: found 0] (1 <= 0)}
+-- >>> newRefined3P (ssn @'OL) "667-00-2211"
+-- Left "Step 2. False Boolean Check(op) | {Bool(1) [number for group 1 invalid: found 0] (1 <= 0)}"
 --
-type Ssn = '(Ssnip, Ssnop, Ssnfmt, String)
-type SsnR = MakeR3 Ssn
+type Ssn (opts :: OptT) = '(opts, Ssnip, Ssnop, Ssnfmt, String)
+type SsnR (opts :: OptT) = MakeR3 (Ssn opts)
 -- | read in a time and validate it
 --
--- >>> prtEval3P hms ol "23:13:59"
+-- >>> newRefined3P (hms @'OL) "23:13:59"
 -- 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
+-- >>> newRefined3P (hms @'OL) "23:13:60"
+-- Left "Step 2. Failed Boolean Check(op) | seconds invalid: found 60"
 --
--- >>> prtEval3P hms ol "26:13:59"
--- Left Step 2. Failed Boolean Check(op) | hours invalid: found 26
+-- >>> newRefined3P (hms @'OL) "26:13:59"
+-- Left "Step 2. Failed Boolean Check(op) | hours invalid: found 26"
 --
-hms :: Proxy Hms
+hms :: OptTC opts => Proxy (Hms opts)
 hms = mkProxy3'
 
-type HmsR = MakeR3 Hms
-
-type Hms = '(Hmsip, Hmsop >> 'True, Hmsfmt, String)
-
-
-hms' :: Proxy Hms'
-hms' = mkProxy3'
-
-type HmsR' = MakeR3 Hms'
+type HmsR (opts :: OptT) = MakeR3 (Hms opts)
+type Hms (opts :: OptT) = '(opts, Hmsip, Hmsop >> 'True, Hmsfmt, String)
 
-type Hms' = '(Hmsip, Hmsop', Hmsfmt, String)
+type HmsR' (opts :: OptT) = MakeR3 (Hms' opts)
+type Hms' (opts :: OptT) = '(opts, Hmsip, Hmsop', Hmsfmt, String)
 
 
 -- | read in an ipv4 address and validate it
 --
--- >>> prtEval3P ip4 oz "001.223.14.1"
+-- >>> newRefined3P (ip4 @'OZ) "001.223.14.1"
 -- Right (Refined3 {r3In = [1,223,14,1], r3Out = "001.223.014.001"})
 --
--- >>> prtEval3P ip4 ol "001.223.14.999"
--- Left Step 2. Failed Boolean Check(op) | octet 3 out of range 0-255 found 999
+-- >>> newRefined3P (ip4 @'OL) "001.223.14.999"
+-- Left "Step 2. Failed Boolean Check(op) | octet 3 out of range 0-255 found 999"
 --
--- >>> prtEval3P ip4 oz "001.223.14.999.1"
--- Left Step 2. Failed Boolean Check(op) | Guards:invalid length(5) expected 4
+-- >>> newRefined3P (ip4 @'OZ) "001.223.14.999.1"
+-- Left "Step 2. Failed Boolean Check(op) | Guards:invalid length(5) expected 4"
 --
--- >>> prtEval3P ip4 ol "001.257.14.1"
--- Left Step 2. Failed Boolean Check(op) | octet 1 out of range 0-255 found 257
+-- >>> newRefined3P (ip4 @'OL) "001.257.14.1"
+-- Left "Step 2. Failed Boolean Check(op) | octet 1 out of range 0-255 found 257"
 --
-type Ip4R = MakeR3 Ip4
-
-type Ip4 = '(Ip4ip, Ip4op >> 'True, Ip4fmt, String) -- guards
+type Ip4R (opts :: OptT) = MakeR3 (Ip4 opts)
+type Ip4 (opts :: OptT) = '( opts, Ip4ip, Ip4op >> 'True, Ip4fmt, String) -- guards
 
-ip4 :: Proxy Ip4
+ip4 :: OptTC opts => Proxy (Ip4 opts)
 ip4 = mkProxy3'
 
-type Ip4R' = MakeR3 Ip4'
-type Ip4' = '(Ip4ip, Ip4op', Ip4fmt, String) -- boolean predicates
+type Ip4R' (opts :: OptT) = MakeR3 (Ip4' opts)
+type Ip4' (opts :: OptT) = '( opts, Ip4ip, Ip4op', Ip4fmt, String) -- boolean predicates
 
-ip4' :: Proxy Ip4'
+ip4' :: OptTC opts => Proxy (Ip4' opts)
 ip4' = mkProxy3'
 
-type Ip6R = MakeR3 Ip6
-type Ip6 = '(Ip6ip, Ip6op, Ip6fmt, String) -- guards
+type Ip6R (opts :: OptT) = MakeR3 (Ip6 opts)
+type Ip6 (opts :: OptT) = '( opts, Ip6ip, Ip6op, Ip6fmt, String) -- guards
 
-ip6 :: Proxy Ip6
+ip6 :: Proxy (Ip6 opts)
 ip6 = Proxy
 
--- valid dates for for DateFmts are "2001-01-01" "Jan 24 2009" and "03/29/07"
-type DateN = '(ParseTimes Day DateFmts Id, 'True, FormatTimeP "%Y-%m-%d" Id, String)
-
-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 oz "00fe"
+-- >>> newRefined3P (base16 @'OZ) "00fe"
 -- Right (Refined3 {r3In = 254, r3Out = "fe"})
 --
--- >>> prtEval3P (basen' @16 @(100 <..> 400)) oz "00fe"
+-- >>> newRefined3P (basen' @'OZ @16 @(100 <..> 400)) "00fe"
 -- Right (Refined3 {r3In = 254, r3Out = "fe"})
 --
--- >>> prtEval3P (basen' @16 @(GuardSimple (Id < 400) >> 'True)) oz "f0fe"
--- Left Step 2. Failed Boolean Check(op) | (61694 < 400)
+-- >>> newRefined3P (basen' @'OZ @16 @(GuardSimple (Id < 400) >> 'True)) "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}
+-- >>> newRefined3P (basen' @'OL @16 @(Id < 400)) "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 Id, p, ShowBase n Id, String)
+type BaseN (opts :: OptT) (n :: Nat) = BaseN' opts n 'True
+type BaseN' (opts :: OptT) (n :: Nat) p = '( opts, ReadBase Int n Id, p, ShowBase n Id, String)
 
-base16 :: Proxy (BaseN 16)
+base16 :: Proxy (BaseN opts 16)
 base16 = basen
 
-base16' :: Proxy (BaseN' 16 p)
+base16' :: Proxy (BaseN' opts 16 p)
 base16' = basen'
 
-base2 :: Proxy (BaseN 2)
+base2 :: Proxy (BaseN opts 2)
 base2 = basen
 
-base2' :: Proxy (BaseN' 2 p)
+base2' :: Proxy (BaseN' opts 2 p)
 base2' = basen'
 
-basen :: Proxy (BaseN n)
+basen :: Proxy (BaseN opts n)
 basen = mkProxy3
 
-basen' :: Proxy (BaseN' n p)
+basen' :: Proxy (BaseN' opts n p)
 basen' = mkProxy3
 
-{-
-basen' :: forall n p
-       . (P p Int
-       , PP p Int ~ Bool
-       , KnownNat n
-       , (n GN.<=? 36) ~ 'True
-       , (2 GN.<=? n) ~ 'True
-       ) => Proxy (BaseN' n p)
-basen' = mkProxy3
--}
-daten :: Proxy DateN
+daten :: OptTC opts => Proxy (DateN opts)
 daten = mkProxy3'
 
-datetimen :: Proxy DateTimeN
+datetimen :: OptTC opts => Proxy (DateTimeN opts)
 datetimen = mkProxy3'
 
 -- | ensures that two numbers are in a given range (emulates 'Refined.Refined')
 --
--- >>> prtEval3P (between @10 @16) oz 14
+-- >>> newRefined3P (between @'OZ @10 @16) 14
 -- Right (Refined3 {r3In = 14, r3Out = 14})
 --
--- >>> prtEval3P (between @10 @16) oz 17
--- Left Step 2. False Boolean Check(op) | FalseP
+-- >>> newRefined3P (between @'OZ @10 @16) 17
+-- Left "Step 2. False Boolean Check(op) | FalseP"
 --
--- >>> prtEval3P (between @10 @16) o0 17
+-- >>> prtEval3P (between @'OAN @10 @16) 17
 -- Left Step 2. False Boolean Check(op) | {17 <= 16}
 -- <BLANKLINE>
 -- *** Step 1. Success Initial Conversion(ip) [17] ***
@@ -324,39 +316,40 @@ -- `- P '16
 -- <BLANKLINE>
 --
-between :: Proxy (BetweenN m n)
+between :: Proxy (BetweenN opts m n)
 between = mkProxy3
 
-type BetweenN m n = '(Id, Between m n Id, Id, Int)
-type BetweenR m n = RefinedEmulate (Between m n Id) Int
+type BetweenN (opts :: OptT) m n = '( opts, Id, Between m n Id, Id, Int)
+type BetweenR (opts :: OptT) m n = RefinedEmulate opts (Between m n Id) Int
 
-type LuhnR (n :: Nat) = MakeR3 (LuhnT n)
+type LuhnR (opts :: OptT) (n :: Nat) = MakeR3 (LuhnT opts n)
 
 -- | Luhn check
 --
--- >>> prtEval3P (Proxy @(LuhnT 4)) oz "1230"
+-- >>> newRefined3P (Proxy @(LuhnT 'OZ 4)) "1230"
 -- Right (Refined3 {r3In = [1,2,3,0], r3Out = "1230"})
 --
--- >>> prtEval3P (Proxy @(LuhnT 4)) ol "1234"
--- Left Step 2. False Boolean Check(op) | {True && False | (Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])}
+-- >>> newRefined3P (Proxy @(LuhnT 'OL 4)) "1234"
+-- 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 Id) (Ones Id)
-   , Msg "incorrect number of digits:"
-         (Len == n) && Luhn Id
-   , ConcatMap (ShowP Id) Id
-   , String)
+type LuhnT (opts :: OptT) (n :: Nat) =
+   '( opts
+    , Map (ReadP Int Id) (Ones Id)
+    , Msg "incorrect number of digits:"
+          (Len == n) && Luhn Id
+    , ConcatMap (ShowP Id) Id
+    , String)
 
 -- | noop true
-type Ok (t :: Type) = '(Id, 'True, Id, t)
-type OkR (t :: Type) = MakeR3 (Ok t)
+type Ok (opts :: OptT) (t :: Type) = '(opts, Id, 'True, Id, t)
+type OkR (opts :: OptT) (t :: Type) = MakeR3 (Ok opts t)
 
-ok :: Proxy (Ok t)
+ok :: Proxy (Ok opts t)
 ok = mkProxy3
 
 -- | noop false
-type OkNot (t :: Type) = '(Id, 'False, Id, t)
+type OkNot (t :: Type) = '( 'OA, Id, 'False, Id, t)
 type OkNotR (t :: Type) = MakeR3 (OkNot t)
 
 oknot :: Proxy (OkNot t)
@@ -364,63 +357,84 @@ 
 -- | convert a string from a given base \'i\' and store it internally as a base \'j\' string
 --
--- >>> prtEval3P (Proxy @(BaseIJ 16 2)) oz "fe"
+-- >>> newRefined3P (Proxy @(BaseIJ 'OZ 16 2)) "fe"
 -- Right (Refined3 {r3In = "11111110", r3Out = "fe"})
 --
--- >>> prtEval3P (Proxy @(BaseIJ 16 2)) oz "fge"
--- Left Step 1. Initial Conversion(ip) Failed | invalid base 16
+-- >>> newRefined3P (Proxy @(BaseIJ 'OZ 16 2)) "fge"
+-- Left "Step 1. Initial Conversion(ip) Failed | invalid base 16"
 --
--- >>> prtEval3P (Proxy @(BaseIJ' 16 2 (ReadBase Int 2 Id < 1000))) ol "ffe"
--- Left Step 2. False Boolean Check(op) | {4094 < 1000}
+-- >>> newRefined3P (Proxy @(BaseIJ' 'OL 16 2 (ReadBase Int 2 Id < 1000))) "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 Id >> ShowBase j Id, p, ReadBase Int j Id >> ShowBase i Id, String)
+type BaseIJ (opts :: OptT) (i :: Nat) (j :: Nat) = BaseIJ' opts i j 'True
+type BaseIJ' (opts :: OptT) (i :: Nat) (j :: Nat) p = '(opts, 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) oz "13 % 3"
+-- >>> newRefined3P (readshow @'OZ @Rational) "13 % 3"
 -- Right (Refined3 {r3In = 13 % 3, r3Out = "13 % 3"})
 --
--- >>> prtEval3P (readshow @Rational) oz "13x % 3"
--- Left Step 1. Initial Conversion(ip) Failed | ReadP Ratio Integer (13x % 3)
+-- >>> newRefined3P (readshow @'OZ @Rational) "13x % 3"
+-- Left "Step 1. Initial Conversion(ip) Failed | ReadP Ratio Integer (13x % 3)"
 --
--- >>> prtEval3P (readshow' @Rational @(3 % 1 <..> 5 % 1)) oz "13 % 3"
+-- >>> newRefined3P (readshow' @'OZ @Rational @(3 % 1 <..> 5 % 1)) "13 % 3"
 -- Right (Refined3 {r3In = 13 % 3, r3Out = "13 % 3"})
 --
--- >>> prtEval3P (Proxy @(ReadShow' Rational (11 -% 2 <..> 3 -% 1))) oz "-13 % 3"
+-- >>> newRefined3P (Proxy @(ReadShow' 'OZ Rational (11 -% 2 <..> 3 -% 1))) "-13 % 3"
 -- Right (Refined3 {r3In = (-13) % 3, r3Out = "(-13) % 3"})
 --
--- >>> prtEval3P (Proxy @(ReadShow' Rational (Id > (15 % 1)))) oz "13 % 3"
--- Left Step 2. False Boolean Check(op) | FalseP
+-- >>> newRefined3P (Proxy @(ReadShow' 'OZ Rational (Id > (15 % 1)))) "13 % 3"
+-- Left "Step 2. False Boolean Check(op) | FalseP"
 --
--- >>> 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}
+-- >>> newRefined3P (Proxy @(ReadShow' 'OL Rational (Msg (PrintF "invalid=%3.2f" (FromRational Double Id)) (Id > (15 % 1))))) "13 % 3"
+-- Left "Step 2. False Boolean Check(op) | {invalid=4.3313 % 3 > 15 % 1}"
 --
--- >>> prtEval3P (Proxy @(ReadShow' Rational (Id > (11 % 1)))) oz "13 % 3"
--- Left Step 2. False Boolean Check(op) | FalseP
+-- >>> newRefined3P (Proxy @(ReadShow' 'OZ Rational (Id > (11 % 1)))) "13 % 3"
+-- Left "Step 2. False Boolean Check(op) | FalseP"
 --
 -- >>> let tmString = "2018-10-19 14:53:11.5121359 UTC"
 -- >>> let tm = read tmString :: UTCTime
--- >>> prtEval3P (readshow @UTCTime) oz tmString
+-- >>> newRefined3P (readshow @'OZ @UTCTime) 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) oz "String \"jsonstring\""
+-- >>> newRefined3P (readshow @'OZ @Value) "String \"jsonstring\""
 -- Right (Refined3 {r3In = String "jsonstring", r3Out = "String \"jsonstring\""})
 --
--- >>> prtEval3P (readshow @Value) oz "Number 123.4"
+-- >>> newRefined3P (readshow @'OZ @Value) "Number 123.4"
 -- Right (Refined3 {r3In = Number 123.4, r3Out = "Number 123.4"})
 --
-type ReadShow (t :: Type) = '(ReadP t Id, 'True, ShowP Id, String)
-type ReadShowR (t :: Type) = MakeR3 (ReadShow t)
+type ReadShow (opts :: OptT) (t :: Type) = '( opts, ReadP t Id, 'True, ShowP Id, String)
+type ReadShowR (opts :: OptT) (t :: Type) = MakeR3 (ReadShow opts t)
 
-type ReadShow' (t :: Type) p = '(ReadP t Id, p, ShowP Id, String)
-type ReadShowR' (t :: Type) p = MakeR3 (ReadShow' t p)
+type ReadShow' (opts :: OptT) (t :: Type) p = '( opts, ReadP t Id, p, ShowP Id, String)
+type ReadShowR' (opts :: OptT) (t :: Type) p = MakeR3 (ReadShow' opts t p)
 
-readshow :: Proxy (ReadShow t)
+readshow :: Proxy (ReadShow opts t)
 readshow = mkProxy3
 
-readshow' :: Proxy (ReadShow' t p)
+readshow' :: Proxy (ReadShow' opts t p)
 readshow' = mkProxy3
 
+-- | test tuple type families
+--
+-- >>> pl @(T5_2 (Ip4 'OL)) "1.2.3.4"
+-- Present [1,2,3,4] (Map [1,2,3,4] | ["1","2","3","4"])
+-- PresentT [1,2,3,4]
+--
+--
+-- >>> pl @(T5_3 (Ip4 'OL)) [141,213,308,4]
+-- Error octet 2 out of range 0-255 found 308 ((>>) lhs failed)
+-- FailT "octet 2 out of range 0-255 found 308"
+--
+--
+-- >>> pl @(T5_3 (Ip4 'OL)) [141,213,308,4,8]
+-- Error Guards:invalid length(5) expected 4 ((>>) lhs failed)
+-- FailT "Guards:invalid length(5) expected 4"
+--
+--
+-- >>> pl @(T5_4 (Ip4 'OL)) [141,513,9,4]
+-- Present "141.513.009.004" (PrintL(4) [141.513.009.004] | s=%03d.%03d.%03d.%03d)
+-- PresentT "141.513.009.004"
+--

@@ -1,10745 +1,10658 @@--- add Writer to MonadEval so we dont need to specify [hh pp ...]
--- the mkNode opts (FailT msg) [msg] .. -- repetitive: needs to add value
--- no types referring to types otherwise we lose use of _ as Type
-{-# OPTIONS -Wall #-}
-{-# OPTIONS -Wno-compat #-}
-{-# OPTIONS -Wincomplete-record-updates #-}
-{-# OPTIONS -Wincomplete-uni-patterns #-}
-{-# OPTIONS -Wredundant-constraints #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE NoOverloadedLists #-}
-{-# LANGUAGE NoStarIsType #-}
-{- |
-     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
-  , BetweenA
-  , type (<..>)
-  , All
-  , Any
-  , AllPositive
-  , Positive
-  , AllNegative
-  , Negative
-  , AndA
-  , type (&*)
-  , OrA
-  , type (|+)
-
-  -- ** regex expressions
-  , Re
-  , Re'
-  , Rescan
-  , Rescan'
-  , RescanRanges
-  , RescanRanges'
-  , Resplit
-  , Resplit'
-  , ReplaceAll
-  , ReplaceAll'
-  , ReplaceOne
-  , ReplaceOne'
-  , ReplaceAllString
-  , ReplaceAllString'
-  , ReplaceOneString
-  , ReplaceOneString'
-  , ReplaceFn
-  , ReplaceFn1
-  , ReplaceFn2
-  , ReplaceFn3
-
-  -- ** tuple expressions
-  , Fst
-  , Snd
-  , Thd
-  , L1
-  , L2
-  , L3
-  , L4
-  , L5
-  , L6
-  , Dup
-  , Swap
-  , SwapC(..)
-  , Assoc
-  , Unassoc
-  , Pairs
-
- -- ** character expressions
-  , IsLower
-  , IsUpper
-  , IsDigit
-  , IsSpace
-  , IsPunctuation
-  , IsControl
-  , IsHexDigit
-  , IsOctDigit
-  , IsSeparator
-  , IsLatin1
-
-  , IsLowerAll
-  , IsUpperAll
-  , IsDigitAll
-  , IsSpaceAll
-  , IsPunctuationAll
-  , IsControlAll
-  , IsHexDigitAll
-  , IsOctDigitAll
-  , IsSeparatorAll
-  , IsLatin1All
-
-  -- ** 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 (-%)
-  , ToRational
-  , FromRational
-  , FromRational'
-
- -- ** proxy expressions
-  , MkProxy
-  , ProxyT
-  , ProxyT'
-  , Unproxy
-
- -- ** read / show expressions
-  , ShowP
-  , ReadP
-  , ReadP'
-  , ReadQ
-  , ReadQ'
-  , ReadMaybe
-  , ReadMaybe'
-  , ReadBase
-  , ReadBase'
-  , ShowBase
-
-  -- ** aeson expressions
-  , ParseJson'
-  , ParseJson
-  , EncodeJson
-  , EncodeJsonFile
-  , ParseJsonFile'
-  , ParseJsonFile
-
-  -- ** 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
-  , type (==!)
-  , OrdP
-  , 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
-  , ChunksOf
-  , Rotate
-  , Take
-  , Drop
-  , Min
-  , Max
-  , Sum
-  , Product
-  , IsEmpty
-  , Null
-  , 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
-  , EitherIn
-
-  -- ** semigroup / monoid expressions
-  , type (<>)
-  , MConcat
-  , STimes
-  , SapA
-  , SapA'
-  , MEmptyT
-  , MEmptyT'
-  , MEmptyP
-  , MEmpty2
-  , MEmpty2'
-
-  -- ** indexing expressions
-  , Ix
-  , Ix'
-  , IxL
-  , type (!!)
-  , type (!!?)
-  , Lookup
-  , LookupDef
-  , LookupDef'
-  , LookupFail
-  , LookupFail'
-
- -- cons / uncons expressions
-  , type (:+)
-  , 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
-  , ReadIO
-  , ReadIO'
-
-  -- ** string expressions
-  , ToLower
-  , ToUpper
-  , TrimBoth
-  , TrimL
-  , TrimR
-  , StripR
-  , StripL
-  , IsPrefix
-  , IsInfix
-  , IsSuffix
-  , IsPrefixI
-  , IsInfixI
-  , IsSuffixI
-  , ToString
-  , FromString
-  , FromString'
-
-  -- ** 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
-  , Dot
-  , RDot
-  , type (>>)
-  , type (<<)
-  , type (>>>)
-  , DoN
-  , type ($$)
-  , type ($&)
-  , K
-  , Hide
-  , Hole
-  , Skip
-  , type (|>)
-  , type (>|)
-  , type (>|>)
-  , Uncurry
-
-  -- *** parallel expressions
-  , Para
-  , ParaN
-  , Repeat
-
-  -- ** miscellaneous
-  , Both
-  , Prime
-  , Luhn
-  , Char1
- ) 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(..))
-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
-import qualified Data.Aeson as A
-import qualified Data.ByteString.Char8 as BS8
-import qualified Data.ByteString.Lazy.Char8 as BL8
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-
--- $setup
--- >>> :set -XDataKinds
--- >>> :set -XTypeApplications
--- >>> :set -XTypeOperators
--- >>> :set -XOverloadedStrings
--- >>> :set -XNoOverloadedLists
--- >>> import qualified Data.Map.Strict as M
--- >>> import qualified Data.Text as T
--- >>> import Safe (readNote)
-
--- | 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
-data Asc
-type AscT = All (Fst Id <= Snd Id) Pairs
-
-instance P AscT x => P Asc x where
-  type PP Asc x = PP AscT x
-  eval _ = evalBool (Proxy @AscT)
-
--- | a type level predicate for a strictly increasing list
-data Asc'
-type AscT' = All (Fst Id < Snd Id) Pairs
-
-instance P AscT' x => P Asc' x where
-  type PP Asc' x = PP AscT' x
-  eval _ = evalBool (Proxy @AscT')
-
--- | a type level predicate for a monotonic decreasing list
-data Desc
-type DescT = All (Fst Id >= Snd Id) Pairs
-
-instance P DescT x => P Desc x where
-  type PP Desc x = PP DescT x
-  eval _ = evalBool (Proxy @DescT)
--- | a type level predicate for a strictly decreasing list
-data Desc'
-type DescT' = All (Fst Id > Snd Id) Pairs
-
-instance P DescT' x => P Desc' x where
-  type PP Desc' x = PP DescT' x
-  eval _ = evalBool (Proxy @DescT')
-
-
---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 @(5 <..> 8) 6
--- True
--- TrueT
---
--- >>> pl @(Between 5 8 Id) 9
--- False (9 <= 8)
--- 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!
-
-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
-
-
-data p <..> q
-infix 4 <..>
-
-type BetweenT p q = Between p q Id
-
-instance P (BetweenT p q) x => P (p <..> q) x where
-  type PP (p <..> q) x = PP (BetweenT p q) x
-  eval _ = evalBool (Proxy @(BetweenT p q))
-
--- | between for tuples
---
--- >>> pl @(BetweenA (Fst Id) (Snd Id)) ((1,4),8)
--- False (8 <= 4)
--- FalseT
---
--- >>> pl @(BetweenA (Fst Id) (Snd Id)) ((1,4),0)
--- False (1 <= 0)
--- FalseT
---
--- >>> pl @(BetweenA (Fst Id) (Snd Id)) ((1,4),3)
--- True (1 <= 3 <= 4)
--- TrueT
---
--- >>> pl @(BetweenA (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2018-10-12"
--- True (2017-04-11 <= 2018-10-12 <= 2018-12-30)
--- TrueT
---
--- >>> pl @(BetweenA (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2019-10-12"
--- False (2019-10-12 <= 2018-12-30)
--- FalseT
---
--- >>> pl @(BetweenA (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2016-10-12"
--- False (2017-04-11 <= 2016-10-12)
--- FalseT
---
-
-{- too much data mitigated somewhat by Hide
-type BetweenAT p q = '(p,q) >> Between (Fst (Fst Id)) (Snd (Fst Id)) (Snd Id)
-
-instance P (BetweenAT p q) x => P (BetweenA p q) x where
-  type PP (BetweenA p q) x = PP (BetweenAT p q) x
-  eval _ = evalBool (Proxy @(BetweenAT p q))
--}
-data BetweenA p q
-
-instance (PP p x ~ (a,a')
-       , P q x
-       , PP q x ~ a
-       , Ord a
-       , a ~ a'
-       , Show a
-       , P p x
-       ) => P (BetweenA p q) x where
-  type PP (BetweenA p q) x = Bool
-  eval _ opts x = do
-    let msg0 = "BetweenA"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
-    pure $ case lr of
-      Left e -> e
-      Right ((p1,p2),q,pp,qq) ->
-        [hh pp, hh qq] & if p1 <= q && q <= p2 then mkNodeB opts True [show p1 <> " <= " <> show q <> " <= " <> show p2]
-        else if p1 > q then mkNodeB opts False [show p1 <> " <= " <> show q]
-        else mkNodeB opts False [show q <> " <= " <> show p2]
-
--- | similar to 'all'
---
--- >>> pl @(All (Between 1 8 Id) Id) [7,3,4,1,2,9,0,1]
--- False (All(8) i=5 (9 <= 8))
--- 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(5) i=0 (1 == 0)
--- |
--- +- 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 ->
-        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 abcs ->
-                   let hhs = hh qq : map (hh . fixit) ts
-                       msg1 = msg0 ++ "(" ++ show (length q) ++ ")"
-                   in case find (not . view _1) abcs of
-                        Nothing -> mkNodeB opts True [msg1] hhs
-                        Just (_,(i,_),tt) ->
-                          mkNodeB opts False [msg1 <> " i=" ++ showIndex i ++ " " <> topMessage tt] 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'
---
--- >>> pl @(Any Even Id) [1,5,11,5,3]
--- False (Any(5))
--- FalseT
---
--- >>> pl @(Any Even Id) [1,5,112,5,3]
--- True (Any(5) i=2 (0 == 0))
--- 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 ->
-        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 abcs ->
-                   let hhs = hh qq : map (hh . fixit) ts
-                       msg1 = msg0 ++ "(" ++ show (length q) ++ ")"
-                   in case find (view _1) abcs of
-                        Nothing -> mkNodeB opts False [msg1] hhs
-                        Just (_,(i,_),tt) ->
-                          mkNodeB opts True [msg1 <> " i=" ++ showIndex i ++ " " <> topMessage tt] 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
---
-data AllPositive
-type AllPositiveT = All Positive Id
-
-instance P AllPositiveT x => P AllPositive x where
-  type PP AllPositive x = PP AllPositiveT x
-  eval _ = evalBool (Proxy @AllPositiveT)
-
--- | a type level predicate for all negative elements in a list
-data AllNegative
-type AllNegativeT = All Negative Id
-
-instance P AllNegativeT x => P AllNegative x where
-  type PP AllNegative x = PP AllNegativeT x
-  eval _ = evalBool (Proxy @AllNegativeT)
-
-
-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")
---
-data Unzip
-type UnzipT = '(Map (Fst Id) Id, Map (Snd Id) Id)
-
-instance P UnzipT x => P Unzip x where
-  type PP Unzip x = PP UnzipT x
-  eval _ = eval (Proxy @UnzipT)
-
-
--- | '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])
---
-data Unzip3
-type Unzip3T = '(Map (Fst Id) Id, Map (Snd Id) Id, Map (Thd Id) Id)
-
-instance P Unzip3T x => P Unzip3 x where
-  type PP Unzip3 x = PP Unzip3T x
-  eval _ = eval (Proxy @Unzip3T)
-
-
--- | 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
-data 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
-
-type ReT p q = Re' '[] p q
-
-instance P (ReT p q) x => P (Re p q) x where
-  type PP (Re p q) x = PP (ReT p q) x
-  eval _ = evalBool (Proxy @(ReT p q))
-
--- 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
-
-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]
-
-data Rescan p q
-type RescanT p q = Rescan' '[] p q
-
-instance P (RescanT p q) x => P (Rescan p q) x where
-  type PP (Rescan p q) x = PP (RescanT p q) x
-  eval _ = eval (Proxy @(RescanT p q))
-
-
--- | 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
-
-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
-
-data RescanRanges p q
-type RescanRangesT p q = RescanRanges' '[] p q
-
-instance P (RescanRangesT p q) x => P (RescanRanges p q) x where
-  type PP (RescanRanges p q) x = PP (RescanRangesT p q) x
-  eval _ = eval (Proxy @(RescanRangesT p q))
-
--- | 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"]
---
--- >>> pl @(Resplit' '[ 'Caseless ] "aBc" Id) "123AbC456abc"
--- Present ["123","456",""] (Resplit (aBc) ["123","456",""] | 123AbC456abc)
--- PresentT ["123","456",""]
---
-data Resplit' (rs :: [ROpt]) 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
-
-data Resplit p q
-type ResplitT p q = Resplit' '[] p q
-
-instance P (ResplitT p q) x => P (Resplit p q) x where
-  type PP (Resplit p q) x = PP (ResplitT p q) x
-  eval _ = eval (Proxy @(ResplitT p q))
-
--- | limit the size of the lists
-_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
-
-instance (GetBool b
-        , GetROpts rs
-        , PP p x ~ String
-        , PP q x ~ RReplace
-        , 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
-                           RReplace s -> (if alle then RH.gsub else RH.sub) regex s r
-                           RReplace1 s -> (if alle then RH.gsub else RH.sub) regex s r
-                           RReplace2 s -> (if alle then RH.gsub else RH.sub) regex s r
-                           RReplace3 s -> (if alle then RH.gsub else RH.sub) regex s r
-               in mkNode opts (PresentT ret) [msg1 <> showLit0 opts " " r <> showLit1 opts " | " ret] (hhs <> [hh rr])
-
-data ReplaceAll' (rs :: [ROpt]) p q r
-type ReplaceAllT' (rs :: [ROpt]) p q r = ReplaceImpl 'True rs p q r
-
-instance P (ReplaceAllT' rs p q r) x => P (ReplaceAll' rs p q r) x where
-  type PP (ReplaceAll' rs p q r) x = PP (ReplaceAllT' rs p q r) x
-  eval _ = eval (Proxy @(ReplaceAllT' rs p q r))
-
-data ReplaceAll p q r
-type ReplaceAllT p q r = ReplaceAll' '[] p q r
-
-instance P (ReplaceAllT p q r) x => P (ReplaceAll p q r) x where
-  type PP (ReplaceAll p q r) x = PP (ReplaceAllT p q r) x
-  eval _ = eval (Proxy @(ReplaceAllT p q r))
-
-data ReplaceOne' (rs :: [ROpt]) p q r
-type ReplaceOneT' (rs :: [ROpt]) p q r = ReplaceImpl 'False rs p q r
-
-instance P (ReplaceOneT' rs p q r) x => P (ReplaceOne' rs p q r) x where
-  type PP (ReplaceOne' rs p q r) x = PP (ReplaceOneT' rs p q r) x
-  eval _ = eval (Proxy @(ReplaceOneT' rs p q r))
-
--- | replace first occurrence of string \'p\' with '\q'\ in \'r\'
---
--- >>> pl @(ReplaceOneString "abc" "def" Id) "123abc456abc"
--- Present "123def456abc" (ReplaceOne' [] (abc) 123abc456abc | 123def456abc)
--- PresentT "123def456abc"
---
-data ReplaceOne p q r
-type ReplaceOneT p q r = ReplaceOne' '[] p q r
-
-instance P (ReplaceOneT p q r) x => P (ReplaceOne p q r) x where
-  type PP (ReplaceOne p q r) x = PP (ReplaceOneT p q r) x
-  eval _ = eval (Proxy @(ReplaceOneT p q r))
-
--- | replace all occurrences of string \'p\' with '\q'\ in \'r\'
---
--- >>> pl @(ReplaceAllString "abc" "def" Id) "123abc456abc"
--- Present "123def456def" (ReplaceAll' [] (abc) 123abc456abc | 123def456def)
--- PresentT "123def456def"
---
--- >>> pl @(ReplaceAllString' '[] "abc" "def" Id) "123AbC456abc"
--- Present "123AbC456def" (ReplaceAll' [] (abc) 123AbC456abc | 123AbC456def)
--- PresentT "123AbC456def"
---
--- >>> pl @(ReplaceAllString' '[ 'Caseless ] "abc" "def" Id) "123AbC456abc"
--- Present "123def456def" (ReplaceAll (abc) 123AbC456abc | 123def456def)
--- PresentT "123def456def"
---
-data ReplaceAllString' (rs :: [ROpt]) p q r
-type ReplaceAllStringT' (rs :: [ROpt]) p q r = ReplaceAll' rs p (ReplaceFn q) r
-
-instance P (ReplaceAllStringT' rs p q r) x => P (ReplaceAllString' rs p q r) x where
-  type PP (ReplaceAllString' rs p q r) x = PP (ReplaceAllStringT' rs p q r) x
-  eval _ = eval (Proxy @(ReplaceAllStringT' rs p q r))
-
-data ReplaceAllString p q r
-type ReplaceAllStringT p q r = ReplaceAllString' '[] p q r
-
-instance P (ReplaceAllStringT p q r) x => P (ReplaceAllString p q r) x where
-  type PP (ReplaceAllString p q r) x = PP (ReplaceAllStringT p q r) x
-  eval _ = eval (Proxy @(ReplaceAllStringT p q r))
-
-data ReplaceOneString' (rs :: [ROpt]) p q r
-type ReplaceOneStringT' (rs :: [ROpt]) p q r = ReplaceOne' rs p (ReplaceFn q) r
-
-instance P (ReplaceOneStringT' rs p q r) x => P (ReplaceOneString' rs p q r) x where
-  type PP (ReplaceOneString' rs p q r) x = PP (ReplaceOneStringT' rs p q r) x
-  eval _ = eval (Proxy @(ReplaceOneStringT' rs p q r))
-
-data ReplaceOneString p q r
-type ReplaceOneStringT p q r = ReplaceOneString' '[] p q r
-
-instance P (ReplaceOneStringT p q r) x => P (ReplaceOneString p q r) x where
-  type PP (ReplaceOneString p q r) x = PP (ReplaceOneStringT p q r) x
-  eval _ = eval (Proxy @(ReplaceOneStringT p q r))
-
--- | Simple replacement string: see 'ReplaceAllString' and 'ReplaceOneString'
---
-data ReplaceFn p
-
-instance (PP p x ~ String
-        , P p x) => P (ReplaceFn p) x where
-  type PP (ReplaceFn p) x = RReplace
-  eval _ opts x = do
-    let msg0 = "ReplaceFn"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = RReplace 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 ReplaceFn1 p
-
-instance (PP p x ~ (String -> [String] -> String)
-        , P p x) => P (ReplaceFn1 p) x where
-  type PP (ReplaceFn1 p) x = RReplace
-  eval _ opts x = do
-    let msg0 = "ReplaceFn1 (String -> [String] -> String)"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right f -> mkNode opts (PresentT (RReplace1 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 "\\." (ReplaceFn2 (Fst Id)) (Snd Id)) (\x -> x <> ":" <> x, "141.201.1.22")
--- Present "141.:.201.:.1.:.22"
--- PresentT "141.:.201.:.1.:.22"
---
-data ReplaceFn2 p
-
-instance (PP p x ~ (String -> String)
-        , P p x) => P (ReplaceFn2 p) x where
-  type PP (ReplaceFn2 p) x = RReplace
-  eval _ opts x = do
-    let msg0 = "ReplaceFn2 (String -> String)"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right f -> mkNode opts (PresentT (RReplace2 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+)$" (ReplaceFn3 (Fst Id)) (Snd Id)) (\ys -> intercalate  " | " $ map (show . succ . readNote @Int "invalid int") ys, "141.201.1.22")
--- Present "142 | 202 | 2 | 23"
--- PresentT "142 | 202 | 2 | 23"
---
-data ReplaceFn3 p
-
-instance (PP p x ~ ([String] -> String)
-        , P p x) => P (ReplaceFn3 p) x where
-  type PP (ReplaceFn3 p) x = RReplace
-  eval _ opts x = do
-    let msg0 = "ReplaceFn3 ([String] -> String)"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right f -> mkNode opts (PresentT (RReplace3 f)) [msg0] [hh pp]
-
-
--- | a predicate for determining if a string 'Data.Text.IsText' belongs to the given character set
---
--- >>> pz @IsSpace '\t'
--- True
--- TrueT
---
--- >>> pz @IsSpace ' '
--- True
--- TrueT
---
--- >>> pz @IsSpace 'x'
--- False
--- FalseT
---
--- >>> pz @IsLower 'a'
--- True
--- TrueT
---
--- >>> pz @IsLower 'X'
--- False
--- FalseT
---
--- >>> pz @IsHexDigit 'A'
--- True
--- TrueT
---
--- >>> pz @IsHexDigit 'g'
--- False
--- FalseT
---
-data IsCharSet (cs :: CharSet)
-
-instance (x ~ Char, GetCharSet cs) => P (IsCharSet cs) x where
-  type PP (IsCharSet cs) x = Bool
-  eval _ opts c =
-    let msg0 = "Is" ++ drop 1 (show cs)
-        (cs,f) = getCharSet @cs
-        b = f c
-    in pure $ mkNodeB opts b [msg0 <> show1 opts " | " [c]] []
-
--- | predicate for determining if a character is lowercase
---
--- >>> pz @IsLower '1'
--- False
--- FalseT
---
--- >>> pz @IsLower 'a'
--- True
--- TrueT
---
--- >>> pz @(Map '(IsControl, IsLatin1, IsHexDigit, IsOctDigit, IsDigit, IsPunctuation, IsSeparator, IsSpace) Id) "abc134"
--- Present [(False,True,True,False,False,False,False,False),(False,True,True,False,False,False,False,False),(False,True,True,False,False,False,False,False),(False,True,True,True,True,False,False,False),(False,True,True,True,True,False,False,False),(False,True,True,True,True,False,False,False)]
--- PresentT [(False,True,True,False,False,False,False,False),(False,True,True,False,False,False,False,False),(False,True,True,False,False,False,False,False),(False,True,True,True,True,False,False,False),(False,True,True,True,True,False,False,False),(False,True,True,True,True,False,False,False)]
---
-data IsLower
-type IsLowerT = IsCharSet 'CLower
-
-instance P IsLowerT x => P IsLower x where
-  type PP IsLower x = PP IsLowerT x
-  eval _ = evalBool (Proxy @IsLowerT)
-
-data IsUpper
-type IsUpperT = IsCharSet 'CUpper
-
-instance P IsUpperT x => P IsUpper x where
-  type PP IsUpper x = PP IsUpperT x
-  eval _ = evalBool (Proxy @IsUpperT)
-
--- | predicate for determining if the character is a digit
---
--- >>> pz @IsDigit 'g'
--- False
--- FalseT
---
--- >>> pz @IsDigit '9'
--- True
--- TrueT
---
-data IsDigit
-type IsDigitT = IsCharSet 'CNumber
-instance P IsDigitT x => P IsDigit x where
-  type PP IsDigit x = Bool
-  eval _ = evalBool (Proxy @IsDigitT)
-
-data IsSpace
-type IsSpaceT = IsCharSet 'CSpace
-instance P IsSpaceT x => P IsSpace x where
-  type PP IsSpace x = Bool
-  eval _ = evalBool (Proxy @IsSpaceT)
-
-data IsPunctuation
-type IsPunctuationT = IsCharSet 'CPunctuation
-instance P IsPunctuationT x => P IsPunctuation x where
-  type PP IsPunctuation x = Bool
-  eval _ = evalBool (Proxy @IsPunctuationT)
-
-data IsControl
-type IsControlT = IsCharSet 'CControl
-instance P IsControlT x => P IsControl x where
-  type PP IsControl x = Bool
-  eval _ = evalBool (Proxy @IsControlT)
-
-data IsHexDigit
-type IsHexDigitT = IsCharSet 'CHexDigit
-instance P IsHexDigitT x => P IsHexDigit x where
-  type PP IsHexDigit x = Bool
-  eval _ = evalBool (Proxy @IsHexDigitT)
-
-data IsOctDigit
-type IsOctDigitT = IsCharSet 'COctDigit
-instance P IsOctDigitT x => P IsOctDigit x where
-  type PP IsOctDigit x = Bool
-  eval _ = evalBool (Proxy @IsOctDigitT)
-
-data IsSeparator
-type IsSeparatorT = IsCharSet 'CSeparator
-instance P IsSeparatorT x => P IsSeparator x where
-  type PP IsSeparator x = Bool
-  eval _ = evalBool (Proxy @IsSeparatorT)
-
-data IsLatin1
-type IsLatin1T = IsCharSet 'CLatin1
-instance P IsLatin1T x => P IsLatin1 x where
-  type PP IsLatin1 x = Bool
-  eval _ = evalBool (Proxy @IsLatin1T)
-
-
-
--- | a predicate for determining if a string 'Data.Text.IsText' belongs to the given character set
---
--- >>> pz @IsLowerAll "abc"
--- True
--- TrueT
---
--- >>> pz @IsLowerAll "abcX"
--- False
--- FalseT
---
--- >>> pz @IsLowerAll (T.pack "abcX")
--- False
--- FalseT
---
--- >>> pz @IsHexDigitAll "01efA"
--- True
--- TrueT
---
--- >>> pz @IsHexDigitAll "01egfA"
--- False
--- FalseT
---
--- | predicate for determining if a string is all lowercase
---
--- >>> pz @IsLowerAll "abcdef213"
--- False
--- FalseT
---
--- >>> pz @IsLowerAll "abcdef"
--- True
--- TrueT
---
--- >>> pz @IsLowerAll ""
--- True
--- TrueT
---
--- >>> pz @IsLowerAll "abcdefG"
--- False
--- FalseT
---
--- >>> pl @(Just Uncons >> IsUpper &* IsLowerAll) "AbcdE"
--- False ((>>) False | {True (&*) False | (IsLowerAll | "bcdE")})
--- FalseT
---
--- >>> pl @(Just Uncons >> IsUpper &* IsLowerAll) "Abcde"
--- True ((>>) True | {True (&*) True})
--- TrueT
---
--- >>> pl @(Just Uncons >> IsUpper &* IsLowerAll) "xbcde"
--- False ((>>) False | {False (&*) True | (IsUpper | "x")})
--- FalseT
---
--- >>> pl @(Just Uncons >> IsUpper &* IsLowerAll) "X"
--- True ((>>) True | {True (&*) True})
--- TrueT
---
--- >>> pz @( '(IsControlAll, IsLatin1All , IsHexDigitAll , IsOctDigitAll , IsDigitAll , IsPunctuationAll , IsSeparatorAll , IsSpaceAll ) ) "abc134"
--- Present (False,True,True,False,False,False,False,False)
--- PresentT (False,True,True,False,False,False,False,False)
---
--- >>> pl @(SplitAts [1,2,10] Id >> Para '[IsLowerAll, IsDigitAll, IsUpperAll ]) "abdefghi"
--- Present [True,False,False] ((>>) [True,False,False] | {Para(0) [True,False,False] | ["a","bd","efghi"]})
--- PresentT [True,False,False]
---
--- >>> pl @(SplitAts [1,2,10] Id >> BoolsQuick "" '[IsLowerAll, IsDigitAll, IsUpperAll ]) "a98efghi"
--- False ((>>) False | {Bool(2) [] (IsUpperAll | "efghi")})
--- FalseT
---
--- >>> pl @(SplitAts [1,2,10] Id >> BoolsQuick "" '[IsLowerAll, IsDigitAll, IsUpperAll || IsLowerAll ]) "a98efghi"
--- True ((>>) True | {Bools})
--- TrueT
---
--- >>> pl @(SplitAts [1,2,10] Id >> BoolsQuick "" '[IsLowerAll, IsDigitAll, IsUpperAll || IsLowerAll ]) "a98efgHi"
--- False ((>>) False | {Bool(2) [] (False || False | (IsUpperAll | "efgHi") || (IsLowerAll | "efgHi"))})
--- FalseT
---
-data IsCharSetAll (cs :: CharSet)
-
-instance (GetCharSet cs
-        , Show a
-        , TL.IsText a
-        ) => P (IsCharSetAll cs) a where
-  type PP (IsCharSetAll cs) a = Bool
-  eval _ opts as =
-    let b = allOf TL.text f as
-        msg0 = "Is" ++ drop 1 (show cs) ++ "All"
-        (cs,f) = getCharSet @cs
-    in pure $ mkNodeB opts b [msg0 <> show1 opts " | " as] []
-
-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 'CSpace where
-  getCharSet = (CSpace, isSpace)
-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)
-
-data IsLowerAll
-type IsLowerAllT = IsCharSetAll 'CLower
-
-instance P IsLowerAllT x => P IsLowerAll x where
-  type PP IsLowerAll x = PP IsLowerAllT x
-  eval _ = evalBool (Proxy @IsLowerAllT)
-
-data IsUpperAll
-type IsUpperAllT = IsCharSetAll 'CUpper
-
-instance P IsUpperAllT x => P IsUpperAll x where
-  type PP IsUpperAll x = PP IsUpperAllT x
-  eval _ = evalBool (Proxy @IsUpperAllT)
-
--- | predicate for determining if the string is all digits
---
--- >>> pz @IsDigitAll "213G"
--- False
--- FalseT
---
--- >>> pz @IsDigitAll "929"
--- True
--- TrueT
---
-data IsDigitAll
-type IsDigitAllT = IsCharSetAll 'CNumber
-instance P IsDigitAllT x => P IsDigitAll x where
-  type PP IsDigitAll x = Bool
-  eval _ = evalBool (Proxy @IsDigitAllT)
-
--- | predicate for determining if the string is all spaces
---
--- >>> pz @IsSpaceAll "213G"
--- False
--- FalseT
---
--- >>> pz @IsSpaceAll "    "
--- True
--- TrueT
---
--- >>> pz @IsSpaceAll ""
--- True
--- TrueT
---
-data IsSpaceAll
-type IsSpaceAllT = IsCharSetAll 'CSpace
-instance P IsSpaceAllT x => P IsSpaceAll x where
-  type PP IsSpaceAll x = Bool
-  eval _ = evalBool (Proxy @IsSpaceAllT)
-
-data IsPunctuationAll
-type IsPunctuationAllT = IsCharSetAll 'CPunctuation
-instance P IsPunctuationAllT x => P IsPunctuationAll x where
-  type PP IsPunctuationAll x = Bool
-  eval _ = evalBool (Proxy @IsPunctuationAllT)
-
-data IsControlAll
-type IsControlAllT = IsCharSetAll 'CControl
-instance P IsControlAllT x => P IsControlAll x where
-  type PP IsControlAll x = Bool
-  eval _ = evalBool (Proxy @IsControlAllT)
-
-data IsHexDigitAll
-type IsHexDigitAllT = IsCharSetAll 'CHexDigit
-instance P IsHexDigitAllT x => P IsHexDigitAll x where
-  type PP IsHexDigitAll x = Bool
-  eval _ = evalBool (Proxy @IsHexDigitAllT)
-
-data IsOctDigitAll
-type IsOctDigitAllT = IsCharSetAll 'COctDigit
-instance P IsOctDigitAllT x => P IsOctDigitAll x where
-  type PP IsOctDigitAll x = Bool
-  eval _ = evalBool (Proxy @IsOctDigitAllT)
-
-data IsSeparatorAll
-type IsSeparatorAllT = IsCharSetAll 'CSeparator
-instance P IsSeparatorAllT x => P IsSeparatorAll x where
-  type PP IsSeparatorAll x = Bool
-  eval _ = evalBool (Proxy @IsSeparatorAllT)
-
-data IsLatin1All
-type IsLatin1AllT = IsCharSetAll 'CLatin1
-instance P IsLatin1AllT x => P IsLatin1All x where
-  type PP IsLatin1All x = Bool
-  eval _ = evalBool (Proxy @IsLatin1AllT)
-
-
--- | 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 ([a] ~ x, Show a) => P Inits x where
-  type PP Inits x = [x]
-  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 ([a] ~ x, Show a) => P Tails x where
-  type PP Tails x = [x]
-  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 ->
-        case chkSize opts msg0 p [hh pp] of
-          Left e -> e
-          Right () ->
-            let d = map pure 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) (readNote @LocalTime "invalid localtime" "2019-05-24 05:19:59")
--- 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", readNote @Day "invalid day" "2019-05-24")
--- 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
-
-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
-
-data ParseTimeP (t :: Type) p q
-type ParseTimePT (t :: Type) p q = ParseTimeP' (Hole t) p q
-
-instance P (ParseTimePT t p q) x => P (ParseTimeP t p q) x where
-  type PP (ParseTimeP t p q) x = PP (ParseTimePT t p q) x
-  eval _ = eval (Proxy @(ParseTimePT t p q))
-
--- | 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
-
-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
-
-data ParseTimes (t :: Type) p q
-type ParseTimesT (t :: Type) p q = ParseTimes' (Hole t) p q
-
-instance P (ParseTimesT t p q) x => P (ParseTimes t p q) x where
-  type PP (ParseTimes t p q) x = PP (ParseTimesT t p q) x
-  eval _ = eval (Proxy @(ParseTimesT t p q))
-
--- | 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
-
-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])
-
-data MkDay
-type MkDayT = MkDay' (Fst Id) (Snd Id) (Thd Id)
-
-instance P MkDayT x => P MkDay x where
-  type PP MkDay x = PP MkDayT x
-  eval _ = eval (Proxy @MkDayT)
-
--- | uncreate a 'Day' returning year month and day
---
--- >>> pz @(UnMkDay Id) (readNote "invalid day" "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 @(Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30") (ReadP Day Id)) "2018-10-12"
--- True
--- TrueT
---
--- >>> pz @(Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30") (ReadP Day Id)) "2016-10-12"
--- False
--- FalseT
---
-data ReadP' 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 hhs = [hh pp]
-        in case reads @(PP t x) s of
-           [(b,"")] -> mkNode opts (PresentT b) [msg0 <> " " ++ show b] hhs
-           o -> mkNode opts (FailT (msg0 <> " (" ++ s ++ ")")) [msg0 <> " failed " <> show o <> " | s=" ++ s] hhs
-
-data ReadP (t :: Type) p
-type ReadPT (t :: Type) p = ReadP' (Hole t) p
-
-instance P (ReadPT t p) x => P (ReadP t p) x where
-  type PP (ReadP t p) x = PP (ReadPT t p) x
-  eval _ = eval (Proxy @(ReadPT t p))
-
-
--- [] (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
-
--- 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
-
-data ReadMaybe (t :: Type) p
-type ReadMaybeT (t :: Type) p = ReadMaybe' (Hole t) p
-
-instance P (ReadMaybeT t p) x => P (ReadMaybe t p) x where
-  type PP (ReadMaybe t p) x = PP (ReadMaybeT t p) x
-  eval _ = eval (Proxy @(ReadMaybeT t p))
-
--- | emulates ReadP
-data ReadQ' t p
-type ReadQT' t p = ReadMaybe' t p >> MaybeIn (Failp "read failed") (Guard "oops" (Snd Id >> Null) >> Fst Id)
-
-instance P (ReadQT' t p) x => P (ReadQ' t p) x where
-  type PP (ReadQ' t p) x = PP (ReadQT' t p) x
-  eval _ = eval (Proxy @(ReadQT' t p))
-
-data ReadQ (t :: Type) p
-type ReadQT (t :: Type) p = ReadQ' (Hole t) p
-
-instance P (ReadQT t p) x => P (ReadQ t p) x where
-  type PP (ReadQ t p) x = PP (ReadQT t p) x
-  eval _ = eval (Proxy @(ReadQT t p))
-
--- | 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 'product'
---
--- >>> pz @Product [10,4,5,12,3,4]
--- Present 28800
--- PresentT 28800
---
--- >>> pz @Product []
--- Present 1
--- PresentT 1
---
-data Product
-
-instance (Num a, Show a) => P Product [a] where
-  type PP Product [a] = a
-  eval _ opts as =
-    let msg0 = "Product"
-        v = product 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 SortByHelperT 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 @(SortByHelperT p))
-                         else eval (Proxy @(Hide (SortByHelperT 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 ->
-                              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 else will double up messages: already handled
-          Right xs -> mkNode opts (_tBool ret) [msg0 <> show0 opts " " xs] [hh qq, hh ret]
-
-data SortOn p q
-type SortOnT p q = SortBy (OrdA p) q
-
-instance P (SortOnT p q) x => P (SortOn p q) x where
-  type PP (SortOn p q) x = PP (SortOnT p q) x
-  eval _ = eval (Proxy @(SortOnT p q))
-
-data SortOnDesc p q
-type SortOnDescT p q = SortBy (Swap >> OrdA p) q
-
-instance P (SortOnDescT p q) x => P (SortOnDesc p q) x where
-  type PP (SortOnDesc p q) x = PP (SortOnDescT p q) x
-  eval _ = eval (Proxy @(SortOnDescT p q))
-
--- | 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
-
-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]
-
-data L1 p
-type L1T p = Fst p
-
-instance P (L1T p) x => P (L1 p) x where
-  type PP (L1 p) x = PP (L1T p) x
-  eval _ = eval (Proxy @(L1T p))
-
-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
-
-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]
-
-data L2 p
-type L2T p = Snd p
-
-instance P (L2T p) x => P (L2 p) x where
-  type PP (L2 p) x = PP (L2T p) x
-  eval _ = eval (Proxy @(L2T p))
-
-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
-
-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]
-
-data L3 p
-type L3T p = Thd p
-
-instance P (L3T p) x => P (L3 p) x where
-  type PP (L3 p) x = PP (L3T p) x
-  eval _ = eval (Proxy @(L3T p))
-
-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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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
---
--- >>> :set -XFlexibleContexts
--- >>> pz @(FromString (Identity _) Id) "abc"
--- Present Identity "abc"
--- PresentT (Identity "abc")
---
--- >>> pz @(FromString (Seq.Seq Char) Id) "abc"
--- Present fromList "abc"
--- PresentT (fromList "abc")
-data FromString' t s
-
-instance (P s a
-        , PP s a ~ String
-        , Show (PP t a)
-        , IsString (PP t a)
-        ) => P (FromString' t s) a where
-  type PP (FromString' t s) a = PP t a
-  eval _ opts a = do
-    let msg0 = "FromString"
-    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]
-
-data FromString (t :: Type) p
-type FromStringPT (t :: Type) p = FromString' (Hole t) p
-
-instance P (FromStringPT t p) x => P (FromString t p) x where
-  type PP (FromString t p) x = PP (FromStringPT t p) x
-  eval _ = eval (Proxy @(FromStringPT t p))
-
-
--- | '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
-
-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]
-
-data FromInteger (t :: Type) p
-type FromIntegerT (t :: Type) p = FromInteger' (Hole t) p
---type FromIntegerP n = FromInteger' Unproxy n
-
-instance P (FromIntegerT t p) x => P (FromInteger t p) x where
-  type PP (FromInteger t p) x = PP (FromIntegerT t p) x
-  eval _ = eval (Proxy @(FromIntegerT t p))
-
--- | '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
-
-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]
-
-data FromIntegral (t :: Type) p
-type FromIntegralT (t :: Type) p = FromIntegral' (Hole t) p
-
-instance P (FromIntegralT t p) x => P (FromIntegral t p) x where
-  type PP (FromIntegral t p) x = PP (FromIntegralT t p) x
-  eval _ = eval (Proxy @(FromIntegralT t p))
-
--- | '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
-
-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]
-
-data FromRational (t :: Type) p
-type FromRationalT (t :: Type) p = FromRational' (Hole t) p
-
-instance P (FromRationalT t p) x => P (FromRational t p) x where
-  type PP (FromRational t p) x = PP (FromRationalT t p) x
-  eval _ = eval (Proxy @(FromRationalT t p))
-
--- | '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
-
-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]
-
-data Truncate (t :: Type) p
-type TruncateT (t :: Type) p = Truncate' (Hole t) p
-
-instance P (TruncateT t p) x => P (Truncate t p) x where
-  type PP (Truncate t p) x = PP (TruncateT t p) x
-  eval _ = eval (Proxy @(TruncateT t p))
-
--- | '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
-
-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]
-
-data Ceiling (t :: Type) p
-type CeilingT (t :: Type) p = Ceiling' (Hole t) p
-
-instance P (CeilingT t p) x => P (Ceiling t p) x where
-  type PP (Ceiling t p) x = PP (CeilingT t p) x
-  eval _ = eval (Proxy @(CeilingT t p))
-
--- | '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
-
-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]
-
-data Floor (t :: Type) p
-type FloorT (t :: Type) p = Floor' (Hole t) p
-
-instance P (FloorT t p) x => P (Floor t p) x where
-  type PP (Floor t p) x = PP (FloorT t p) x
-  eval _ = eval (Proxy @(FloorT t p))
--- | 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] []
-
--- | 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))
-
-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)
-
--- | 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 PadImpl (left :: Bool) 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 (PadImpl left n p q) a where
-  type PP (PadImpl left n p q) a = PP q a
-  eval _ opts a = do
-    let msg0 = "Pad" <> (if lft then "L" else "R")
-        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])
-
-data PadL n p q
-type PadLT n p q = PadImpl 'True n p q
-
-instance P (PadLT n p q) x => P (PadL n p q) x where
-  type PP (PadL n p q) x = PP (PadLT n p q) x
-  eval _ = eval (Proxy @(PadLT n p q))
-
-data PadR n p q
-type PadRT n p q = PadImpl 'False n p q
-
-instance P (PadRT n p q) x => P (PadR n p q) x where
-  type PP (PadR n p q) x = PP (PadRT n p q) x
-  eval _ = eval (Proxy @(PadRT n p q))
-
--- | 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) = splitAtNeg (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")
---
--- >>> pz @(SplitAt (Negate 2) Id) "hello world"
--- Present ("hello wor","ld")
--- PresentT ("hello wor","ld")
---
-data 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
-            ret = splitAtNeg n p
-       in mkNode opts (PresentT ret) [show01' opts msg1 ret "n=" n <> show1 opts " | " p] [hh pp, hh qq]
-
-splitAtNeg :: Int -> [a] -> ([a], [a])
-splitAtNeg n as = splitAt (if n<0 then length as + n else n) as
-
-
-data Take n p
-type TakeT n p = Fst (SplitAt n p)
-
-instance P (TakeT n p) x => P (Take n p) x where
-  type PP (Take n p) x = PP (TakeT n p) x
-  eval _ = eval (Proxy @(TakeT n p))
-
-data Drop n p
-type DropT n p = Snd (SplitAt n p)
-
-instance P (DropT n p) x => P (Drop n p) x where
-  type PP (Drop n p) x = PP (DropT n p) x
-  eval _ = eval (Proxy @(DropT n p))
-
---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.&&&'
-data p &&& q
-infixr 3 &&&
-type WAmpT p q = W '(p, q)
-
-instance P (WAmpT p q) x => P (p &&& q) x where
-  type PP (p &&& q) x = PP (WAmpT p q) x
-  eval _ = eval (Proxy @(WAmpT p q))
-
--- | similar to 'Control.Arrow.***'
---
--- >>> pz @(Pred Id *** ShowP Id) (13, True)
--- Present (12,"True")
--- PresentT (12,"True")
---
--- >>> pl @(FlipT (***) Len (Id * 12)) (99,"cdef")
--- Present (1188,4) ((***) (1188,4) | (99,"cdef"))
--- PresentT (1188,4)
---
-data p *** q
-infixr 3 ***
-
-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]
-
-data First p
-type FirstT p = p *** I
-
-instance P (FirstT p) x => P (First p) x where
-  type PP (First p) x = PP (FirstT p) x
-  eval _ = eval (Proxy @(FirstT p))
-
-data Second q
-type SecondT q = I *** q
-
-instance P (SecondT q) x => P (Second q) x where
-  type PP (Second q) x = PP (SecondT q) x
-  eval _ = eval (Proxy @(SecondT q))
-
--- | 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
-
-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 to 'isLeft'
---
--- >>> pz @(IsLeft Id) (Right 123)
--- False
--- FalseT
---
--- >>> pz @(IsLeft Id) (Left 'a')
--- True
--- TrueT
---
-data IsLeft p
-
-instance (P p x, PP p x ~ Either a b) => P (IsLeft p) x where
-  type PP (IsLeft p) x = Bool
-  eval _ opts x = do
-    let msg0 = "IsLeft"
-    pp <- eval (Proxy @p) opts x
-    let hhs = [hh pp]
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right (Left _) -> mkNodeB opts True [msg0] hhs
-      Right (Right _) -> mkNodeB opts False [msg0] hhs
-
--- | similar to 'isRight'
---
--- >>> pz @(IsRight Id) (Right 123)
--- True
--- TrueT
---
--- >>> pz @(IsRight Id) (Left "aa")
--- False
--- FalseT
---
-
-data IsRight p
-
-instance (P p x, PP p x ~ Either a b) => P (IsRight p) x where
-  type PP (IsRight p) x = Bool
-  eval _ opts x = do
-    let msg0 = "IsRight"
-    pp <- eval (Proxy @p) opts x
-    let hhs = [hh pp]
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right (Left _) -> mkNodeB opts False [msg0] hhs
-      Right (Right _) -> mkNodeB opts True [msg0] hhs
-
-
--- | 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]
-
-data Dup
-type DupT = W '(Id, Id)
-
-instance Show x => P Dup x where
-  type PP Dup x = PP DupT x
-  eval _ = eval (Proxy @DupT)
-
-data BinOp = BMult | BSub | BAdd deriving (Show,Eq)
-
-data p + q
-infixl 6 +
-
-type AddT p q = Bin 'BAdd p q
-
-instance P (AddT p q) x => P (p + q) x where
-  type PP (p + q) x = PP (AddT p q) x
-  eval _ = eval (Proxy @(AddT p q))
-
-data p - q
-infixl 6 -
-
-type SubT p q = Bin 'BSub p q
-
-instance P (SubT p q) x => P (p - q) x where
-  type PP (p - q) x = PP (SubT p q) x
-  eval _ = eval (Proxy @(SubT p q))
-
-data p * q
-infixl 7 *
-
-type MultT p q = Bin 'BMult p q
-
-instance P (MultT p q) x => P (p * q) x where
-  type PP (p * q) x = PP (MultT p q) x
-  eval _ = eval (Proxy @(MultT p q))
-
-data p > q
-infix 4 >
-
-instance P (Cmp 'CGt p q) x => P (p > q) x where
-  type PP (p > q) x = Bool
-  eval _ = evalBool (Proxy @(Cmp 'CGt p q))
-
-data p >= q
-infix 4 >=
-
-instance P (Cmp 'CGe p q) x => P (p >= q) x where
-  type PP (p >= q) x = Bool
-  eval _ = evalBool (Proxy @(Cmp 'CGe p q))
-
-data p == q
-infix 4 ==
-
-instance P (Cmp 'CEq p q) x => P (p == q) x where
-  type PP (p == q) x = Bool
-  eval _ = evalBool (Proxy @(Cmp 'CEq p q))
-
-data p <= q
-infix 4 <=
-
-instance P (Cmp 'CLe p q) x => P (p <= q) x where
-  type PP (p <= q) x = Bool
-  eval _ = evalBool (Proxy @(Cmp 'CLe p q))
-
-data p < q
-infix 4 <
-
-instance P (Cmp 'CLt p q) x => P (p < q) x where
-  type PP (p < q) x = Bool
-  eval _ = evalBool (Proxy @(Cmp 'CLt p q))
-
-data p /= q
-infix 4 /=
-
-instance P (Cmp 'CNe p q) x => P (p /= q) x where
-  type PP (p /= q) x = Bool
-  eval _ = evalBool (Proxy @(Cmp 'CNe p q))
-
---type p + q = Bin 'BAdd p q
---type p - q = Bin 'BSub p q
---type p * q = Bin 'BMult p q
-
---type p > q = Cmp 'CGt p q
---type p >= q = Cmp 'CGe p q
---type p == q = Cmp 'CEq p q
---type p /= q = Cmp 'CNe p q
---type p <= q = Cmp 'CLe p q
---type p < q = Cmp 'CLt p q
-
-type Gt n = I > n
-type Ge n = I >= n
-type Same n = I == n
-type Le n = I <= n
-type Lt n = I < n
-type Ne n = I /= n
-
---type p >~ q = CmpI 'CGt p q
---type p >=~ q = CmpI 'CGe p q
---type p ==~ q = CmpI 'CEq p q
---type p <=~ q = CmpI 'CLe p q
---type p <~ q = CmpI 'CLt p q
---type p /=~ q = CmpI 'CNe p q
-
-data p >~ q
-infix 4 >~
-
-instance P (CmpI 'CGt p q) x => P (p >~ q) x where
-  type PP (p >~ q) x = Bool
-  eval _ = evalBool (Proxy @(CmpI 'CGt p q))
-
-data p >=~ q
-infix 4 >=~
-
-instance P (CmpI 'CGe p q) x => P (p >=~ q) x where
-  type PP (p >=~ q) x = Bool
-  eval _ = evalBool (Proxy @(CmpI 'CGe p q))
-
-data p ==~ q
-infix 4 ==~
-
-instance P (CmpI 'CEq p q) x => P (p ==~ q) x where
-  type PP (p ==~ q) x = Bool
-  eval _ = evalBool (Proxy @(CmpI 'CEq p q))
-
-data p <=~ q
-infix 4 <=~
-
-instance P (CmpI 'CLe p q) x => P (p <=~ q) x where
-  type PP (p <=~ q) x = Bool
-  eval _ = evalBool (Proxy @(CmpI 'CLe p q))
-
-data p <~ q
-infix 4 <~
-
-instance P (CmpI 'CLt p q) x => P (p <~ q) x where
-  type PP (p <~ q) x = Bool
-  eval _ = evalBool (Proxy @(CmpI 'CLt p q))
-
-data p /=~ q
-infix 4 /=~
-
-instance P (CmpI 'CNe p q) x => P (p /=~ q) x where
-  type PP (p /=~ q) x = Bool
-  eval _ = evalBool (Proxy @(CmpI 'CNe p q))
-
-
-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 (%) zero denominator
--- FailT "(%) 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 %
-
-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 = "(%)"
-    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]
-
-data p -% q -- = Negate (p % q)
-infixl 8 -%
-type NegateRatioT p q = Negate (p % q)
-
-instance P (NegateRatioT p q) x => P (p -% q) x where
-  type PP (p -% q) x = PP (NegateRatioT p q) x
-  eval _ = eval (Proxy @(NegateRatioT p q))
-
-
--- | 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
-
-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]
-
-data Wrap (t :: Type) p
-type WrapT (t :: Type) p = Wrap' (Hole t) p
-
-instance P (WrapT t p) x => P (Wrap t p) x where
-  type PP (Wrap t p) x = PP (WrapT t p) x
-  eval _ = eval (Proxy @(WrapT t p))
--- | 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 @(MEmpty2 (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 MEmpty2' t
-
-instance (Show (f a)
-        , Show (f (PP t (f a)))
-        , Functor f
-        , Monoid (PP t (f a))
-        ) => P (MEmpty2' t) (f a) where
-  type PP (MEmpty2' t) (f a) = f (PP t (f a))
-  eval _ opts fa =
-    let msg0 = "MEmpty2"
-        b = mempty <$> fa
-    in pure $ mkNode opts (PresentT b) [show01 opts msg0 b fa] []
-
-data MEmpty2 (t :: Type)
-type MEmpty2T (t :: Type) = MEmpty2' (Hole t)
-
-instance P (MEmpty2T t) x => P (MEmpty2 t) x where
-  type PP (MEmpty2 t) x = PP (MEmpty2T t) x
-  eval _ = eval (Proxy @(MEmpty2T t))
-
--- | 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)
-
-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 'SwapC'
---
--- >>> 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
-
-class Bifunctor p => SwapC p where -- (p :: Type -> Type -> Type) where
-  swapC :: p a b -> p b a
-instance SwapC Either where
-  swapC (Left a) = Right a
-  swapC (Right a) = Left a
-instance SwapC These where
-  swapC (This a) = That a
-  swapC (That b) = This b
-  swapC (These a b) = These b a
-instance SwapC (,) where
-  swapC (a,b) = (b,a)
-
-instance (Show (p a b)
-        , SwapC 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 = swapC pab
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d pab] []
-
--- | assoc using 'AssocC'
---
--- >>> 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
-
-class AssocC p where
-  assoc :: p (p a b) c -> p a (p b c)
-  unassoc :: p a (p b c) -> p (p a b) c
-instance AssocC Either where
-  assoc (Left (Left a)) = Left a
-  assoc (Left (Right b)) = Right (Left b)
-  assoc (Right b) = Right (Right b)
-  unassoc (Left a) = Left (Left a)
-  unassoc (Right (Left b)) = Left (Right b)
-  unassoc (Right (Right b)) = Right b
-instance AssocC These where
-  assoc (This (This a)) = This a
-  assoc (This (That b)) = That (This b)
-  assoc (That b) = That (That b)
-  assoc (These (This a) c) = These a (That c)
-  assoc (These (That b) c) = That (These b c)
-  assoc (These (These a b) c) = These a (These b c)
-  assoc (This (These a b)) = These a (This b)
-  unassoc (This a) = This (This a)
-  unassoc (That (This b)) = This (That b)
-  unassoc (That (That b)) = That b
-  unassoc (These a (That c)) = These (This a) c
-  unassoc (That (These b c)) = These (That b) c
-  unassoc (These a (These b c)) = These (These a b) c
-  unassoc (These a (This b)) = This (These a b)
-
--- copied from Data.These
-partitionThese :: [These a b] -> ([a], [b], [(a, b)])
-partitionThese [] = ([], [], [])
-partitionThese (t:ts) = case t of
-    This x    -> (x : xs,     ys,         xys)
-    That y    -> (    xs, y : ys,         xys)
-    These x y -> (    xs,     ys, (x,y) : xys)
-  where
-    ~(xs,ys,xys) = partitionThese ts
-
-instance AssocC (,) where
-  assoc ((a,b),c) = (a,(b,c))
-  unassoc (a,(b,c)) = ((a,b),c)
-
-instance (Show (p (p a b) c)
-        , Show (p a (p b c))
-        , AssocC 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 = assoc pabc
-    in pure $ mkNode opts (PresentT d) [show01 opts msg0 d pabc] []
-
--- | unassoc using 'AssocC'
---
--- >>> 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))
-        , AssocC 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 = 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
--- FailT "Succ bounded"
---
-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 ->
-        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]
-
-data SuccB p q
-
-data SuccB' q
-type SuccBT' q = SuccB (Failp "Succ bounded") q
-
-instance P (SuccBT' q) x => P (SuccB' q) x where
-  type PP (SuccB' q) x = PP (SuccBT' q) x
-  eval _ = eval (Proxy @(SuccBT' q))
-
--- | bounded 'pred' function
---
--- >>> pz @(PredB' Id) (13 :: Int)
--- Present 12
--- PresentT 12
---
--- >>> pz @(PredB' Id) LT
--- Error Pred bounded
--- FailT "Pred bounded"
---
-data PredB' q
-type PredBT' q = PredB (Failp "Pred bounded") 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 ->
-        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]
-
-data PredB p q
-
-instance P (PredBT' q) x => P (PredB' q) x where
-  type PP (PredB' q) x = PP (PredBT' q) x
-  eval _ = eval (Proxy @(PredBT' q))
-
-
--- | '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
-
-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]
-
-data ToEnum (t :: Type) p
-type ToEnumT (t :: Type) p = ToEnum' (Hole t) p
-
-instance P (ToEnumT t p) x => P (ToEnum t p) x where
-  type PP (ToEnum t p) x = PP (ToEnumT t p) x
-  eval _ = eval (Proxy @(ToEnumT t p))
--- | 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
--- FailT "ToEnum bounded"
---
-data ToEnumBDef' t def
-
-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] []
-
-data ToEnumBDef (t :: Type) def
-type ToEnumBDefT (t :: Type) def = ToEnumBDef' (Hole t) def
-
-instance P (ToEnumBDefT t def) x => P (ToEnumBDef t def) x where
-  type PP (ToEnumBDef t def) x = PP (ToEnumBDefT t def) x
-  eval _ = eval (Proxy @(ToEnumBDefT t def))
-
-data ToEnumBFail (t :: Type)
-type ToEnumBFailT (t :: Type) = ToEnumBDef' (Hole t) (Failp "ToEnum bounded")
-
-instance P (ToEnumBFailT t) x => P (ToEnumBFail t) x where
-  type PP (ToEnumBFail t) x = PP (ToEnumBFailT t) x
-  eval _ = eval (Proxy @(ToEnumBFailT t))
-
--- | 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
-
-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]
-
-data Keep p q
-type KeepT p q = KeepImpl 'True p q
-
-instance P (KeepT p q) x => P (Keep p q) x where
-  type PP (Keep p q) x = PP (KeepT p q) x
-  eval _ = eval (Proxy @(KeepT p q))
-
-data Remove p q
-type RemoveT p q = KeepImpl 'False p q
-
-instance P (RemoveT p q) x => P (Remove p q) x where
-  type PP (Remove p q) x = PP (RemoveT p q) x
-  eval _ = eval (Proxy @(RemoveT p q))
-
--- | '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'
---
--- >>> :set -XFlexibleContexts
--- >>> pz @(HeadDef (MEmptyT _) Id) ([] :: [SG.Sum Int])
--- Present Sum {getSum = 0}
--- PresentT (Sum {getSum = 0})
---
--- >>> pz @(HeadDef (MEmptyT String) '[ "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 ()
---
-data HeadDef p q
-type HeadDefT p q = JustDef p (q >> Uncons >> FMapFst)
-
-instance P (HeadDefT p q) x => P (HeadDef p q) x where
-  type PP (HeadDef p q) x = PP (HeadDefT p q) x
-  eval _ = eval (Proxy @(HeadDefT p q))
-
-
--- | 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"
---
-data HeadFail msg q
-type HeadFailT msg q = JustFail msg (q >> Uncons >> FMapFst)
-
-instance P (HeadFailT msg q) x => P (HeadFail msg q) x where
-  type PP (HeadFail msg q) x = PP (HeadFailT msg q) x
-  eval _ = eval (Proxy @(HeadFailT msg q))
-
-data TailDef p q
-type TailDefT p q = JustDef p (q >> Uncons >> FMapSnd)
-
-instance P (TailDefT p q) x => P (TailDef p q) x where
-  type PP (TailDef p q) x = PP (TailDefT p q) x
-  eval _ = eval (Proxy @(TailDefT p q))
-
-
-data TailFail msg q
-type TailFailT msg q = JustFail msg (q >> Uncons >> FMapSnd)
-
-instance P (TailFailT msg q) x => P (TailFail msg q) x where
-  type PP (TailFail msg q) x = PP (TailFailT msg q) x
-  eval _ = eval (Proxy @(TailFailT msg q))
-
-
-data LastDef p q
-type LastDefT p q = JustDef p (q >> Unsnoc >> FMapSnd)
-
-instance P (LastDefT p q) x => P (LastDef p q) x where
-  type PP (LastDef p q) x = PP (LastDefT p q) x
-  eval _ = eval (Proxy @(LastDefT p q))
-
-data LastFail msg q
-type LastFailT msg q = JustFail msg (q >> Unsnoc >> FMapSnd)
-
-instance P (LastFailT msg q) x => P (LastFail msg q) x where
-  type PP (LastFail msg q) x = PP (LastFailT msg q) x
-  eval _ = eval (Proxy @(LastFailT msg q))
-
-data InitDef p q
-type InitDefT p q = JustDef p (q >> Unsnoc >> FMapFst)
-
-instance P (InitDefT p q) x => P (InitDef p q) x where
-  type PP (InitDef p q) x = PP (InitDefT p q) x
-  eval _ = eval (Proxy @(InitDefT p q))
-
-data InitFail msg q
-type InitFailT msg q = JustFail msg (q >> Unsnoc >> FMapFst)
-
-instance P (InitFailT msg q) x => P (InitFail msg q) x where
-  type PP (InitFail msg q) x = PP (InitFailT msg q) x
-  eval _ = eval (Proxy @(InitFailT msg q))
-
-data LookupDef' v w p q
-type LookupDefT' v w p q = JustDef p (q >> Lookup v w)
-
-instance P (LookupDefT' v w p q) x => P (LookupDef' v w p q) x where
-  type PP (LookupDef' v w p q) x = PP (LookupDefT' v w p q) x
-  eval _ = eval (Proxy @(LookupDefT' v w p q))
-
-data LookupFail' msg v w q
-type LookupFailT' msg v w q = JustFail msg (q >> Lookup v w)
-
-instance P (LookupFailT' msg v w q) x => P (LookupFail' msg v w q) x where
-  type PP (LookupFail' msg v w q) x = PP (LookupFailT' msg v w q) x
-  eval _ = eval (Proxy @(LookupFailT' msg v w q))
-
-data LookupDef v w p
-type LookupDefT v w p = LookupDef' v w p I
-
-instance P (LookupDefT v w p) x => P (LookupDef v w p) x where
-  type PP (LookupDef v w p) x = PP (LookupDefT v w p) x
-  eval _ = eval (Proxy @(LookupDefT v w p))
-
-data LookupFail msg v w
-type LookupFailT msg v w = LookupFail' msg v w I
-
-instance P (LookupFailT msg v w) x => P (LookupFail msg v w) x where
-  type PP (LookupFail msg v w) x = PP (LookupFailT msg v w) x
-  eval _ = eval (Proxy @(LookupFailT msg v w))
-
---type Just'  p = JustFail  "expected Just" p
-data Left' p
-type LeftT' p = LeftFail "expected Left"  p
-
-instance P (LeftT' p) x => P (Left' p) x where
-  type PP (Left' p) x = PP (LeftT' p) x
-  eval _ = eval (Proxy @(LeftT' p))
-
-data Right' p
-type RightT' p = RightFail "expected Right" p
-
-instance P (RightT' p) x => P (Right' p) x where
-  type PP (Right' p) x = PP (RightT' p) x
-  eval _ = eval (Proxy @(RightT' p))
-
-data This'  p
-type ThisT'  p = ThisFail  "expected This"  p
-
-instance P (ThisT' p) x => P (This' p) x where
-  type PP (This' p) x = PP (ThisT' p) x
-  eval _ = eval (Proxy @(ThisT' p))
-
-data That'  p
-type ThatT'  p = ThatFail  "expected That"  p
-
-instance P (ThatT' p) x => P (That' p) x where
-  type PP (That' p) x = PP (ThatT' p) x
-  eval _ = eval (Proxy @(ThatT' p))
-
-data These' p
-type TheseT' p = TheseFail "expected These" p
-
-instance P (TheseT' p) x => P (These' p) x where
-  type PP (These' p) x = PP (TheseT' p) x
-  eval _ = eval (Proxy @(TheseT' 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
-
--- 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 'isJust'
---
--- >>> pz @(IsJust Id) Nothing
--- False
--- FalseT
---
--- >>> pz @(IsJust Id) (Just 'a')
--- True
--- TrueT
---
-data IsJust p
-
-instance (P p x, PP p x ~ Maybe a) => P (IsJust p) x where
-  type PP (IsJust p) x = Bool
-  eval _ opts x = do
-    let msg0 = "IsJust"
-    pp <- eval (Proxy @p) opts x
-    let hhs = [hh pp]
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right (Just _) -> mkNodeB opts True [msg0] hhs
-      Right Nothing -> mkNodeB opts False [msg0] hhs
-
--- | similar to 'isNothing'
---
--- >>> pz @(IsNothing Id) (Just 123)
--- False
--- FalseT
---
--- >>> pz @(IsNothing Id) Nothing
--- True
--- TrueT
---
-data IsNothing p
-
-instance (P p x, PP p x ~ Maybe a) => P (IsNothing p) x where
-  type PP (IsNothing p) x = Bool
-  eval _ opts x = do
-    let msg0 = "IsNothing"
-    pp <- eval (Proxy @p) opts x
-    let hhs = [hh pp]
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right (Just _) -> mkNodeB opts False [msg0] hhs
-      Right Nothing -> mkNodeB opts True [msg0] hhs
-
-data MapMaybe p q
-type MapMaybeT p q = ConcatMap (p >> MaybeIn MEmptyP '[Id]) q
-
-instance P (MapMaybeT p q) x => P (MapMaybe p q) x where
-  type PP (MapMaybe p q) x = PP (MapMaybeT p q) x
-  eval _ = eval (Proxy @(MapMaybeT p q))
-
--- | similar to 'Data.Either.catMaybes'
---
--- >>> pl @(CatMaybes Id) [Just 'a',Nothing,Just 'c',Just 'd',Nothing]
--- Present "acd" (Concat "acd" | ["a","","c","d",""])
--- PresentT "acd"
---
-data CatMaybes q
-type CatMaybesT q = MapMaybe Id q
-
-instance P (CatMaybesT q) x => P (CatMaybes q) x where
-  type PP (CatMaybes q) x = PP (CatMaybesT q) x
-  eval _ = eval (Proxy @(CatMaybesT q))
-
--- | 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
-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 MEmptyT (t :: Type)
-type MEmptyTT (t :: Type) = MEmptyT' (Hole t)
-
-instance P (MEmptyTT t) x => P (MEmptyT t) x where
-  type PP (MEmptyT t) x = PP (MEmptyTT t) x
-  eval _ = eval (Proxy @(MEmptyTT t))
-
-data MEmptyP
-type MEmptyPT = MEmptyT' Unproxy -- expects a proxy: so only some things work with this: eg MaybeIn
-
-instance P MEmptyPT x => P MEmptyP x where
-  type PP MEmptyP x = PP MEmptyPT x
-  eval _ = eval (Proxy @MEmptyPT)
-
--- | 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'
-
--- 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] []
-
-data MkNothing (t :: Type)
-type MkNothingT (t :: Type) = MkNothing' (Hole t)
-
-instance P (MkNothing t) x where
-  type PP (MkNothing t) x = PP (MkNothingT t) x
-  eval _ = eval (Proxy @(MkNothingT t))
-
--- | '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
-
-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 MkLeft (t :: Type) p
-type MkLeftT (t :: Type) p = MkLeft' (Hole t) p
-
-instance P (MkLeftT t p) x => P (MkLeft t p) x where
-  type PP (MkLeft t p) x = PP (MkLeftT t p) x
-  eval _ = eval (Proxy @(MkLeftT t p))
-
--- | 'Data.Either.Right' constructor
---
--- >>> pz @(MkRight _ Id) 44
--- Present Right 44
--- PresentT (Right 44)
---
-data MkRight' 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 MkRight (t :: Type) p
-type MkRightT (t :: Type) p = MkRight' (Hole t) p
-
-instance P (MkRightT t p) x => P (MkRight t p) x where
-  type PP (MkRight t p) x = PP (MkRightT t p) x
-  eval _ = eval (Proxy @(MkRightT t p))
-
--- | '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
-
-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 MkThis (t :: Type) p
-type MkThisT (t :: Type) p = MkThis' (Hole t) p
-
-instance P (MkThisT t p) x => P (MkThis t p) x where
-  type PP (MkThis t p) x = PP (MkThisT t p) x
-  eval _ = eval (Proxy @(MkThisT t p))
-
--- | 'Data.These.That' constructor
---
--- >>> pz @(MkThat _ Id) 44
--- Present That 44
--- PresentT (That 44)
---
-data MkThat' 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]
-
-data MkThat (t :: Type) p
-type MkThatT (t :: Type) p = MkThat' (Hole t) p
-
-instance P (MkThatT t p) x => P (MkThat t p) x where
-  type PP (MkThat t p) x = PP (MkThatT t p) x
-  eval _ = eval (Proxy @(MkThatT t p))
-
--- type MkThat t p = MkThis t p >> Swap
--- type MkThat' (t :: Type) = Pure (These t) Id -- t has to be a semigroup
-
--- | 'Data.These.These' constructor
---
--- >>> pz @(MkThese (Fst 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
-
-instance (PP p x ~ [a]
-        , P p x
-        , Show a
-        , Monoid a
-        ) => P (MConcat p) x where
-  type PP (MConcat p) x = ExtractAFromList (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 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
---
-data FoldMap (t :: Type) p
-type FoldMapT (t :: Type) p = Map (Wrap t Id) p >> Unwrap (MConcat Id)
-
-instance P (FoldMapT t p) x => P (FoldMap t p) x where
-  type PP (FoldMap t p) x = PP (FoldMapT t p) x
-  eval _ = eval (Proxy @(FoldMapT t p))
-
--- | 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
-
-instance P (ProxyT' t) x where
-  type PP (ProxyT' t) x = Proxy (PP t x)
-  eval _ opts _ =
-    pure $ mkNode opts (PresentT Proxy) ["ProxyT"] []
-
-data ProxyT (t :: Type)
-type ProxyTT (t :: Type) = ProxyT' (Hole t)
-
-instance P (ProxyT t) x where
-  type PP (ProxyT t) x = PP (ProxyTT t) x
-  eval _ = eval (Proxy @(ProxyTT 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
-
-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] []
-
-data Ix' (n :: Nat)
-type IxT' (n :: Nat) = Ix n (Failp "Ix index not found")
-
-instance P (IxT' n) x => P (Ix' n) x where
-  type PP (Ix' n) x = PP (IxT' n) x
-  eval _ = eval (Proxy @(IxT' n))
-
--- | similar to 'Data.List.!!' leveraging 'Ixed'
---
--- >>> pz @(IxL Id 2 "notfound") ["abc","D","eF","","G"]
--- Present "eF"
--- PresentT "eF"
---
--- >>> pz @(IxL Id 20 "notfound") ["abc","D","eF","","G"]
--- Present "notfound"
--- PresentT "notfound"
---
-data IxL p q def -- p is the big value and q is the index and def is the default
-
-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]
-
--- | similar to 'Data.List.!!' leveraging 'Ixed'
---
--- >>> 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"
---
--- >>> import qualified Data.Map.Strict as M
--- >>> pz @(Id !! "eF") (M.fromList (flip zip [0..] ["abc","D","eF","","G"]))
--- Present 2
--- PresentT 2
---
-data p !! q
-type BangBangT p q = IxL p q (Failp "(!!) index not found")
-
-instance P (BangBangT p q) a => P (p !! q) a where
-  type PP (p !! q) a = PP (BangBangT p q) a
-  eval _ = eval (Proxy @(BangBangT p q))
-
--- | '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
---
--- >>> pl @((Id !!? Char1 "d") > MkJust 99 || Length Id <= 3) (M.fromList $ zip "abcd" [1..])
--- False (False || False | (Just 4 > Just 99) || (4 <= 3))
--- FalseT
---
--- >>> pz @((Id !!? Char1 "d") > MkJust 2 || Length Id <= 3) (M.fromList $ zip "abcd" [1..])
--- True
--- TrueT
---
-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 p !!? q
-type BangBangQT p q = Lookup p q
-
-instance P (BangBangQT p q) a => P (p !!? q) a where
-  type PP (p !!? q) a = PP (BangBangQT p q) a
-  eval _ = eval (Proxy @(BangBangQT p q))
-
-
--- | '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]
-
-
--- | similar to (++)
---
--- >>> pz @(Fst Id ++ Snd Id) ([9,10,11],[1,2,3,4])
--- Present [9,10,11,1,2,3,4]
--- PresentT [9,10,11,1,2,3,4]
---
--- >>> pz @(Snd Id ++ Fst Id) ([],[5])
--- Present [5]
--- PresentT [5]
---
--- >>> pz @(Char1 "xyz" :+ W "ab" ++ W "cdefg") ()
--- Present "xabcdefg"
--- PresentT "xabcdefg"
---
--- >>> pz @([1,2,3] ++ EmptyList _) "somestuff"
--- Present [1,2,3]
--- PresentT [1,2,3]
---
-data p ++ q
-infixr 5 ++
-
-instance (P p x
-        , P q x
-        , Show (PP p x)
-        , PP p x ~ [a]
-        , PP q x ~ [a]
-        ) => 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 ++ q
-        in mkNode opts (PresentT b) [show01' opts msg0 b "p=" p <> show1 opts " | q=" q] [hh pp, hh qq]
-
-
-
--- 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] []
-
-data Null' p
-
-instance (Show (t a)
-        , Foldable t
-        , t a ~ PP p x
-        , P p x
-        ) => P (Null' p) x where
-  type PP (Null' p) x = Bool
-  eval _ opts x = do
-    let msg0 = "Null"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let b = null p
-        in mkNodeB opts b ["Null" <> show1 opts " | " p] [hh pp]
-
--- | similar to 'null' using 'Foldable'
---
--- >>> pz @Null [1,2,3,4]
--- False
--- FalseT
---
--- >>> pz @Null []
--- True
--- TrueT
---
--- >>> pz @Null Nothing
--- True
--- TrueT
---
-data Null
-type NullT = Null' Id
-instance P NullT a => P Null a where
-  type PP Null a = Bool
-  eval _ = evalBool (Proxy @NullT)
-
--- | 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]
-
--- | 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 () Int])
--- 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] []
-
-data Thiss
-type ThissT = Fst PartitionThese
-
-instance P ThissT x => P Thiss x where
-  type PP Thiss x = PP ThissT x
-  eval _ = eval (Proxy @ThissT)
-
-data Thats
-type ThatsT = Snd PartitionThese
-
-instance P ThatsT x => P Thats x where
-  type PP Thats x = PP ThatsT x
-  eval _ = eval (Proxy @ThatsT)
-
-data Theses
-type ThesesT = Thd PartitionThese
-
-instance P ThesesT x => P Theses x where
-  type PP Theses x = PP ThesesT x
-  eval _ = eval (Proxy @ThesesT)
-
--- 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'
---
--- >>> pz @(Dup >> ScanN 4 Id (Pred Id *** Succ Id)) 'g'
--- Present [('g','g'),('f','h'),('e','i'),('d','j'),('c','k')]
--- PresentT [('g','g'),('f','h'),('e','i'),('d','j'),('c','k')]
---
-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]
-
-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) ->
-        case chkSize opts msg0 r [hh rr] of
-          Left e -> pure e
-          Right () -> 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 -> errorInProgram $ "Scanl e=" ++ show (fromTT e)
-                 Right abcs ->
-                   let vals = map (view _1) abcs
-                       itts = map (view _2 &&& view _3) abcs
-                   in 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)
-
-data ScanN n p q
-type ScanNT n p q = Scanl (Fst Id >> q) p (EnumFromTo 1 n) -- n times using q then run p
-
-instance P (ScanNT n p q) x => P (ScanN n p q) x where
-  type PP (ScanN n p q) x = PP (ScanNT n p q) x
-  eval _ = eval (Proxy @(ScanNT n p q))
-
-data ScanNA q
-type ScanNAT q = ScanN (Fst Id) (Snd Id) q
-
-instance P (ScanNAT q) x => P (ScanNA q) x where
-  type PP (ScanNA q) x = PP (ScanNAT q) x
-  eval _ = eval (Proxy @(ScanNAT q))
-
-data FoldN n p q
-type FoldNT n p q = Last (ScanN n p q)
-
-instance P (FoldNT n p q) x => P (FoldN n p q) x where
-  type PP (FoldN n p q) x = PP (FoldNT n p q) x
-  eval _ = eval (Proxy @(FoldNT n p q))
-
-data FoldL p q r
-type FoldLT p q r = Last (Scanl p q r)
-
-instance P (FoldLT p q r) x => P (FoldL p q r) x where
-  type PP (FoldL p q r) x = PP (FoldLT p q r) x
-  eval _ = eval (Proxy @(FoldLT p q r))
-
--- | 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)
-
-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 -> errorInProgram $ "Unfoldr e=" ++ show (fromTT e)
-             Right abcs ->
-               let vals = map (view _1) abcs
-                   itts = map (view _2 &&& view _3) abcs
-               in 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)
-
-type family UnfoldT mbs where
-  UnfoldT (Maybe (b,s)) = b
-
-data IterateN n f
-type IterateNT n f = Unfoldr (MaybeBool (Fst Id > 0) '(Snd Id, Pred Id *** f)) '(n, Id)
-
-instance P (IterateNT n f) x => P (IterateN n f) x where
-  type PP (IterateN n f) x = PP (IterateNT n f) x
-  eval _ = eval (Proxy @(IterateNT n f))
-
-data IterateUntil p f
-type IterateUntilT p f = IterateWhile (Not p) f
-
-instance P (IterateUntilT p f) x => P (IterateUntil p f) x where
-  type PP (IterateUntil p f) x = PP (IterateUntilT p f) x
-  eval _ = eval (Proxy @(IterateUntilT p f))
-
-data IterateWhile p f
-type IterateWhileT p f = Unfoldr (MaybeBool p '(Id, f)) Id
-
-instance P (IterateWhileT p f) x => P (IterateWhile p f) x where
-  type PP (IterateWhile p f) x = PP (IterateWhileT p f) x
-  eval _ = eval (Proxy @(IterateWhileT p f))
-
-data IterateNWhile n p f
-type IterateNWhileT n p f = '(n, Id) >> IterateWhile (Fst Id > 0 && (Snd Id >> p)) (Pred Id *** f) >> Map (Snd Id) Id
-
-instance P (IterateNWhileT n p f) x => P (IterateNWhile n p f) x where
-  type PP (IterateNWhile n p f) x = PP (IterateNWhileT n p f) x
-  eval _ = eval (Proxy @(IterateNWhileT n p f))
-
-data IterateNUntil n p f
-type IterateNUntilT n p f = IterateNWhile n (Not p) f
-
-instance P (IterateNUntilT n p f) x => P (IterateNUntil n p f) x where
-  type PP (IterateNUntil n p f) x = PP (IterateNUntilT n p f) x
-  eval _ = eval (Proxy @(IterateNUntilT n p f))
-
--- | 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
-
-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 abcs ->
-               let vals = map (view _1) abcs
-               in mkNode opts (PresentT vals) [show01 opts msg0 vals q] (hh qq : map (hh . fixit) ts)
-
-data ConcatMap p q
-type ConcatMapT p q = Concat (Map p q)
-
-instance P (ConcatMapT p q) x => P (ConcatMap p q) x where
-  type PP (ConcatMap p q) x = PP (ConcatMapT p q) x
-  eval _ = eval (Proxy @(ConcatMapT p q))
-
--- | 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
-
-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 ->
-        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 abcs ->
-                 let itts = map (view _2 &&& view _3) abcs
-                     w0 = partition (view _1) abcs
-                     zz1 = (map (view (_2 . _2)) *** map (view (_2 . _2))) w0
-                 in mkNode opts (PresentT zz1) [show01' opts msg0 zz1 "s=" q] (hh qq : map (hh . fixit) itts)
-
-data Filter p q
-type FilterT p q = Fst (Partition p q)
-
-instance P (FilterT p q) x => P (Filter p q) x where
-  type PP (Filter p q) x = PP (FilterT p q) x
-  eval _ = eval (Proxy @(FilterT p q))
-
--- | 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
-
--- 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 ->
-        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 failure
-                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 (itoList 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 -> errorInProgram "Break"
-                     Left e -> e
-
-data Span p q
-type SpanT p q = Break (Not p) q
-
-instance P (SpanT p q) x => P (Span p q) x where
-  type PP (Span p q) x = PP (SpanT p q) x
-  eval _ = eval (Proxy @(SpanT p q))
-
--- | 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
-
-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 | isVerbose opts]
-
-data FailS p
-instance P (Fail I p) x => P (FailS p) x where
-  type PP (FailS p) x = PP (Fail I p) x
-  eval _ = eval (Proxy @(Fail I p))
-
-data Failt (t :: Type) p
-instance P (Fail (Hole t) p) x => P (Failt t p) x where
-  type PP (Failt t p) x = PP (Fail (Hole t) p) x
-  eval _ = eval (Proxy @(Fail (Hole t) p))
-
-data Failp p
-instance P (Fail Unproxy p) x => P (Failp p) x where
-  type PP (Failp p) x = PP (Fail Unproxy p) x
-  eval _ = eval (Proxy @(Fail Unproxy p))
-
-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 'ParseTimeP', 'ReadBase'
---
-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
-
-data Catch' p s
-type CatchT' 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 (CatchT' p s) x => P (Catch' p s) x where
-  type PP (Catch' p s) x = PP (CatchT' p s) x
-  eval _ = eval (Proxy @(CatchT' p 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)]
---
-data Even
-type EvenT = Mod I 2 == 0
-
-instance P EvenT x => P Even x where
-  type PP Even x = Bool
-  eval _ = evalBool (Proxy @EvenT)
-
-data Odd
-type OddT = Mod I 2 == 1
-
-instance P OddT x => P Odd x where
-  type PP Odd x = Bool
-  eval _ = evalBool (Proxy @OddT)
-
-
---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
-
-data Quot p q
-type QuotT p q = Fst (QuotRem p q)
-
-instance P (QuotT p q) x => P (Quot p q) x where
-  type PP (Quot p q) x = PP (QuotT p q) x
-  eval _ = eval (Proxy @(QuotT p q))
-
-data Rem p q
-type RemT p q = Snd (QuotRem p q)
-
-instance P (RemT p q) x => P (Rem p q) x where
-  type PP (Rem p q) x = PP (RemT p q) x
-  eval _ = eval (Proxy @(RemT 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
--- 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 1 3
--- FailT "1 3"
---
--- >>> pz @(GuardsQuick (PrintT "arg %d failed with value %d" Id) '[Gt 4, Ge 3, Same 4]) [17,3,5]
--- Error arg 2 failed with value 5
--- FailT "arg 2 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:invalid length(4) expected 3
--- FailT "Guards:invalid length(4) expected 3"
---
-data GuardsImpl (n :: Nat) (os :: [(k,k1)])
-
-data Guards (ps :: [(k,k1)])
-
-instance ([a] ~ x, GetLen ps, P (GuardsImpl (LenT ps) ps) x) => P (Guards ps) x where
-  type PP (Guards ps) x = PP (GuardsImpl (LenT ps) ps) x
-  eval _ opts as = do
-    let msg0 = "Guards"
-        n = getLen @ps
-    if n /= length as then
-       let msg1 = msg0 <> badLength as n
-       in pure $ mkNode opts (FailT msg1) [msg1] []
-    else eval (Proxy @(GuardsImpl (LenT ps) ps)) opts as
-
-badLength :: (Foldable t, Show n, Num n) => t a -> n -> String
-badLength as n = ":invalid length(" <> show (length as) <> ") expected " ++ show (n+0)
-
-instance ([a] ~ x, Show a)
-         => P (GuardsImpl n ('[] :: [(k,k1)])) x where
-  type PP (GuardsImpl n ('[] :: [(k,k1)])) x = x
-  eval _ opts as =
-    let msg0 = "Guards"
-    in if not (null as) then errorInProgram $ "GuardsImpl base case has extra data " ++ show as
-       else pure $ mkNode opts (PresentT as) [msg0 <> " no data"] []
-
-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
-        , [a] ~ x
-        ) => P (GuardsImpl n ('(prt,p) ': ps)) x where
-  type PP (GuardsImpl n ('(prt,p) ': ps)) x = x
-  eval _ opts as' = do
-     let cpos = n-pos-1
-         msgbase1 = "Guard(" <> show 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 (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 -> mkNode opts (FailT msgx) [msgbase1 <> " failed [" <> msgx <> "]" <> show0 opts " " a] (hh pp : [hh qq | isVerbose opts])
-                 Right True ->
-                   if pos == 0 then -- we are at the bottom of the tree
-                      pure $ mkNode opts (PresentT [a]) [msgbase2] [hh pp]
-                   else 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 -> (ss & tForest %~ \x -> fromTT pp : x) & tBool .~ PresentT (a:zs)
-         _ -> errorInProgram "GuardsImpl n+1 case has no data"
-
-data GuardsQuick (prt :: k) (ps :: [k1])
-type GuardsQuickT (prt :: k) (ps :: [k1]) = Guards (ToGuardsT prt ps)
-
-instance P (GuardsQuickT prt ps) x => P (GuardsQuick prt ps) x where
-  type PP (GuardsQuick prt ps) x = PP (GuardsQuickT prt ps) x
-  eval _ = eval (Proxy @(GuardsQuickT prt ps))
-
--- | boolean guard which checks a given a list of predicates against the list of values
---
--- prefer 'Bools' as 'BoolsQuick' doesnt give much added value: passes in the index and the value to prt but you already have the index in the message
---
--- pulls the top message from the tree if a predicate is false
---
--- >>> pl @(Bools '[ '(W "hh",Between 0 23 Id), '(W "mm",Between 0 59 Id), '(PrintT "<<<%d %d>>>" Id,Between 0 59 Id) ] ) [12,93,14]
--- False (Bool(1) [mm] (93 <= 59))
--- FalseT
---
--- >>> pl @(Bools '[ '(W "hh",Between 0 23 Id), '(W "mm",Between 0 59 Id), '(PrintT "<<<%d %d>>>" Id,Between 0 59 Id) ] ) [12,13,94]
--- False (Bool(2) [<<<2 94>>>] (94 <= 59))
--- FalseT
---
--- >>> pl @(Bools '[ '(W "hh",Between 0 23 Id), '(W "mm",Between 0 59 Id), '(PrintT "<<<%d %d>>>" Id,Between 0 59 Id) ] ) [12,13,14]
--- True (Bools)
--- TrueT
---
--- >>> pl @(BoolsQuick "abc" '[Between 0 23 Id, Between 0 59 Id, Between 0 59 Id]) [12,13,14]
--- True (Bools)
--- TrueT
---
--- >>> pl @(BoolsQuick (PrintT "id=%d val=%d" Id) '[Between 0 23 Id, Between 0 59 Id, Between 0 59 Id]) [12,13,14]
--- True (Bools)
--- TrueT
---
--- >>> pl @(BoolsQuick (PrintT "id=%d val=%d" Id) '[Between 0 23 Id, Between 0 59 Id, Between 0 59 Id]) [12,13,99]
--- False (Bool(2) [id=2 val=99] (99 <= 59))
--- FalseT
---
--- >>> pl @(Bools '[ '("hours",Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ] ) [12,13,14]
--- True (Bools)
--- TrueT
---
--- >>> pl @(Bools '[ '("hours",Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ] ) [12,60,14]
--- False (Bool(1) [minutes] (60 <= 59))
--- FalseT
---
--- >>> pl @(Bools '[ '("hours",Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ] ) [12,60,14,20]
--- False (Bools:invalid length(4) expected 3)
--- FalseT
---
-data Bools (ps :: [(k,k1)])
-
-instance ([a] ~ x
-        , GetLen ps
-        , P (BoolsImpl (LenT ps) ps) x
-        , PP (BoolsImpl (LenT ps) ps) x ~ Bool
-        ) => P (Bools ps) x where
-  type PP (Bools ps) x = Bool
-  eval _ opts as = do
-    let msg0 = "Bools"
-        msg1 = "Bool("++show n++")"
-        n = getLen @ps
-    case chkSize opts msg1 as [] of
-      Left e -> pure e
-      Right () ->
-        if n /= length as then
-           let msg2 = msg0 <> badLength as n
-           in pure $ mkNodeB opts False [msg2] [] -- was FailT but now just FalseT
-        else evalBool (Proxy @(BoolsImpl (LenT ps) ps)) opts as
-
-data BoolsImpl (n :: Nat) (os :: [(k,k1)])
-
-instance (KnownNat n
-        , Show a
-        , [a] ~ x
-        ) => P (BoolsImpl n ('[] :: [(k,k1)])) x where
-  type PP (BoolsImpl n ('[] :: [(k,k1)])) x = Bool
-  eval _ opts as =
-    let msg0 = "Bool(" <> show n <> ")"
-        n :: Int = nat @n
-    in if not (null as) then errorInProgram $ "BoolsImpl base case has extra data " ++ show as
-       else pure $ mkNodeB opts True [msg0 <> " empty"] []
-
-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) x
-        , PP (BoolsImpl n ps) [a] ~ Bool
---        , Show a
-        , [a] ~ x
-        ) => P (BoolsImpl n ('(prt,p) ': ps)) x where
-  type PP (BoolsImpl n ('(prt,p) ': ps)) x = Bool
-  eval _ opts as' = do
-     let cpos = n-pos-1
-         msgbase1 = "Bool(" <> 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 : [hh qq | isVerbose opts])
-                 Right True ->
-                   if pos == 0 then -- we are at the bottom of the tree
-                      pure $ mkNodeB opts True [msgbase2] [hh pp]
-                   else 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 _ ->  ss & tForest %~ \x -> fromTT pp : x
-         _ -> errorInProgram "BoolsImpl n+1 case has no data"
-
-data BoolsQuick (prt :: k) (ps :: [k1])
-type BoolsQuickT (prt :: k) (ps :: [k1]) = Bools (ToGuardsT prt ps)
-
--- why do we need this? when BoolsN works without [use the x ~ [a] trick in BoolsN]
-instance (PP (Bools (ToGuardsT prt ps)) x ~ Bool
-        , P (BoolsQuickT prt ps) x
-          ) => P (BoolsQuick prt ps) x where
-  type PP (BoolsQuick prt ps) x = PP (BoolsQuickT prt ps) x
-  eval _ = evalBool (Proxy @(BoolsQuickT prt ps))
-
--- | 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 Id)) [121,33,7,256]
--- False (Bool(3) [id=3 must be between 0 and 255, found 256] (256 <= 255))
--- FalseT
---
--- >>> pl @(BoolsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255 Id)) [121,33,7,44]
--- True (Bools)
--- TrueT
---
-data BoolsN prt (n :: Nat) (p :: k1)
-type BoolsNT prt (n :: Nat) (p :: k1) = Bools (ToGuardsT prt (RepeatT n p))
-
-instance (x ~ [a], P (BoolsNT prt n p) x) => P (BoolsN prt n p) x where
-  type PP (BoolsN prt n p) x = PP (BoolsNT prt n p) x
-  eval _ = evalBool (Proxy @(BoolsNT prt n p))
-
--- | 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 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)]) [13,59,61]
--- Error seconds invalid: found 61
--- FailT "seconds invalid: found 61"
---
--- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)]) [27,59,12]
--- Error hours invalid: found 27
--- FailT "hours invalid: found 27"
---
--- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)]) [23,59,12]
--- Present [23,59,12]
--- PresentT [23,59,12]
---
-data GuardsDetailImpl (ps :: [(k,k1)])
-
-instance ([a] ~ x
-        , GetLen ps
-        , P (GuardsImplX (LenT ps) ps) x
-        ) => P (GuardsDetailImpl ps) x where
-  type PP (GuardsDetailImpl ps) x = PP (GuardsImplX (LenT ps) ps) x
-  eval _ opts as = do
-    let msg0 = "Guards"
-        n = getLen @ps
-    if n /= length as then
-       let msg1 = msg0 <> badLength as n
-       in pure $ mkNode opts (FailT msg1) [msg1] []
-    else eval (Proxy @(GuardsImplX (LenT ps) ps)) opts as
-
-data GuardsImplX (n :: Nat) (os :: [(k,k1)])
-
-instance ([a] ~ x, Show a)
-        => P (GuardsImplX n ('[] :: [(k,k1)])) x where
-  type PP (GuardsImplX n ('[] :: [(k,k1)])) x = x
-  eval _ opts as =
-    let msg0 = "Guards"
-        -- n :: Int = nat @n
-    in if not (null as) then errorInProgram $ "GuardsImplX base case has extra data " ++ show as
-       else pure $ mkNode opts (PresentT as) [msg0] []
-
-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
-        , [a] ~ x
-        ) => P (GuardsImplX n ('(prt,p) ': ps)) x where
-  type PP (GuardsImplX n ('(prt,p) ': ps)) x = x
-  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 : [hh qq | isVerbose opts])
-                 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]
-         _ -> errorInProgram "GuardsImplX n+1 case has no data"
-
-data GuardsDetail prt (ps :: [(k0,k1)])
-type GuardsDetailT prt (ps :: [(k0,k1)]) = GuardsDetailImpl (ToGuardsDetailT prt ps)
-
-instance P (GuardsDetailT prt ps) x => P (GuardsDetail prt ps) x where
-  type PP (GuardsDetail prt ps) x = PP (GuardsDetailT prt ps) x
-  eval _ = eval (Proxy @(GuardsDetailT prt ps))
-
-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")
-
--- | 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 Id)) [121,33,7,256]
--- Error id=3 must be between 0 and 255, found 256
--- FailT "id=3 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 Id)) [121,33,7,44]
--- Present [121,33,7,44]
--- PresentT [121,33,7,44]
---
-data GuardsN prt (n :: Nat) p
-type GuardsNT prt (n :: Nat) p = Guards (ToGuardsT prt (RepeatT n p))
-
-instance (x ~ [a], P (GuardsNT prt n p) x) => P (GuardsN prt n p) x where
-  type PP (GuardsN prt n p) x = PP (GuardsNT prt n p) x
-  eval _ = eval (Proxy @(GuardsNT prt n p))
-
--- | \'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
-
-data ExitWhen prt p
-type ExitWhenT prt p = Guard prt (Not p)
-
-instance P (ExitWhenT prt p) x => P (ExitWhen prt p) x where
-  type PP (ExitWhen prt p) x = PP (ExitWhenT prt p) x
-  eval _ = eval (Proxy @(ExitWhenT prt 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 | isVerbose opts])
-      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
---
--- >>> 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 failure
-data Skip p
-
-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]
-
-data p |> q
-type SkipLT p q = Skip p >> q
-infixr 1 |>
-
-instance P (SkipLT p q) x => P (p |> q) x where
-  type PP (p |> q) x = PP (SkipLT p q) x
-  eval _ = eval (Proxy @(SkipLT p q))
-
-data p >| q
-type SkipRT p q = p >> Skip q
-infixr 1 >|
-
-instance P (SkipRT p q) x => P (p >| q) x where
-  type PP (p >| q) x = PP (SkipRT p q) x
-  eval _ = eval (Proxy @(SkipRT p q))
-
-data p >|> q
-type SkipBothT p q = Skip p >> Skip q
-infixr 1 >|>
-
-instance P (SkipBothT p q) x => P (p >|> q) x where
-  type PP (p >|> q) x = PP (SkipBothT p q) x
-  eval _ = eval (Proxy @(SkipBothT p q))
-
--- 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 >>
-
-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]
-
-data p << q
-type LeftArrowsT p q = q >> p
-infixr 1 <<
-
-instance P (LeftArrowsT p q) x => P (p << q) x where
-  type PP (p << q) x = PP (LeftArrowsT p q) x
-  eval _ = eval (Proxy @(LeftArrowsT p q))
-
-type p >>> q = p >> q
-infixl 1 >>>
-
--- | 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 <- runPQBool 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 <- runPQBool 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 <- runPQBool 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 <- evalBool (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]
-
--- | 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
---
-
-data p ==! q
-infix 4 ==!
-
-type OrdP p q = p ==! q
-
-instance (Ord (PP p a)
-        , PP p a ~ PP q a
-        , P p a
-        , Show (PP q a)
-        , P q a
-        ) => P (p ==! q) a where
-  type PP (p ==! q) a = Ordering
-  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 d = compare p q
-        in mkNode opts (PresentT d) [msg0 <> " " <> show p <> " " <> prettyOrd d <> show0 opts " " q] [hh pp, hh qq]
-
-data OrdA p
-
-instance P (OrdA' p p) x => P (OrdA p) x where
-  type PP (OrdA p) x = PP (OrdA' p p) x
-  eval _ = eval (Proxy @(OrdA' p p))
-
-data OrdA' p q
-type OrdAT' p q = (Fst Id >> p) ==! (Snd Id >> q)
-
-instance P (OrdAT' p q) x => P (OrdA' p q) x where
-  type PP (OrdA' p q) x = PP (OrdAT' p q) x
-  eval _ = eval (Proxy @(OrdAT' p q))
-
--- | 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
---
-type OrdI p q = p ===~ q
-data p ===~ q
-infix 4 ===~
-
-instance (PP p a ~ String
-        , PP p a ~ PP q a
-        , P p a
-        , P q a
-        ) => P (p ===~ q) a where
-  type PP (p ===~ q) a = Ordering
-  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 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\'
---
--- >>> pl @(Lt 4) 123
--- False (123 < 4)
--- FalseT
---
--- >>> pl @(Lt 4) 1
--- True (1 < 4)
--- TrueT
---
--- >>> pl @(Negate 7 <..> 20) (-4)
--- True (-7 <= -4 <= 20)
--- TrueT
---
--- >>> pl @(Negate 7 <..> 20) 21
--- False (21 <= 20)
--- FalseT
---
-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 _ Id) ("aBc" :: String)
--- Present [(0,'a'),(1,'B'),(2,'c')]
--- PresentT [(0,'a'),(1,'B'),(2,'c')]
---
-data IToList' t p
-
-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]
-
-data IToList (t :: Type) p
-type IToListT (t :: Type) p = IToList' (Hole t) p
-
-instance P (IToListT t p) x => P (IToList t p) x where
-  type PP (IToList t p) x = PP (IToListT t p) x
-  eval _ = eval (Proxy @(IToListT t p))
-
--- | 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
-        , [a] ~ x
-        ) => P (FromList t) x where
-  type PP (FromList t) x = 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
---
--- >>> pl @(IsThat Id) (This 12)
--- False (IsThat | This 12)
--- FalseT
---
--- >>> pl @(IsThis Id) (This 12)
--- True (IsThis | This 12)
--- TrueT
---
--- >>> pl @(IsThese Id) (This 12)
--- False (IsThese | This 12)
--- FalseT
---
--- >>> pl @(IsThese Id) (These 'x' 12)
--- True (IsThese | These 'x' 12)
--- TrueT
---
-data IsTh (th :: These x y) p -- x y can be anything
-
-
--- 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 = "Is"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let (t,f) = getThese @th
-            b = f p
-        in mkNodeB opts b [msg0 <> t <> show1 opts " | " p] []
-
-data IsThis p
-type IsThisT p = IsTh ('This '()) p
-
-instance P (IsThisT p) x => P (IsThis p) x where
-  type PP (IsThis p) x = PP (IsThisT p) x
-  eval _ = evalBool (Proxy @(IsThisT p))
-
-data IsThat p
-type IsThatT p = IsTh ('That '()) p
-
-instance P (IsThatT p) x => P (IsThat p) x where
-  type PP (IsThat p) x = PP (IsThatT p) x
-  eval _ = evalBool (Proxy @(IsThatT p))
-
-data IsThese p
-type IsTheseT p = IsTh ('These '() '()) p
-
-instance P (IsTheseT p) x => P (IsThese p) x where
-  type PP (IsThese p) x = PP (IsTheseT p) x
-  eval _ = evalBool (Proxy @(IsTheseT 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 (MkLeft _ Id) (MkRight _ 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 (MkLeft _ Id) (MkRight _ 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 (MkLeft _ Id) (MkRight _ 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
-
-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 th = do
-     let msg0 = "TheseIn"
-     case th of
-        This a -> do
-          let msg1 = "This "
-              msg2 = msg0 <> msg1
-          pp <- eval (Proxy @p) opts a
-          pure $ case getValueLR opts (msg2 <> "p failed") pp [] of
-               Left e -> e
-               Right c -> mkNode opts (PresentT c) [show01' opts msg0 c msg1 a] [hh pp]
-        That b -> do
-          let msg1 = "That "
-              msg2 = msg0 <> msg1
-          qq <- eval (Proxy @q) opts b
-          pure $ case getValueLR opts (msg2 <> "q failed") qq [] of
-               Left e -> e
-               Right c -> mkNode opts (PresentT c) [show01' opts msg0 c msg1 b] [hh qq]
-        These a b -> do
-          let msg1 = "These "
-              msg2 = msg0 <> msg1
-          rr <- eval (Proxy @r) opts (a,b)
-          pure $ case getValueLR opts (msg2 <> "r failed") rr [] of
-               Left e -> e
-               Right c -> mkNode opts (PresentT c) [show01 opts msg0 c (These a b)] [hh rr]
-
-data TheseId p q
-type TheseIdT p q = TheseIn '(I, p) '(q, I) I
-
-instance P (TheseIdT p q) x => P (TheseId p q) x where
-  type PP (TheseId p q) x = PP (TheseIdT p q) x
-  eval _ = eval (Proxy @(TheseIdT p q))
--- | creates an empty list of the given type
---
--- >>> pz @(Id :+ EmptyList _) 99
--- Present [99]
--- PresentT [99]
---
-data EmptyList' t
-
-instance P (EmptyList' t) x where
-  type PP (EmptyList' t) x = [PP t x]
-  eval _ opts _ =
-    pure $ mkNode opts (PresentT []) ["EmptyList"] []
-
-data EmptyList (t :: Type)
-type EmptyListT (t :: Type) = EmptyList' (Hole t)
-
-instance P (EmptyList t) x where
-  type PP (EmptyList t) x = PP (EmptyListT t) x
-  eval _ = eval (Proxy @(EmptyListT t))
-
--- | 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"]
---
-data Singleton p
-
-instance P p x => P (Singleton p) x where
-  type PP (Singleton p) x = [PP p x]
-  eval _ opts x = do
-    let msg0 = "Singleton"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p -> mkNode opts (PresentT [p]) [msg0] [hh pp]
-
---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, GL.CmpSymbol s "" ~ 'GT) => P (Char1 s) a where
-  type PP (Char1 s) a = Char
-  eval _ opts _ =
-     case symb @s of
-       [] -> errorInProgram "Char1: found empty Symbol/string"
-       c:_ -> 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']
---
--- >>> pz @(ZipThese '[] '[]) "aBcDeF"
--- Present []
--- PresentT []
---
-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 hhs = [hh pp, hh qq]
-        in case chkSize opts msg0 p hhs <* chkSize opts msg0 q hhs of
-          Left e -> e
-          Right () ->
-            let d = simpleAlign p q
-            in mkNode opts (PresentT d) [show01' opts msg0 d "p=" p <> show1 opts " | q=" q] hhs
-
-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 failure 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
-
-instance (Typeable (PP t x)
-        , ZwischenT 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]
-
-data ReadBase (t :: Type) (n :: Nat) p
-type ReadBaseT (t :: Type) (n :: Nat) p = ReadBase' (Hole t) n p
-
-instance P (ReadBaseT t n p) x => P (ReadBase t n p) x where
-  type PP (ReadBase t n p) x = PP (ReadBaseT t n p) x
-  eval _ = eval (Proxy @(ReadBaseT t n p))
-
-getValidBase :: Int -> String
-getValidBase n =
-  let xs = ['0'..'9'] <> ['a'..'z']
-      len = length xs
-  in if n > len || n < 2 then errorInProgram $ "getValidBase: 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 hhs = [hh pp, hh qq]
-        in case chkSize opts msg0 p hhs <* chkSize opts msg0 q hhs of
-          Left e -> e
-          Right () ->
-            let d = intercalate p (map pure q)
-            in mkNode opts (PresentT d) [show01 opts msg0 d p <> show1 opts " | " q] hhs
-
--- | 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:invalid length(4) expected 3
--- FailT "Para:invalid length(4) expected 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 ([a] ~ x
-        , GetLen ps
-        , P (ParaImpl (LenT ps) ps) x
-        ) => P (Para ps) x where
-  type PP (Para ps) x = PP (ParaImpl (LenT ps) ps) x
-  eval _ opts as = do
-    let msg0 = "Para"
-        n = getLen @ps
-    if n /= length as then
-       let msg1 = msg0 <> badLength as n
-       in pure $ mkNode opts (FailT msg1) [msg1] []
-    else eval (Proxy @(ParaImpl (LenT ps) ps)) opts as
-
--- only allow non empty lists -- might need [a] ~ x but it seems fine
-instance GL.TypeError ('GL.Text "ParaImpl '[] invalid: requires at least one value in the list")
-   => P (ParaImpl n ('[] :: [k])) x where
-  type PP (ParaImpl n ('[] :: [k])) x = Void
-  eval _ _ _ = errorInProgram "ParaImpl empty list"
-
-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 problem
-          Right b -> mkNode opts (PresentT [b]) [msgbase1 <> show0 opts " " [b] <> show1 opts " | " a] [hh pp]
-      _ -> errorInProgram $ "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]
-       _ -> errorInProgram "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:invalid length(5) expected 4
--- FailT "Para:invalid length(5) expected 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)) x
-         , GetLen (RepeatT n p)
-         , x ~ [a]
-         ) => P (ParaN n p) x where
-  type PP (ParaN n p) x = PP (Para (RepeatT n p)) x
-  eval _ = eval (Proxy @(Para (RepeatT n p)))
-
--- | 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)
-data Case' (ps :: [k]) (qs :: [k1]) (r :: k2)
-data Case'' s (ps :: [k]) (qs :: [k1]) (r :: k2)
-
-type CaseT' (ps :: [k]) (qs :: [k1]) (r :: k2) = Case (Snd Id >> Failp "Case:no match") ps qs r
-type CaseT'' s (ps :: [k]) (qs :: [k1]) (r :: k2) = Case (FailCaseT s) ps qs r -- eg s= PrintF "%s" (ShowP Id)
-
-instance P (CaseT'' s ps qs r) x => P (Case'' s ps qs r) x where
-  type PP (Case'' s ps qs r) x = PP (CaseT'' s ps qs r) x
-  eval _ = eval (Proxy @(CaseT'' s ps qs r))
-
-instance P (CaseT' ps qs r) x => P (Case' ps qs r) x where
-  type PP (Case' ps qs r) x = PP (CaseT' ps qs r) x
-  eval _ = eval (Proxy @(CaseT' ps qs r))
-
-type FailCaseT p = Fail (Snd Id >> Unproxy) (Fst Id >> p)
-
-type CaseImplT e ps qs r = CaseImpl (LenT ps) e ps qs r
-
--- 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 (CaseImplT e ps qs r) x
-        ) => P (Case e ps qs r) x where
-  type PP (Case e ps qs r) x = PP (CaseImplT e ps qs r) x
-  eval _ = eval (Proxy @(CaseImplT 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 _ _ _ = errorInProgram "CaseImpl lhs empty"
-
-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 _ _ _ = errorInProgram "CaseImpl rhs empty"
-
-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 _ _ _ = errorInProgram "CaseImpl both lists empty"
-
-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 | isVerbose opts])
-          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 : [hh qq | isVerbose opts])
-          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
-
-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 Traverse p q
-type TraverseT p q = Map p q >> Sequence
-
-instance P (TraverseT p q) x => P (Traverse p q) x where
-  type PP (Traverse p q) x = PP (TraverseT p q) x
-  eval _ = eval (Proxy @(TraverseT p q))
-
--- | 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 "LICENSE" >> 'Just Id >> Len > 0) ()
--- True
--- TrueT
---
--- >>> pz @(FileExists "xyzzy") ()
--- False
--- FalseT
---
-data ReadFile p
-
-data FileExists p
-type FileExistsT p = IsJust (ReadFile p)
-
-instance P (FileExistsT p) x => P (FileExists p) x where
-  type PP (FileExists p) x = PP (FileExistsT p) x
-  eval _ = evalBool (Proxy @(FileExistsT p))
-
-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"] [hh pp]
-          Just Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " does not exist"] [hh pp]
-          Just (Just b) -> mkNode opts (PresentT (Just b)) [msg1 <> " len=" <> show (length b) <> showLit0 opts " Just " b] [hh pp]
-
--- | does the directory exists
---
--- >>> pz @(DirExists ".") ()
--- True
--- TrueT
---
-data ReadDir p
-data DirExists p
-type DirExistsT p = IsJust (ReadDir p)
-
-instance P (DirExistsT p) x => P (DirExists p) x where
-  type PP (DirExists p) x = PP (DirExistsT p) x
-  eval _ = evalBool (Proxy @(DirExistsT p))
-
-
-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] []
-
--- | read an environment variable
---
--- >>> 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] []
-
--- | read all the environment variables as key value pairs
-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)] []
-
--- | get the current time using 'UTCTime'
-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] []
-
--- | get the current time using 'ZonedTime'
-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
-
--- | append to a file
-data AppendFile (s :: Symbol) p
-type AppendFileT (s :: Symbol) p = WriteFileImpl ('FOther s 'WFAppend) p
-
-instance P (AppendFileT s p) x => P (AppendFile s p) x where
-  type PP (AppendFile s p) x = PP (AppendFileT s p) x
-  eval _ = eval (Proxy @(AppendFileT s p))
-
-
--- | write to file, overwriting if needed
-data WriteFile' (s :: Symbol) p
-type WriteFileT' (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWriteForce) p
-
-instance P (WriteFileT' s p) x => P (WriteFile' s p) x where
-  type PP (WriteFile' s p) x = PP (WriteFileT' s p) x
-  eval _ = eval (Proxy @(WriteFileT' s p))
-
--- | write to file, without overwriting
-data WriteFile (s :: Symbol) p
-type WriteFileT (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWrite) p
-
-instance P (WriteFileT s p) x => P (WriteFile s p) x where
-  type PP (WriteFile s p) x = PP (WriteFileT s p) x
-  eval _ = eval (Proxy @(WriteFileT s p))
-
--- | write a string value to stdout
-data Stdout p
-type StdoutT p = WriteFileImpl 'FStdout p
-
-instance P (StdoutT p) x => P (Stdout p) x where
-  type PP (Stdout p) x = PP (StdoutT p) x
-  eval _ = eval (Proxy @(StdoutT p))
-
--- | write a string value to stderr
-data Stderr p
-type StderrT p = WriteFileImpl 'FStderr p
-
-instance P (StderrT p) x => P (Stderr p) x where
-  type PP (Stderr p) x = PP (StderrT p) x
-  eval _ = eval (Proxy @(StderrT 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 $ case fh of
-                  FStdout -> fmap (left show) $ E.try @E.SomeException $ putStr ss
-                  FStderr -> fmap (left show) $ E.try @E.SomeException $ putStr 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 (`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]
-
--- | read in a value of a given type from stdin with a prompt: similar to 'System.IO.readIO'
-type ReadIO (t :: Type) = ReadIO' t "Enter value"
-type ReadIO' (t :: Type) s = Stdout (s <> ":") >> Stdin >> ReadP t Id
--- eg pe2 @(ReadIO Int + ReadIO Int) ()
-
--- | read a value from stdin
-data Stdin
-
-instance P Stdin x where
-  type PP Stdin x = String
-  eval _ opts _x = do
-    let msg0 = "Stdin"
-    mb <- runIO $ do
-                      lr <- E.try getLine
-                      pure $ case lr of
-                        Left (e :: E.SomeException) -> Left $ show e
-                        Right ss -> Right ss
-    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
-
-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]
-
-data IsPrefix p q
-type IsPrefixT p q = IsFixImpl 'LT 'False p q
-
-instance P (IsPrefixT p q) x => P (IsPrefix p q) x where
-  type PP (IsPrefix p q) x = PP (IsPrefixT p q) x
-  eval _ = evalBool (Proxy @(IsPrefixT p q))
-
-data IsInfix p q
-type IsInfixT p q = IsFixImpl 'EQ 'False p q
-
-instance P (IsInfixT p q) x => P (IsInfix p q) x where
-  type PP (IsInfix p q) x = PP (IsInfixT p q) x
-  eval _ = evalBool (Proxy @(IsInfixT p q))
-
-data IsSuffix p q
-type IsSuffixT p q = IsFixImpl 'GT 'False p q
-
-instance P (IsSuffixT p q) x => P (IsSuffix p q) x where
-  type PP (IsSuffix p q) x = PP (IsSuffixT p q) x
-  eval _ = evalBool (Proxy @(IsSuffixT p q))
-
-data IsPrefixI p q
-type IsPrefixIT p q = IsFixImpl 'LT 'True p q
-
-instance P (IsPrefixIT p q) x => P (IsPrefixI p q) x where
-  type PP (IsPrefixI p q) x = PP (IsPrefixIT p q) x
-  eval _ = evalBool (Proxy @(IsPrefixIT p q))
-
-data IsInfixI p q
-type IsInfixIT p q = IsFixImpl 'EQ 'True p q
-
-instance P (IsInfixIT p q) x => P (IsInfixI p q) x where
-  type PP (IsInfixI p q) x = PP (IsInfixIT p q) x
-  eval _ = evalBool (Proxy @(IsInfixIT p q))
-
-data IsSuffixI p q
-type IsSuffixIT p q = IsFixImpl 'GT 'True p q
-
-instance P (IsSuffixIT p q) x => P (IsSuffixI p q) x where
-  type PP (IsSuffixI p q) x = PP (IsSuffixIT p q) x
-  eval _ = evalBool (Proxy @(IsSuffixIT p q))
-
--- | 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 <>
-
-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]
-
-data SapA' (t :: Type)
-type SapAT' (t :: Type) = Wrap t (Fst Id) <> Wrap t (Snd Id)
-
-instance P (SapAT' t) x => P (SapA' t) x where
-  type PP (SapA' t) x = PP (SapAT' t) x
-  eval _ = eval (Proxy @(SapAT' t))
-
-data SapA
-type SapAT = Fst Id <> Snd Id
-
-instance P SapAT x => P SapA x where
-  type PP SapA x = PP SapAT x
-  eval _ = eval (Proxy @SapAT)
-
--- | 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 ArrowRT p q = q <* p
-data p *> q
-infixl 4 *>
-
-instance P (ArrowRT p q) x => P (p *> q) x where
-  type PP (p *> q) x = PP (ArrowRT p q) x
-  eval _ = eval (Proxy @(ArrowRT p q))
-
-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) [msg0 <> " " <> 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) [msg0 <> " " <> 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 @(TrimBoth (Snd Id)) (20," abc   " :: String)
--- Present "abc"
--- PresentT "abc"
---
--- >>> pz @(TrimBoth (Snd Id)) (20,T.pack " abc   ")
--- Present "abc"
--- PresentT "abc"
---
--- >>> pz @(TrimL (Snd Id)) (20," abc   ")
--- Present "abc   "
--- PresentT "abc   "
---
--- >>> pz @(TrimR (Snd Id)) (20," abc   ")
--- Present " abc"
--- PresentT " abc"
---
--- >>> pz @(TrimR "  abc ") ()
--- Present "  abc"
--- PresentT "  abc"
---
--- >>> pz @(TrimR "") ()
--- Present ""
--- PresentT ""
---
--- >>> pz @(TrimBoth "         ") ()
--- Present ""
--- PresentT ""
---
--- >>> pz @(TrimBoth "") ()
--- Present ""
--- PresentT ""
---
-data TrimImpl (left :: Bool) (right :: Bool) p
-
-instance (FailUnlessT (OrT l r)
-           ('GL.Text "TrimImpl: left and right cannot both be False")
-        , GetBool l
-        , GetBool r
-        , TL.IsText (PP p x)
-        , P p x
-        ) => P (TrimImpl l r p) x where
-  type PP (TrimImpl l r p) x = PP p x
-  eval _ opts x = do
-    let msg0 = "Trim" ++ (if l && r then "Both" else if l then "L" else "R")
-        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]
-
-data TrimL p
-type TrimLT p = TrimImpl 'True 'False p
-
-instance P (TrimLT p) x => P (TrimL p) x where
-  type PP (TrimL p) x = PP (TrimLT p) x
-  eval _ = eval (Proxy @(TrimLT p))
-
-data TrimR p
-type TrimRT p = TrimImpl 'False 'True p
-
-instance P (TrimRT p) x => P (TrimR p) x where
-  type PP (TrimR p) x = PP (TrimRT p) x
-  eval _ = eval (Proxy @(TrimRT p))
-
-data TrimBoth p
-type TrimBothT p = TrimImpl 'True 'True p
-
-instance P (TrimBothT p) x => P (TrimBoth p) x where
-  type PP (TrimBoth p) x = PP (TrimBothT p) x
-  eval _ = eval (Proxy @(TrimBothT p))
-
--- | similar to 'T.stripLeft' 'T.stripRight'
---
--- >>> pz @(StripL "xyz" Id) ("xyzHello" :: String)
--- Present Just "Hello"
--- PresentT (Just "Hello")
---
--- >>> pz @(StripL "xyz" Id) (T.pack "xyzHello")
--- Present Just "Hello"
--- PresentT (Just "Hello")
---
--- >>> pz @(StripL "xyz" Id) "xywHello"
--- Present Nothing
--- PresentT Nothing
---
--- >>> pz @(StripR "xyz" Id) "Hello xyz"
--- Present Just "Hello "
--- PresentT (Just "Hello ")
---
--- >>> pz @(StripR "xyz" Id) "xyzHelloxyw"
--- Present Nothing
--- PresentT Nothing
---
--- >>> pz @(StripR "xyz" Id) ""
--- Present Nothing
--- PresentT Nothing
---
--- >>> pz @(StripR "xyz" "xyz") ()
--- Present Just ""
--- PresentT (Just "")
---
-data StripImpl(left :: Bool) p q
-
-instance (GetBool l
-        , PP p x ~ String
-        , P p x
-        , TL.IsText (PP q x)
-        , P q x
-        ) => P (StripImpl l p q) x where
-  type PP (StripImpl l p q) x = Maybe (PP q x)
-  eval _ opts x = do
-    let msg0 = "Strip" ++ if l then "L" else "R"
-        l = getBool @l
-    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 l then
-                  let (before,after) = splitAt (length p) q
-                  in if before == p then Just after else Nothing
-                else
-                  let (before,after) = splitAt (length q - length p) q
-                  in if after == p then Just before else Nothing
-        in mkNode opts (PresentT (fmap (view TL.packed) b)) [msg0 <> show0 opts "" b <> showLit1 opts " | p=" p <> showLit1 opts " | q=" q] [hh pp, hh qq]
-
-data StripL p q
-type StripLT p q = StripImpl 'True p q
-
-instance P (StripLT p q) x => P (StripL p q) x where
-  type PP (StripL p q) x = PP (StripLT p q) x
-  eval _ = eval (Proxy @(StripLT p q))
-
-data StripR p q
-type StripRT p q = StripImpl 'False p q
-
-instance P (StripRT p q) x => P (StripR p q) x where
-  type PP (StripR p q) x = PP (StripRT p q) x
-  eval _ = eval (Proxy @(StripRT p q))
-
--- | 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 _ = eval (Proxy @(RepeatT n p))
-
--- | 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
-type DoNT (n :: Nat) p = Do (RepeatT n p)
-instance P (DoNT n p) a => P (DoN n p) a where
-  type PP (DoN n p) a = PP (DoNT n p) a
-  eval _ = eval (Proxy @(DoNT n p))
-
--- | 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 ->
-        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 ->
-        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 ->
-        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 ->
-        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 a 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 ->
-        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 a 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 ->
-        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 ->
-        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 <> " " <> showThese 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 ->
-        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 <> " " <> showThese 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 ->
-        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 <> " " <> showThese q] [hh qq, hh pp]
-
-
--- | extract the This value from a 'These' otherwise fail with a 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 ->
-        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 <> " " <> showThese q] [hh qq, hh pp]
-
-
--- | extract the That value from a 'These' otherwise fail with a 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 ->
-        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 <> " " <> showThese q] [hh qq, hh pp]
-
-
-
-
--- | extract the These value from a 'These' otherwise fail with a 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 ->
-        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 <> " " <> showThese q] [hh qq, hh pp]
-
--- | 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]
-
-
--- | compose simple functions
---
--- >>> pl @(Dot '[Thd,Snd,Fst] Id) ((1,(2,9,10)),(3,4))
--- Present 10 (Thd 10 | (2,9,10))
--- PresentT 10
---
-data Dot (ps :: [Type -> Type]) (q :: Type)
-instance (P (DotExpandT ps q) a) => P (Dot ps q) a where
-  type PP (Dot ps q) a = PP (DotExpandT ps q) a
-  eval _ = eval (Proxy @(DotExpandT ps q))
-
-type family DotExpandT (ps :: [Type -> Type]) (q :: Type) :: Type where
-  DotExpandT '[] _ = GL.TypeError ('GL.Text "'[] invalid: requires at least one predicate in the list")
-  DotExpandT '[p] q = p $ q
-  DotExpandT (p ': p1 ': ps) q = p $ DotExpandT (p1 ': ps) q
-
--- | reversed dot
---
--- >>> pl @(RDot '[Fst,Snd,Thd] Id) ((1,(2,9,10)),(3,4))
--- Present 10 (Thd 10 | (2,9,10))
--- PresentT 10
---
--- >>> pl @(RDot '[Fst,Snd] Id) (('a',2),(True,"zy"))
--- Present 2 (Snd 2 | ('a',2))
--- PresentT 2
---
-data RDot (ps :: [Type -> Type]) (q :: Type)
-instance P (RDotExpandT ps q) a => P (RDot ps q) a where
-  type PP (RDot ps q) a = PP (RDotExpandT ps q) a
-  eval _ = eval (Proxy @(RDotExpandT ps q))
-
-type family RDotExpandT (ps :: [Type -> Type]) (q :: Type) :: Type where
-  RDotExpandT '[] _ = GL.TypeError ('GL.Text "'[] invalid: requires at least one predicate in the list")
-  RDotExpandT '[p] q = p $ q
-  RDotExpandT (p ': p1 ': ps) q = RDotExpandT (p1 ': ps) (p $ q)
-
--- | like 'GHC.Base.$' for expressions
---
--- >>> pl @(Fst $ Snd $ Id) ((1,2),(3,4))
--- Present 3 (Fst 3 | (3,4))
--- PresentT 3
---
--- >>> pl @((<=) 4 $ Fst $ Snd $ Id) ((1,2),(3,4))
--- False (4 <= 3)
--- FalseT
---
-data (p :: k -> k1) $ (q :: k)
-infixr 0 $
-
-instance P (p q) a => P (p $ q) a where
-  type PP (p $ q) a = PP (p q) a
-  eval _  = eval (Proxy @(p q))
-
--- | similar to 'Control.Lens.&'
---
--- >>> pl @(Id & Fst & Singleton & Length) (13,"xyzw")
--- Present 1 (Length 1 | [13])
--- PresentT 1
---
--- >>> pl @(2 & (&&&) "abc") ()
--- Present ("abc",2) (W'(,))
--- PresentT ("abc",2)
---
--- >>> pl @(2 & '(,) "abc") ()
--- Present ("abc",2) ('(,))
--- PresentT ("abc",2)
---
--- >>> pl @('(,) 4 $ '(,) 7 $ "aa") ()
--- Present (4,(7,"aa")) ('(,))
--- PresentT (4,(7,"aa"))
---
--- >>> pl @(Thd $ Snd $ Fst Id) ((1,("W",9,'a')),(3,4))
--- Present 'a' (Thd 'a' | ("W",9,'a'))
--- PresentT 'a'
---
-data (q :: k) & (p :: k -> k1)
-infixl 1 &
-
-instance P (p q) a => P (q & p) a where
-  type PP (q & p) a = PP (p q) a
-  eval _ = eval (Proxy @(p q))
-
--- | creates a constant expression ignoring the second argument
---
--- >>> pl @(RDot '[Fst,Snd,Thd,K "xxx"] Id) ((1,(2,9,10)),(3,4))
--- Present "xxx" (K'xxx)
--- PresentT "xxx"
---
--- >>> pl @(RDot '[Fst,Snd,Thd,K '("abc",Id)] Id) ((1,(2,9,10)),(3,4))
--- Present ("abc",((1,(2,9,10)),(3,4))) (K'(,))
--- PresentT ("abc",((1,(2,9,10)),(3,4)))
---
--- >>> pl @(Thd $ Snd $ Fst $ K Id "dud") ((1,("W",9,'a')),(3,4))
--- Present 'a' (Thd 'a' | ("W",9,'a'))
--- PresentT 'a'
---
--- >>> pl @((Thd $ Snd $ Fst $ K Id "dud") >> Pred Id) ((1,("W",9,'a')),(3,4))
--- Present '`' ((>>) '`' | {Pred '`' | 'a'})
--- PresentT '`'
---
-data K (p :: k) (q :: k1)
-instance P p a => P (K p q) a where
-  type PP (K p q) a = PP p a
-  eval _ = eval (Proxy @(Msg "K" p))
-
--- | applies \'p\' to the first and second slot of an n-tuple
---
--- >>> pl @(Both Len (Fst Id)) (("abc",[10..17],1,2,3),True)
--- Present (3,8) (Both)
--- PresentT (3,8)
---
--- >>> pl @(Both (Pred Id) $ Fst Id) ((12,'z',[10..17]),True)
--- Present (11,'y') (Both)
--- PresentT (11,'y')
---
--- >>> pl @(Both (Succ Id) Id) (4,'a')
--- Present (5,'b') (Both)
--- PresentT (5,'b')
---
--- >>> pl @(Both Len (Fst Id)) (("abc",[10..17]),True)
--- Present (3,8) (Both)
--- PresentT (3,8)
---
--- >>> pl @(Both (ReadP Day Id) Id) ("1999-01-01","2001-02-12")
--- Present (1999-01-01,2001-02-12) (Both)
--- PresentT (1999-01-01,2001-02-12)
---
-data Both p q
-instance ( ExtractL1C (PP q x)
-         , ExtractL2C (PP q x)
-         , P p (ExtractL1T (PP q x))
-         , P p (ExtractL2T (PP q x))
-         , P q x
-   ) => P (Both p q) x where
-  type PP (Both p q) x = (PP p (ExtractL1T (PP q x)), PP p (ExtractL2T (PP q x)))
-  eval _ opts x = do
-    let msg0 = "Both"
-    qq <- eval (Proxy @q) opts x
-    case getValueLR opts msg0 qq [] of
-      Left e -> pure e
-      Right q -> do
-        let (a,a') = (extractL1C q, extractL2C q)
-        pp <- eval (Proxy @p) opts a
-        case getValueLR opts msg0 pp [hh qq] of
-          Left e -> pure e
-          Right b -> do
-            pp' <- eval (Proxy @p) opts a'
-            pure $ case getValueLR opts msg0 pp' [hh qq, hh pp] of
-              Left e -> e
-              Right b' ->
-                mkNode opts (PresentT (b,b')) [msg0] [hh qq, hh pp, hh pp']
-
--- | gets the singleton value from a foldable
---
--- >>> pl @(OneP Id) [10..15]
--- Error OneP 6 elements
--- FailT "OneP 6 elements"
---
--- >>> pl @(OneP Id) [10]
--- Present 10 (OneP)
--- PresentT 10
---
--- >>> pl @(OneP Id) []
--- Error OneP empty
--- FailT "OneP empty"
---
--- >>> pl @(OneP Id) (Just 10)
--- Present 10 (OneP)
--- PresentT 10
---
--- >>> pl @(OneP Id) Nothing
--- Error OneP empty
--- FailT "OneP empty"
---
-data OneP p
-instance (Foldable t
-        , PP p x ~ t a
-        , P p x
-        ) => P (OneP p) x where
-  type PP (OneP p) x = ExtractAFromTA (PP p x)
-  eval _ opts x = do
-    let msg0 = "OneP"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p -> case toList p of
-                   [] -> mkNode opts (FailT (msg0 <> " empty")) [msg0 <> " expected one element"] [hh pp]
-                   [a] -> mkNode opts (PresentT a) [msg0] [hh pp]
-                   as -> let n = length as
-                         in mkNode opts (FailT (msg0 <> " " <> show n <> " elements")) [msg0 <> " expected one element"] [hh pp]
-
--- | parse json data
---
--- >>> pl @(ParseJson (Int,String) Id) "[10,\"abc\"]"
--- Present (10,"abc") (ParseJson (Int,[Char]) (10,"abc"))
--- PresentT (10,"abc")
---
--- >>> pl @(ParseJson (Int,String) Id) "[10,\"abc\",99]"
--- Error ParseJson (Int,[Char])([10,"abc",...) Error in $
--- FailT "ParseJson (Int,[Char])([10,\"abc\",...) Error in $"
---
--- >>> pl @(ParseJson (Int,Bool) (FromString _ Id)) ("[1,true]" :: String)
--- Present (1,True) (ParseJson (Int,Bool) (1,True))
--- PresentT (1,True)
---
--- >>> pl @(ParseJson (Int,Bool) Id) (A.encode (1,True))
--- Present (1,True) (ParseJson (Int,Bool) (1,True))
--- PresentT (1,True)
---
--- >>> pl @(ParseJson () Id) "[1,true]"
--- Error ParseJson ()([1,true]) Error in $
--- FailT "ParseJson ()([1,true]) Error in $"
---
-data ParseJson' t p
-
-instance (P p x
-        , PP p x ~ BL8.ByteString
-        , Typeable (PP t x)
-        , Show (PP t x)
-        , A.FromJSON (PP t x)
-        ) => P (ParseJson' t p) x where
-  type PP (ParseJson' t p) x = PP t x
-  eval _ opts x = do
-    let msg0 = "ParseJson " <> 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 hhs = [hh pp]
-            msg1 = msg0 <> "(" ++ litBL 10 s ++ ")"
-        in case A.eitherDecode' s of
-           Right b -> mkNode opts (PresentT b) [msg0 <> " " ++ showL 30 b] hhs
-           Left e -> mkNode opts (FailT (msg1 <> " " <> takeWhile (/=':') e) ) [msg0 <> " failed " <> e <> " | " <> litBL 100 s] hhs
-
-data ParseJson (t :: Type) p
-type ParseJsonT (t :: Type) p = ParseJson' (Hole t) p
-
-instance P (ParseJsonT t p) x => P (ParseJson t p) x where
-  type PP (ParseJson t p) x = PP (ParseJsonT t p) x
-  eval _ = eval (Proxy @(ParseJsonT t p))
-
--- | parse a json file
-data ParseJsonFile' t p
-
-instance (P p x
-        , PP p x ~ String
-        , Typeable (PP t x)
-        , Show (PP t x)
-        , A.FromJSON (PP t x)
-        ) => P (ParseJsonFile' t p) x where
-  type PP (ParseJsonFile' t p) x = PP t x
-  eval _ opts x = do
-    let msg0 = "ParseJsonFile " <> t
-        t = showT @(PP t x)
-    pp <- eval (Proxy @p) opts x
-    case getValueLR opts msg0 pp [] of
-      Left e -> pure e
-      Right p -> do
-        let hhs = [hh pp]
-            msg1 = msg0 <> "(" <> p <> ")"
-        mb <- runIO $ do
-                b <- doesFileExist p
-                if b then Just <$> BS8.readFile p
-                else pure Nothing
-        pure $ case mb of
-          Nothing -> mkNode opts (FailT (msg1 <> " must run in IO")) [msg1 <> " must run in IO"] hhs
-          Just Nothing -> mkNode opts (FailT (msg1 <> " file doesn't exist")) [msg1 <> " does not exist"] hhs
-          Just (Just s) ->
-            case A.eitherDecodeStrict' s of
-               Right b -> mkNode opts (PresentT b) [msg1 <> " " ++ showL 30 b] hhs
---                Left e -> mkNode opts (FailT (msg1 <> " " <> takeWhile (/=':') e)) [msg1 <> " failed " <> litL 100 e] hhs
-               Left e -> mkNode opts (FailT (msg1 <> " " <> takeWhile (/=':') e)) [msg0 <> " failed " <> e <> " | " <> litBS 100 s] hhs
-
-data ParseJsonFile (t :: Type) p
-type ParseJsonFileT (t :: Type) p = ParseJsonFile' (Hole t) p
-
-instance P (ParseJsonFileT t p) x => P (ParseJsonFile t p) x where
-  type PP (ParseJsonFile t p) x = PP (ParseJsonFileT t p) x
-  eval _ = eval (Proxy @(ParseJsonFileT t p))
-
--- | encode json
---
--- >>> pl @(EncodeJson Id) (10,"def")
--- Present "[10,\"def\"]" (EncodeJson [10,"def"])
--- PresentT "[10,\"def\"]"
---
--- >>> pl @(EncodeJson Id >> ParseJson (Int,Bool) Id) (1,True)
--- Present (1,True) ((>>) (1,True) | {ParseJson (Int,Bool) (1,True)})
--- PresentT (1,True)
---
--- >>> pl @(ParseJson ([String], These Int ()) (EncodeJson Id)) (["abc","def"],This 110)
--- Present (["abc","def"],This 110) (ParseJson ([[Char]],(These Int ())) (["abc","def"],This 110))
--- PresentT (["abc","def"],This 110)
---
-data EncodeJson p
-
-instance (A.ToJSON (PP p x), P p x) => P (EncodeJson p) x where
-  type PP (EncodeJson p) x = BL8.ByteString
-  eval _ opts x = do
-    let msg0 = "EncodeJson"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = A.encode p
-        in mkNode opts (PresentT d) [msg0 <> showLit0 opts " " (litBL 50 d)] [hh pp]
-
--- | encode a json file
-data EncodeJsonFile p q
-
-instance (PP p x ~ String
-        , P p x
-        , A.ToJSON (PP q x)
-        , P q x
-        ) => P (EncodeJsonFile p q) x where
-  type PP (EncodeJsonFile p q) x = ()
-  eval _ opts x = do
-    let msg0 = "EncodeJsonFile"
-    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
-    case lr of
-      Left e -> pure e
-      Right (p,q,pp,qq) -> do
-        let d = A.encode q
-            hhs = [hh pp, hh qq]
-        mb <- runIO $ BL8.writeFile p d
-        pure $ case mb of
-          Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] hhs
-          Just () -> mkNode opts (PresentT ()) [msg0 <> showLit0 opts " " (litBL 50 d)] hhs
-
--- | uncurry experiment
---
--- >>> pl @(Uncurry Between (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2019-10-12"
--- False (Uncurry (2019-10-12 <= 2018-12-30))
--- FalseT
---
--- >>> pl @(Uncurry Between (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2017-10-12"
--- True (Uncurry (2017-04-11 <= 2017-10-12 <= 2018-12-30))
--- TrueT
---
--- >>> pl @(Uncurry Between (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2016-10-12"
--- False (Uncurry (2017-04-11 <= 2016-10-12))
--- FalseT
---
-data Uncurry (p :: Type -> Type -> Type -> Type) q r
-
-instance (PP q x ~ (a,b)
-        , PP (p a b (PP r x)) x ~ PP (p (Fst Id) (Snd Id) (Thd Id)) (a, b, PP r x)
-        , P q x
-        , P r x
-        , P (p (Fst Id) (Snd Id) (Thd Id)) (a,b,PP r x)
-     ) => P (Uncurry p q r) x where
-  type PP (Uncurry p q r) x = PP (p (ExtractL1T (PP q x)) (ExtractL2T (PP q x)) (PP r x)) x
-  eval _ opts x = do
-    let msg0 = "Uncurry"
-    lr <- runPQ msg0 (Proxy @q) (Proxy @r) opts x []
-    case lr of
-      Left e -> pure e
-      Right ((q1,q2),r,qq,rr) -> do
-        let hhs0 = [hh qq, hh rr]
-        pp <- eval (Proxy @(p (Fst Id) (Snd Id) (Thd Id))) opts (q1,q2,r)
-        pure $ case getValueLR opts msg0 pp hhs0 of
-          Left e -> e
-          Right _ ->
-            let hhs = hhs0 ++ [hh pp]
-            in mkNode opts (_tBool pp) [msg0 <> " " <> topMessage pp] hhs
-
--- | like 'Predicate.Prelude.&&' but for a tuple
---
--- >>> pl @(SplitAt 4 "abcdefg" >> Len > 4 &* Len < 5) ()
--- False ((>>) False | {False (&*) True | (4 > 4)})
--- FalseT
---
-data AndA p q r
-instance (PP r x ~ (a,b)
-        , PP p a ~ Bool
-        , PP q b ~ Bool
-        , P p a
-        , P q b
-        , P r x
-        ) => P (AndA p q r) x where
-  type PP (AndA p q r) x = Bool
-  eval _ opts x = do
-    let msg0 = "(&*)"
-    rr <- eval (Proxy @r) opts x
-    case getValueLR opts msg0 rr [] of
-      Left e -> pure e
-      Right (r1,r2) -> do
-        pp <- evalBool (Proxy @p) opts r1
-        case getValueLR opts msg0 pp [hh rr] of
-          Left e -> pure e
-          Right p -> do
-            qq <- evalBool (Proxy @q) opts r2
-            pure $ case getValueLR opts msg0 qq [hh rr, hh pp] of
-              Left e -> e
-              Right q ->
-                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 rr, hh pp, hh qq]
-
-data p &* q
-type AndAT p q = AndA p q Id
-infixr 3 &*
-
-instance P (AndAT p q) x => P (p &* q) x where
-  type PP (p &* q) x = PP (AndAT p q) x
-  eval _ = evalBool (Proxy @(AndAT p q))
-
-{-
-data p &&! q
-type AndAT' p q = (Fst Id >> p) && (Snd Id >> q)
-infixr 3 &&!
-
-instance (P (AndAT' p q) x
-        ) => P (p &&! q) x where
-  type PP (p &&! q) x = PP (AndAT' p q) x
-  eval _ = evalBool (Proxy @(AndAT' p q))
--}
-
--- | like 'Predicate.Prelude.||' but for a tuple
---
--- >>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,8,14,44],9)
--- True (True (|+) False)
--- TrueT
---
--- >>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,14],9)
--- False (False (|+) False | (32 > 44) (|+) (9 < 2))
--- FalseT
---
--- >>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,14],1)
--- True (False (|+) True)
--- TrueT
---
-data OrA p q r
-instance (PP r x ~ (a,b)
-        , PP p a ~ Bool
-        , PP q b ~ Bool
-        , P p a
-        , P q b
-        , P r x
-        ) => P (OrA p q r) x where
-  type PP (OrA p q r) x = Bool
-  eval _ opts x = do
-    let msg0 = "(|+)"
-    rr <- eval (Proxy @r) opts x
-    case getValueLR opts msg0 rr [] of
-      Left e -> pure e
-      Right (r1,r2) -> do
-        pp <- evalBool (Proxy @p) opts r1
-        case getValueLR opts msg0 pp [hh rr] of
-          Left e -> pure e
-          Right p -> do
-            qq <- evalBool (Proxy @q) opts r2
-            pure $ case getValueLR opts msg0 qq [hh rr, hh pp] of
-              Left e -> e
-              Right q ->
-                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 rr, hh pp, hh qq]
-
-data p |+ q
-type OrAT p q = OrA p q Id
-infixr 3 |+
-
-instance P (OrAT p q) x => P (p |+ q) x where
-  type PP (p |+ q) x = PP (OrAT p q) x
-  eval _ = evalBool (Proxy @(OrAT p q))
-
--- | very simple conversion to a string
-data ToString p
-instance (ToStringC (PP p x), P p x) => P (ToString p) x where
-  type PP (ToString p) x = String
-  eval _ opts x = do
-    let msg0 = "ToString"
-    pp <- eval (Proxy @p) opts x
-    pure $ case getValueLR opts msg0 pp [] of
-      Left e -> e
-      Right p ->
-        let d = toStringC p
-        in mkNode opts (PresentT d) [msg0] [hh pp]
-
-class ToStringC a where
-  toStringC :: a -> String
-instance ToStringC String where
-  toStringC = id
-instance ToStringC T.Text where
-  toStringC = T.unpack
-instance ToStringC TL.Text where
-  toStringC = TL.unpack
-instance ToStringC BL8.ByteString where
-  toStringC = BL8.unpack
-instance ToStringC BS8.ByteString where
-  toStringC = BS8.unpack
-
--- | splits a list pointed to by \'p\' into lists of size \'n\'
---
--- >>> pz @(ChunksOf 2 Id) "abcdef"
--- Present ["ab","cd","ef"]
--- PresentT ["ab","cd","ef"]
---
--- >>> pz @(ChunksOf 2 Id) "abcdefg"
--- Present ["ab","cd","ef","g"]
--- PresentT ["ab","cd","ef","g"]
---
--- >>> pz @(ChunksOf 2 Id) ""
--- Present []
--- PresentT []
---
--- >>> pz @(ChunksOf 2 Id) "a"
--- Present ["a"]
--- PresentT ["a"]
---
-data ChunksOf n p
-
-instance (PP p a ~ [b]
-        , P n a
-        , P p a
-        , Show b
-        , Integral (PP n a)
-        ) => P (ChunksOf n p) a where
-  type PP (ChunksOf n p) a = [PP p a]
-  eval _ opts a = do
-    let msg0 = "ChunksOf"
-    lr <- runPQ msg0 (Proxy @n) (Proxy @p) opts a []
-    pure $ case lr of
-      Left e -> e
-      Right (fromIntegral -> n,p,pp,qq) ->
-        let hhs = [hh pp, hh qq]
-            msg1 = msg0 <> show0 opts " " n <> show0 opts " " p
-        in if n <= 0 then mkNode opts (FailT (msg0 <> " n<1")) [msg1] hhs
-           else let ret = unfoldr (\s -> if null s then Nothing else Just $ splitAt n s) p
-                in mkNode opts (PresentT ret) [show01' opts msg1 ret "n=" n <> show1 opts " | " p] hhs
-
-data Rotate n p
-type RotateT n p = SplitAt n p >> Swap >> First Reverse >> SapA
-
-instance P (RotateT n p) x => P (Rotate n p) x where
-  type PP (Rotate n p) x = PP (RotateT n p) x
-  eval _ = eval (Proxy @(RotateT n p))
+{-# OPTIONS -Wall #-}
+{-# OPTIONS -Wno-compat #-}
+{-# OPTIONS -Wincomplete-record-updates #-}
+{-# OPTIONS -Wincomplete-uni-patterns #-}
+{-# OPTIONS -Wredundant-constraints #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE NoOverloadedLists #-}
+{-# LANGUAGE NoStarIsType #-}
+{- |
+     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
+  , BetweenA
+  , type (<..>)
+  , All
+  , Any
+  , AllPositive
+  , Positive
+  , AllNegative
+  , Negative
+  , AndA
+  , type (&*)
+  , OrA
+  , type (|+)
+  , IdBool
+  -- ** regex expressions
+  , Re
+  , Re'
+  , Rescan
+  , Rescan'
+  , RescanRanges
+  , RescanRanges'
+  , Resplit
+  , Resplit'
+  , ReplaceAll
+  , ReplaceAll'
+  , ReplaceOne
+  , ReplaceOne'
+  , ReplaceAllString
+  , ReplaceAllString'
+  , ReplaceOneString
+  , ReplaceOneString'
+  , ReplaceFn
+  , ReplaceFn1
+  , ReplaceFn2
+  , ReplaceFn3
+
+  -- ** tuple expressions
+  , Fst
+  , Snd
+  , Thd
+  , L1
+  , L2
+  , L3
+  , L4
+  , L5
+  , L6
+  , Dup
+  , Swap
+  , SwapC(..)
+  , Assoc
+  , Unassoc
+  , Pairs
+
+ -- ** character expressions
+  , IsLower
+  , IsUpper
+  , IsDigit
+  , IsSpace
+  , IsPunctuation
+  , IsControl
+  , IsHexDigit
+  , IsOctDigit
+  , IsSeparator
+  , IsLatin1
+
+  , IsLowerAll
+  , IsUpperAll
+  , IsDigitAll
+  , IsSpaceAll
+  , IsPunctuationAll
+  , IsControlAll
+  , IsHexDigitAll
+  , IsOctDigitAll
+  , IsSeparatorAll
+  , IsLatin1All
+
+  -- ** datetime expressions
+  , FormatTimeP
+  , ParseTimeP
+  , ParseTimeP'
+  , ParseTimes
+  , ParseTimes'
+  , MkDay
+  , MkDay'
+  , UnMkDay
+  , MkDayExtra
+  , MkDayExtra'
+  , ToDay
+  , ToTime
+  , MkTime
+  , MkTime'
+  , UnMkTime
+  , PosixToUTCTime
+  , UTCTimeToPosix
+
+  -- ** 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
+  , LogBase
+  , type (^)
+  , type (**)
+
+  -- *** rational numbers
+  , type (%)
+  , type (-%)
+  , ToRational
+  , FromRational
+  , FromRational'
+
+ -- ** proxy expressions
+  , MkProxy
+  , ProxyT
+  , ProxyT'
+  , Unproxy
+
+ -- ** read / show expressions
+  , ShowP
+  , ReadP
+  , ReadP'
+  , ReadQ
+  , ReadQ'
+  , ReadMaybe
+  , ReadMaybe'
+  , ReadBase
+  , ReadBase'
+  , ShowBase
+
+  -- ** aeson expressions
+  , ParseJson'
+  , ParseJson
+  , EncodeJson
+  , EncodeJsonFile
+  , ParseJsonFile'
+  , ParseJsonFile
+
+  -- ** 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
+  , type (==!)
+  , OrdP
+  , 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
+  , GroupOn
+  , Filter
+  , Break
+  , Span
+  , Intercalate
+  , Elem
+  , Inits
+  , Tails
+  , Ones
+  , OneP
+  , Len
+  , Length
+  , PadL
+  , PadR
+  , Cycle
+  , SplitAts
+  , SplitAt
+  , ChunksOf
+  , Rotate
+  , Take
+  , Drop
+  , Min
+  , Max
+  , Sum
+  , Product
+  , IsEmpty
+  , Null
+  , 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
+  , EitherIn
+
+  -- ** semigroup / monoid expressions
+  , type (<>)
+  , MConcat
+  , STimes
+  , SapA
+  , SapA'
+  , MEmptyT
+  , MEmptyT'
+  , MEmptyP
+  , MEmpty2
+  , MEmpty2'
+
+  -- ** indexing expressions
+  , Ix
+  , Ix'
+  , IxL
+  , type (!!)
+  , type (!!?)
+  , Lookup
+  , LookupDef
+  , LookupDef'
+  , LookupFail
+  , LookupFail'
+
+ -- ** cons / uncons expressions
+  , type (:+)
+  , 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
+  , ReadIO
+  , ReadIO'
+
+  -- ** string expressions
+  , ToLower
+  , ToUpper
+  , ToTitle
+  , TrimBoth
+  , TrimL
+  , TrimR
+  , StripR
+  , StripL
+  , IsPrefix
+  , IsInfix
+  , IsSuffix
+  , IsPrefixI
+  , IsInfixI
+  , IsSuffixI
+  , ToString
+  , FromString
+  , FromString'
+
+  -- ** 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
+  , Dot
+  , RDot
+  , type (>>)
+  , type (<<)
+  , type (>>>)
+  , DoN
+  , type ($$)
+  , type ($&)
+  , K
+  , Hide
+  , Hole
+  , Skip
+  , type (|>)
+  , type (>|)
+  , type (>|>)
+  , Uncurry
+
+  -- *** parallel expressions
+  , Para
+  , ParaN
+  , Repeat
+
+  -- ** miscellaneous
+  , Both
+  , Prime
+  , PrimeNext
+  , Luhn
+  , Char1
+  -- ** tuples
+  , Tuple2
+  , Tuple3
+  , Tuple4
+  , Tuple5
+  , Tuple6
+ ) 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 Data.List
+import qualified Data.Text.Lens as DTL
+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(..))
+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
+import qualified Data.Time.Clock.System as CP
+import qualified Data.Time.Clock.POSIX as P
+import qualified Data.Aeson as A
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Map.Strict as M
+
+-- $setup
+-- >>> :set -XDataKinds
+-- >>> :set -XTypeApplications
+-- >>> :set -XTypeOperators
+-- >>> :set -XOverloadedStrings
+-- >>> :set -XNoOverloadedLists
+-- >>> import qualified Data.Map.Strict as M
+-- >>> import qualified Data.Text as T
+-- >>> import Safe (readNote)
+
+-- | 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]
+-- TrueT
+--
+-- >>> pz @Asc' [1,2,3,4,5,5,7]
+-- FalseT
+--
+-- >>> pz @Asc "axacdef"
+-- FalseT
+--
+
+
+-- | a type level predicate for a monotonic increasing list
+data Asc
+type AscT = All (Fst Id <= Snd Id) Pairs
+
+instance P AscT x => P Asc x where
+  type PP Asc x = PP AscT x
+  eval _ = evalBool (Proxy @AscT)
+
+-- | a type level predicate for a strictly increasing list
+data Asc'
+type AscT' = All (Fst Id < Snd Id) Pairs
+
+instance P AscT' x => P Asc' x where
+  type PP Asc' x = PP AscT' x
+  eval _ = evalBool (Proxy @AscT')
+
+-- | a type level predicate for a monotonic decreasing list
+data Desc
+type DescT = All (Fst Id >= Snd Id) Pairs
+
+instance P DescT x => P Desc x where
+  type PP Desc x = PP DescT x
+  eval _ = evalBool (Proxy @DescT)
+-- | a type level predicate for a strictly decreasing list
+data Desc'
+type DescT' = All (Fst Id > Snd Id) Pairs
+
+instance P DescT' x => P Desc' x where
+  type PP Desc' x = PP DescT' x
+  eval _ = evalBool (Proxy @DescT')
+
+
+--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]
+-- TrueT
+--
+-- >>> pz @(5 <..> 8) 6
+-- TrueT
+--
+-- >>> pl @(Between 5 8 Id) 9
+-- False (9 <= 8)
+-- FalseT
+--
+-- >>> pz @(10 % 4 <..> 40 % 5) 4
+-- TrueT
+--
+-- >>> pz @(10 % 4 <..> 40 % 5) 33
+-- FalseT
+--
+data Between p q r -- reify as it is used a lot! nicer specific messages at the top level!
+
+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
+
+
+data p <..> q
+infix 4 <..>
+
+type BetweenT p q = Between p q Id
+
+instance P (BetweenT p q) x => P (p <..> q) x where
+  type PP (p <..> q) x = PP (BetweenT p q) x
+  eval _ = evalBool (Proxy @(BetweenT p q))
+
+-- | between for tuples
+--
+-- >>> pl @(BetweenA (Fst Id) (Snd Id)) ((1,4),8)
+-- False (8 <= 4)
+-- FalseT
+--
+-- >>> pl @(BetweenA (Fst Id) (Snd Id)) ((1,4),0)
+-- False (1 <= 0)
+-- FalseT
+--
+-- >>> pl @(BetweenA (Fst Id) (Snd Id)) ((1,4),3)
+-- True (1 <= 3 <= 4)
+-- TrueT
+--
+-- >>> pl @(BetweenA (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2018-10-12"
+-- True (2017-04-11 <= 2018-10-12 <= 2018-12-30)
+-- TrueT
+--
+-- >>> pl @(BetweenA (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2019-10-12"
+-- False (2019-10-12 <= 2018-12-30)
+-- FalseT
+--
+-- >>> pl @(BetweenA (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2016-10-12"
+-- False (2017-04-11 <= 2016-10-12)
+-- FalseT
+--
+
+{- too much data mitigated somewhat by Hide
+type BetweenAT p q = '(p,q) >> Between (Fst (Fst Id)) (Snd (Fst Id)) (Snd Id)
+
+instance P (BetweenAT p q) x => P (BetweenA p q) x where
+  type PP (BetweenA p q) x = PP (BetweenAT p q) x
+  eval _ = evalBool (Proxy @(BetweenAT p q))
+-}
+data BetweenA p q
+
+instance (PP p x ~ (a,a')
+       , P q x
+       , PP q x ~ a
+       , Ord a
+       , a ~ a'
+       , Show a
+       , P p x
+       ) => P (BetweenA p q) x where
+  type PP (BetweenA p q) x = Bool
+  eval _ opts x = do
+    let msg0 = "BetweenA"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right ((p1,p2),q,pp,qq) ->
+        [hh pp, hh qq] & if p1 <= q && q <= p2 then mkNodeB opts True (show p1 <> " <= " <> show q <> " <= " <> show p2)
+        else if p1 > q then mkNodeB opts False (show p1 <> " <= " <> show q)
+        else mkNodeB opts False (show q <> " <= " <> show p2)
+
+-- | similar to 'all'
+--
+-- >>> pl @(All (Between 1 8 Id) Id) [7,3,4,1,2,9,0,1]
+-- False (All(8) i=5 (9 <= 8))
+-- FalseT
+--
+-- >>> pz @(All Odd Id) [1,5,11,5,3]
+-- TrueT
+--
+-- >>> pz @(All Odd Id) []
+-- TrueT
+--
+-- >>> pan @(All Even Id) [1,5,11,5,3]
+-- False All(5) i=0 (1 == 0)
+-- |
+-- +- 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 ->
+        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 abcs ->
+                   let hhs = hh qq : map (hh . fixit) ts
+                       msg1 = msg0 ++ "(" ++ show (length q) ++ ")"
+                   in case find (not . view _1) abcs of
+                        Nothing -> mkNodeB opts True msg1 hhs
+                        Just (_,(i,_),tt) ->
+                          mkNodeB opts False (msg1 <> " i=" ++ showIndex i ++ " " <> topMessage tt) hhs
+
+showIndex :: (Show i, Num i) => i -> String
+showIndex i = show (i+0)
+-- | similar to 'any'
+--
+-- >>> pl @(Any Even Id) [1,5,11,5,3]
+-- False (Any(5))
+-- FalseT
+--
+-- >>> pl @(Any Even Id) [1,5,112,5,3]
+-- True (Any(5) i=2 (0 == 0))
+-- TrueT
+--
+-- >>> pz @(Any Even Id) []
+-- 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 ->
+        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 abcs ->
+                   let hhs = hh qq : map (hh . fixit) ts
+                       msg1 = msg0 ++ "(" ++ show (length q) ++ ")"
+                   in case find (view _1) abcs of
+                        Nothing -> mkNodeB opts False msg1 hhs
+                        Just (_,(i,_),tt) ->
+                          mkNodeB opts True (msg1 <> " i=" ++ showIndex i ++ " " <> topMessage tt) hhs
+
+
+-- | a type level predicate for all positive elements in a list
+--
+-- >>> pz @AllPositive [1,5,10,2,3]
+-- TrueT
+--
+-- >>> pz @AllPositive [0,1,5,10,2,3]
+-- FalseT
+--
+-- >>> pz @AllPositive [3,1,-5,10,2,3]
+-- FalseT
+--
+-- >>> pz @AllNegative [-1,-5,-10,-2,-3]
+-- TrueT
+--
+data AllPositive
+type AllPositiveT = All Positive Id
+
+instance P AllPositiveT x => P AllPositive x where
+  type PP AllPositive x = PP AllPositiveT x
+  eval _ = evalBool (Proxy @AllPositiveT)
+
+-- | a type level predicate for all negative elements in a list
+data AllNegative
+type AllNegativeT = All Negative Id
+
+instance P AllNegativeT x => P AllNegative x where
+  type PP AllNegative x = PP AllNegativeT x
+  eval _ = evalBool (Proxy @AllNegativeT)
+
+
+type Positive = Gt 0
+
+type Negative = Lt 0
+
+-- | 'unzip' equivalent
+--
+-- >>> pz @Unzip (zip [1..5] "abcd")
+-- PresentT ([1,2,3,4],"abcd")
+--
+data Unzip
+type UnzipT = '(Map (Fst Id) Id, Map (Snd Id) Id)
+
+instance P UnzipT x => P Unzip x where
+  type PP Unzip x = PP UnzipT x
+  eval _ = eval (Proxy @UnzipT)
+
+
+-- | 'unzip3' equivalent
+--
+-- >>> pz @Unzip3 (zip3 [1..5] "abcd" (cycle [True,False]))
+-- PresentT ([1,2,3,4],"abcd",[True,False,True,False])
+--
+data Unzip3
+type Unzip3T = '(Map (Fst Id) Id, Map (Snd Id) Id, Map (Thd Id) Id)
+
+instance P Unzip3T x => P Unzip3 x where
+  type PP Unzip3 x = PP Unzip3T x
+  eval _ = eval (Proxy @Unzip3T)
+
+
+-- | 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"
+-- TrueT
+--
+data Re' (rs :: [ROpt]) p q
+data 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
+
+type ReT p q = Re' '[] p q
+
+instance P (ReT p q) x => P (Re p q) x where
+  type PP (Re p q) x = PP (ReT p q) x
+  eval _ = evalBool (Proxy @(ReT p q))
+
+-- 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"
+-- PresentT [("13:05:25",["13","05","25"])]
+--
+-- >>> pz @(Rescan (Snd Id) "13:05:25") ('a',"^(\\d{2}):(\\d{2}):(\\d{2})$")
+-- PresentT [("13:05:25",["13","05","25"])]
+--
+data Rescan' (rs :: [ROpt]) 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 (oRecursion opts) $ 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]
+
+data Rescan p q
+type RescanT p q = Rescan' '[] p q
+
+instance P (RescanT p q) x => P (Rescan p q) x where
+  type PP (Rescan p q) x = PP (RescanT p q) x
+  eval _ = eval (Proxy @(RescanT p q))
+
+
+-- | 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"
+-- PresentT [((0,8),[(0,2),(3,5),(6,8)])]
+--
+data RescanRanges' (rs :: [ROpt]) 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 (oRecursion opts) $ 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
+
+data RescanRanges p q
+type RescanRangesT p q = RescanRanges' '[] p q
+
+instance P (RescanRangesT p q) x => P (RescanRanges p q) x where
+  type PP (RescanRanges p q) x = PP (RescanRangesT p q) x
+  eval _ = eval (Proxy @(RescanRangesT p q))
+
+-- | splits a string on a regex delimiter
+--
+-- >>> pz @(Resplit "\\." Id) "141.201.1.22"
+-- PresentT ["141","201","1","22"]
+--
+-- >>> pz @(Resplit (Singleton (Fst Id)) (Snd Id)) (':', "12:13:1")
+-- PresentT ["12","13","1"]
+--
+-- >>> pl @(Resplit' '[ 'Caseless ] "aBc" Id) "123AbC456abc"
+-- Present ["123","456",""] (Resplit (aBc) ["123","456",""] | 123AbC456abc)
+-- PresentT ["123","456",""]
+--
+data Resplit' (rs :: [ROpt]) 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 (oRecursion opts) $ 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
+
+data Resplit p q
+type ResplitT p q = Resplit' '[] p q
+
+instance P (ResplitT p q) x => P (Resplit p q) x where
+  type PP (Resplit p q) x = PP (ResplitT p q) x
+  eval _ = eval (Proxy @(ResplitT p q))
+
+-- | replaces regex \'s\' with a string \'s1\' inside the value
+--
+-- >>> pz @(ReplaceAllString 'ROverWrite "\\." ":" Id) "141.201.1.22"
+-- PresentT "141:201:1:22"
+--
+data ReplaceImpl (alle :: Bool) (rs :: [ROpt]) p q r
+
+instance (GetBool b
+        , GetROpts rs
+        , PP p x ~ String
+        , PP q x ~ RReplace
+        , 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
+                           RReplace o s ->
+                             let g fn = (if alle then RH.gsub else RH.sub) regex fn r
+                             in g (case o of
+                                  RPrepend -> (s <>)
+                                  ROverWrite -> const s
+                                  RAppend -> (<> s))
+                           RReplace1 s -> (if alle then RH.gsub else RH.sub) regex s r
+                           RReplace2 s -> (if alle then RH.gsub else RH.sub) regex s r
+                           RReplace3 s -> (if alle then RH.gsub else RH.sub) regex s r
+               in mkNode opts (PresentT ret) (msg1 <> showLit0 opts " " r <> showLit1 opts " | " ret) (hhs <> [hh rr])
+
+data ReplaceAll' (rs :: [ROpt]) p q r
+type ReplaceAllT' (rs :: [ROpt]) p q r = ReplaceImpl 'True rs p q r
+
+instance P (ReplaceAllT' rs p q r) x => P (ReplaceAll' rs p q r) x where
+  type PP (ReplaceAll' rs p q r) x = PP (ReplaceAllT' rs p q r) x
+  eval _ = eval (Proxy @(ReplaceAllT' rs p q r))
+
+data ReplaceAll p q r
+type ReplaceAllT p q r = ReplaceAll' '[] p q r
+
+instance P (ReplaceAllT p q r) x => P (ReplaceAll p q r) x where
+  type PP (ReplaceAll p q r) x = PP (ReplaceAllT p q r) x
+  eval _ = eval (Proxy @(ReplaceAllT p q r))
+
+data ReplaceOne' (rs :: [ROpt]) p q r
+type ReplaceOneT' (rs :: [ROpt]) p q r = ReplaceImpl 'False rs p q r
+
+instance P (ReplaceOneT' rs p q r) x => P (ReplaceOne' rs p q r) x where
+  type PP (ReplaceOne' rs p q r) x = PP (ReplaceOneT' rs p q r) x
+  eval _ = eval (Proxy @(ReplaceOneT' rs p q r))
+
+-- | replace first occurrence of string \'p\' with '\q'\ in \'r\'
+--
+-- >>> pl @(ReplaceOneString 'ROverWrite "abc" "def" Id) "123abc456abc"
+-- Present "123def456abc" (ReplaceOne' [] (abc) 123abc456abc | 123def456abc)
+-- PresentT "123def456abc"
+--
+-- >>> pz @(Rescan "^Date\\((\\d+[+-]\\d{4})\\)" Id >> Head Id >> Snd Id >> Id !! 0 >> ReplaceOneString 'RPrepend "\\d{3}[+-]" "." Id >> ParseTimeP ZonedTime "%s%Q%z" Id) "Date(1530144000123+0530)"
+-- PresentT 2018-06-28 05:30:00.123 +0530
+--
+-- >>> pz @(Rescan "^Date\\((\\d+[+-]\\d{4})\\)" Id >> Head Id >> Snd Id >> Id !! 0 >> ReplaceOneString 'RPrepend "\\d{3}[+-]" "." Id >> ParseTimeP ZonedTime "%s%Q%z" Id) "Date(1593460089052+0800)"
+-- PresentT 2020-06-30 03:48:09.052 +0800
+--
+-- >>> pz @(Rescan "^Date\\((\\d+)(\\d{3}[+-]\\d{4})\\)" Id >> Head Id >> Snd Id >> (Id !! 0 <> "." <> Id !! 1)  >> ParseTimeP ZonedTime "%s%Q%z" Id) "Date(1593460089052+0800)"
+-- PresentT 2020-06-30 03:48:09.052 +0800
+--
+data ReplaceOne p q r
+type ReplaceOneT p q r = ReplaceOne' '[] p q r
+
+instance P (ReplaceOneT p q r) x => P (ReplaceOne p q r) x where
+  type PP (ReplaceOne p q r) x = PP (ReplaceOneT p q r) x
+  eval _ = eval (Proxy @(ReplaceOneT p q r))
+
+-- | replace all occurrences of string \'p\' with '\q'\ in \'r\'
+--
+-- >>> pl @(ReplaceAllString 'ROverWrite "abc" "def" Id) "123abc456abc"
+-- Present "123def456def" (ReplaceAll' [] (abc) 123abc456abc | 123def456def)
+-- PresentT "123def456def"
+--
+-- >>> pl @(ReplaceAllString' '[] 'ROverWrite "abc" "def" Id) "123AbC456abc"
+-- Present "123AbC456def" (ReplaceAll' [] (abc) 123AbC456abc | 123AbC456def)
+-- PresentT "123AbC456def"
+--
+-- >>> pl @(ReplaceAllString' '[ 'Caseless ] 'ROverWrite "abc" "def" Id) "123AbC456abc"
+-- Present "123def456def" (ReplaceAll (abc) 123AbC456abc | 123def456def)
+-- PresentT "123def456def"
+--
+-- >>> pl @(ReplaceAllString 'RPrepend "abc" "def" Id) "123AbC456abc"
+-- Present "123AbC456defabc" (ReplaceAll' [] (abc) 123AbC456abc | 123AbC456defabc)
+-- PresentT "123AbC456defabc"
+--
+-- >>> pl @(ReplaceAllString 'ROverWrite "abc" "def" Id) "123AbC456abc"
+-- Present "123AbC456def" (ReplaceAll' [] (abc) 123AbC456abc | 123AbC456def)
+-- PresentT "123AbC456def"
+--
+-- >>> pl @(ReplaceAllString 'RAppend "abc" "def" Id) "123AbC456abc"
+-- Present "123AbC456abcdef" (ReplaceAll' [] (abc) 123AbC456abc | 123AbC456abcdef)
+-- PresentT "123AbC456abcdef"
+--
+data ReplaceAllString' (rs :: [ROpt]) (o :: ReplaceFnSub) p q r
+type ReplaceAllStringT' (rs :: [ROpt]) (o :: ReplaceFnSub) p q r = ReplaceAll' rs p (ReplaceFn o q) r
+
+instance P (ReplaceAllStringT' rs o p q r) x => P (ReplaceAllString' rs o p q r) x where
+  type PP (ReplaceAllString' rs o p q r) x = PP (ReplaceAllStringT' rs o p q r) x
+  eval _ = eval (Proxy @(ReplaceAllStringT' rs o p q r))
+
+data ReplaceAllString o p q r
+type ReplaceAllStringT o p q r = ReplaceAllString' '[] o p q r
+
+instance P (ReplaceAllStringT o p q r) x => P (ReplaceAllString o p q r) x where
+  type PP (ReplaceAllString o p q r) x = PP (ReplaceAllStringT o p q r) x
+  eval _ = eval (Proxy @(ReplaceAllStringT o p q r))
+
+data ReplaceOneString' (rs :: [ROpt]) (o :: ReplaceFnSub) p q r
+type ReplaceOneStringT' (rs :: [ROpt]) (o :: ReplaceFnSub) p q r = ReplaceOne' rs p (ReplaceFn o q) r
+
+instance P (ReplaceOneStringT' rs o p q r) x => P (ReplaceOneString' rs o p q r) x where
+  type PP (ReplaceOneString' rs o p q r) x = PP (ReplaceOneStringT' rs o p q r) x
+  eval _ = eval (Proxy @(ReplaceOneStringT' rs o p q r))
+
+data ReplaceOneString (o :: ReplaceFnSub) p q r
+type ReplaceOneStringT (o :: ReplaceFnSub) p q r = ReplaceOneString' '[] o p q r
+
+instance P (ReplaceOneStringT o p q r) x => P (ReplaceOneString o p q r) x where
+  type PP (ReplaceOneString o p q r) x = PP (ReplaceOneStringT o p q r) x
+  eval _ = eval (Proxy @(ReplaceOneStringT o p q r))
+
+-- | Simple replacement string: see 'ReplaceAllString' and 'ReplaceOneString'
+--
+data ReplaceFn (o :: ReplaceFnSub) p
+
+instance (ReplaceFnSubC r
+        , PP p x ~ String
+        , P p x) => P (ReplaceFn r p) x where
+  type PP (ReplaceFn r p) x = RReplace
+  eval _ opts x = do
+    let msg0 = "ReplaceFn"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = RReplace (getReplaceFnSub @r) 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 ReplaceFn1 p
+
+instance (PP p x ~ (String -> [String] -> String)
+        , P p x) => P (ReplaceFn1 p) x where
+  type PP (ReplaceFn1 p) x = RReplace
+  eval _ opts x = do
+    let msg0 = "ReplaceFn1 (String -> [String] -> String)"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right f -> mkNode opts (PresentT (RReplace1 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 "\\." (ReplaceFn2 (Fst Id)) (Snd Id)) (\x -> x <> ":" <> x, "141.201.1.22")
+-- PresentT "141.:.201.:.1.:.22"
+--
+data ReplaceFn2 p
+
+instance (PP p x ~ (String -> String)
+        , P p x) => P (ReplaceFn2 p) x where
+  type PP (ReplaceFn2 p) x = RReplace
+  eval _ opts x = do
+    let msg0 = "ReplaceFn2 (String -> String)"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right f -> mkNode opts (PresentT (RReplace2 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+)$" (ReplaceFn3 (Fst Id)) (Snd Id)) (\ys -> intercalate  " | " $ map (show . succ . readNote @Int "invalid int") ys, "141.201.1.22")
+-- PresentT "142 | 202 | 2 | 23"
+--
+data ReplaceFn3 p
+
+instance (PP p x ~ ([String] -> String)
+        , P p x) => P (ReplaceFn3 p) x where
+  type PP (ReplaceFn3 p) x = RReplace
+  eval _ opts x = do
+    let msg0 = "ReplaceFn3 ([String] -> String)"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right f -> mkNode opts (PresentT (RReplace3 f)) msg0 [hh pp]
+
+
+-- | a predicate for determining if a string 'Data.Text.IsText' belongs to the given character set
+--
+-- >>> pz @IsSpace '\t'
+-- TrueT
+--
+-- >>> pz @IsSpace ' '
+-- TrueT
+--
+-- >>> pz @IsSpace 'x'
+-- FalseT
+--
+-- >>> pz @IsLower 'a'
+-- TrueT
+--
+-- >>> pz @IsLower 'X'
+-- FalseT
+--
+-- >>> pz @IsHexDigit 'A'
+-- TrueT
+--
+-- >>> pz @IsHexDigit 'g'
+-- FalseT
+--
+data IsCharSet (cs :: CharSet)
+
+instance (x ~ Char, GetCharSet cs) => P (IsCharSet cs) x where
+  type PP (IsCharSet cs) x = Bool
+  eval _ opts c =
+    let msg0 = "Is" ++ drop 1 (show cs)
+        (cs,f) = getCharSet @cs
+        b = f c
+    in pure $ mkNodeB opts b (msg0 <> show1 opts " | " [c]) []
+
+-- | predicate for determining if a character is lowercase
+--
+-- >>> pz @IsLower '1'
+-- FalseT
+--
+-- >>> pz @IsLower 'a'
+-- TrueT
+--
+-- >>> pz @(Map '(IsControl, IsLatin1, IsHexDigit, IsOctDigit, IsDigit, IsPunctuation, IsSeparator, IsSpace) Id) "abc134"
+-- PresentT [(False,True,True,False,False,False,False,False),(False,True,True,False,False,False,False,False),(False,True,True,False,False,False,False,False),(False,True,True,True,True,False,False,False),(False,True,True,True,True,False,False,False),(False,True,True,True,True,False,False,False)]
+--
+data IsLower
+type IsLowerT = IsCharSet 'CLower
+
+instance P IsLowerT x => P IsLower x where
+  type PP IsLower x = PP IsLowerT x
+  eval _ = evalBool (Proxy @IsLowerT)
+
+data IsUpper
+type IsUpperT = IsCharSet 'CUpper
+
+instance P IsUpperT x => P IsUpper x where
+  type PP IsUpper x = PP IsUpperT x
+  eval _ = evalBool (Proxy @IsUpperT)
+
+-- | predicate for determining if the character is a digit
+--
+-- >>> pz @IsDigit 'g'
+-- FalseT
+--
+-- >>> pz @IsDigit '9'
+-- TrueT
+--
+data IsDigit
+type IsDigitT = IsCharSet 'CNumber
+instance P IsDigitT x => P IsDigit x where
+  type PP IsDigit x = Bool
+  eval _ = evalBool (Proxy @IsDigitT)
+
+data IsSpace
+type IsSpaceT = IsCharSet 'CSpace
+instance P IsSpaceT x => P IsSpace x where
+  type PP IsSpace x = Bool
+  eval _ = evalBool (Proxy @IsSpaceT)
+
+data IsPunctuation
+type IsPunctuationT = IsCharSet 'CPunctuation
+instance P IsPunctuationT x => P IsPunctuation x where
+  type PP IsPunctuation x = Bool
+  eval _ = evalBool (Proxy @IsPunctuationT)
+
+data IsControl
+type IsControlT = IsCharSet 'CControl
+instance P IsControlT x => P IsControl x where
+  type PP IsControl x = Bool
+  eval _ = evalBool (Proxy @IsControlT)
+
+data IsHexDigit
+type IsHexDigitT = IsCharSet 'CHexDigit
+instance P IsHexDigitT x => P IsHexDigit x where
+  type PP IsHexDigit x = Bool
+  eval _ = evalBool (Proxy @IsHexDigitT)
+
+data IsOctDigit
+type IsOctDigitT = IsCharSet 'COctDigit
+instance P IsOctDigitT x => P IsOctDigit x where
+  type PP IsOctDigit x = Bool
+  eval _ = evalBool (Proxy @IsOctDigitT)
+
+data IsSeparator
+type IsSeparatorT = IsCharSet 'CSeparator
+instance P IsSeparatorT x => P IsSeparator x where
+  type PP IsSeparator x = Bool
+  eval _ = evalBool (Proxy @IsSeparatorT)
+
+data IsLatin1
+type IsLatin1T = IsCharSet 'CLatin1
+instance P IsLatin1T x => P IsLatin1 x where
+  type PP IsLatin1 x = Bool
+  eval _ = evalBool (Proxy @IsLatin1T)
+
+
+
+-- | a predicate for determining if a string 'Data.Text.IsText' belongs to the given character set
+--
+-- >>> pz @IsLowerAll "abc"
+-- TrueT
+--
+-- >>> pz @IsLowerAll "abcX"
+-- FalseT
+--
+-- >>> pz @IsLowerAll (T.pack "abcX")
+-- FalseT
+--
+-- >>> pz @IsHexDigitAll "01efA"
+-- TrueT
+--
+-- >>> pz @IsHexDigitAll "01egfA"
+-- FalseT
+--
+-- | predicate for determining if a string is all lowercase
+--
+-- >>> pz @IsLowerAll "abcdef213"
+-- FalseT
+--
+-- >>> pz @IsLowerAll "abcdef"
+-- TrueT
+--
+-- >>> pz @IsLowerAll ""
+-- TrueT
+--
+-- >>> pz @IsLowerAll "abcdefG"
+-- FalseT
+--
+-- >>> pl @(Just Uncons >> IsUpper &* IsLowerAll) "AbcdE"
+-- False ((>>) False | {True (&*) False | (IsLowerAll | "bcdE")})
+-- FalseT
+--
+-- >>> pl @(Just Uncons >> IsUpper &* IsLowerAll) "Abcde"
+-- True ((>>) True | {True (&*) True})
+-- TrueT
+--
+-- >>> pl @(Just Uncons >> IsUpper &* IsLowerAll) "xbcde"
+-- False ((>>) False | {False (&*) True | (IsUpper | "x")})
+-- FalseT
+--
+-- >>> pl @(Just Uncons >> IsUpper &* IsLowerAll) "X"
+-- True ((>>) True | {True (&*) True})
+-- TrueT
+--
+-- >>> pz @( '(IsControlAll, IsLatin1All , IsHexDigitAll , IsOctDigitAll , IsDigitAll , IsPunctuationAll , IsSeparatorAll , IsSpaceAll ) ) "abc134"
+-- PresentT (False,True,True,False,False,False,False,False)
+--
+-- >>> pl @(SplitAts [1,2,10] Id >> Para '[IsLowerAll, IsDigitAll, IsUpperAll ]) "abdefghi"
+-- Present [True,False,False] ((>>) [True,False,False] | {Para(0) [True,False,False] | ["a","bd","efghi"]})
+-- PresentT [True,False,False]
+--
+-- >>> pl @(SplitAts [1,2,10] Id >> BoolsQuick "" '[IsLowerAll, IsDigitAll, IsUpperAll ]) "a98efghi"
+-- False ((>>) False | {Bool(2) [] (IsUpperAll | "efghi")})
+-- FalseT
+--
+-- >>> pl @(SplitAts [1,2,10] Id >> BoolsQuick "" '[IsLowerAll, IsDigitAll, IsUpperAll || IsLowerAll ]) "a98efghi"
+-- True ((>>) True | {Bools})
+-- TrueT
+--
+-- >>> pl @(SplitAts [1,2,10] Id >> BoolsQuick "" '[IsLowerAll, IsDigitAll, IsUpperAll || IsLowerAll ]) "a98efgHi"
+-- False ((>>) False | {Bool(2) [] (False || False | (IsUpperAll | "efgHi") || (IsLowerAll | "efgHi"))})
+-- FalseT
+--
+data IsCharSetAll (cs :: CharSet)
+
+instance (GetCharSet cs
+        , Show a
+        , DTL.IsText a
+        ) => P (IsCharSetAll cs) a where
+  type PP (IsCharSetAll cs) a = Bool
+  eval _ opts as =
+    let b = allOf DTL.text f as
+        msg0 = "Is" ++ drop 1 (show cs) ++ "All"
+        (cs,f) = getCharSet @cs
+    in pure $ mkNodeB opts b (msg0 <> show1 opts " | " as) []
+
+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 'CSpace where
+  getCharSet = (CSpace, isSpace)
+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)
+
+data IsLowerAll
+type IsLowerAllT = IsCharSetAll 'CLower
+
+instance P IsLowerAllT x => P IsLowerAll x where
+  type PP IsLowerAll x = PP IsLowerAllT x
+  eval _ = evalBool (Proxy @IsLowerAllT)
+
+data IsUpperAll
+type IsUpperAllT = IsCharSetAll 'CUpper
+
+instance P IsUpperAllT x => P IsUpperAll x where
+  type PP IsUpperAll x = PP IsUpperAllT x
+  eval _ = evalBool (Proxy @IsUpperAllT)
+
+-- | predicate for determining if the string is all digits
+--
+-- >>> pz @IsDigitAll "213G"
+-- FalseT
+--
+-- >>> pz @IsDigitAll "929"
+-- TrueT
+--
+data IsDigitAll
+type IsDigitAllT = IsCharSetAll 'CNumber
+instance P IsDigitAllT x => P IsDigitAll x where
+  type PP IsDigitAll x = Bool
+  eval _ = evalBool (Proxy @IsDigitAllT)
+
+-- | predicate for determining if the string is all spaces
+--
+-- >>> pz @IsSpaceAll "213G"
+-- FalseT
+--
+-- >>> pz @IsSpaceAll "    "
+-- TrueT
+--
+-- >>> pz @IsSpaceAll ""
+-- TrueT
+--
+data IsSpaceAll
+type IsSpaceAllT = IsCharSetAll 'CSpace
+instance P IsSpaceAllT x => P IsSpaceAll x where
+  type PP IsSpaceAll x = Bool
+  eval _ = evalBool (Proxy @IsSpaceAllT)
+
+data IsPunctuationAll
+type IsPunctuationAllT = IsCharSetAll 'CPunctuation
+instance P IsPunctuationAllT x => P IsPunctuationAll x where
+  type PP IsPunctuationAll x = Bool
+  eval _ = evalBool (Proxy @IsPunctuationAllT)
+
+data IsControlAll
+type IsControlAllT = IsCharSetAll 'CControl
+instance P IsControlAllT x => P IsControlAll x where
+  type PP IsControlAll x = Bool
+  eval _ = evalBool (Proxy @IsControlAllT)
+
+data IsHexDigitAll
+type IsHexDigitAllT = IsCharSetAll 'CHexDigit
+instance P IsHexDigitAllT x => P IsHexDigitAll x where
+  type PP IsHexDigitAll x = Bool
+  eval _ = evalBool (Proxy @IsHexDigitAllT)
+
+data IsOctDigitAll
+type IsOctDigitAllT = IsCharSetAll 'COctDigit
+instance P IsOctDigitAllT x => P IsOctDigitAll x where
+  type PP IsOctDigitAll x = Bool
+  eval _ = evalBool (Proxy @IsOctDigitAllT)
+
+data IsSeparatorAll
+type IsSeparatorAllT = IsCharSetAll 'CSeparator
+instance P IsSeparatorAllT x => P IsSeparatorAll x where
+  type PP IsSeparatorAll x = Bool
+  eval _ = evalBool (Proxy @IsSeparatorAllT)
+
+data IsLatin1All
+type IsLatin1AllT = IsCharSetAll 'CLatin1
+instance P IsLatin1AllT x => P IsLatin1All x where
+  type PP IsLatin1All x = Bool
+  eval _ = evalBool (Proxy @IsLatin1AllT)
+
+
+-- | converts a string 'Data.Text.Lens.IsText' value to lower case
+--
+-- >>> pz @ToLower "HeLlO wOrld!"
+-- PresentT "hello world!"
+--
+data ToLower
+
+instance (Show a, DTL.IsText a) => P ToLower a where
+  type PP ToLower a = a
+  eval _ opts as =
+    let msg0 = "ToLower"
+        xs = as & DTL.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!"
+-- PresentT "HELLO WORLD!"
+--
+data ToUpper
+
+instance (Show a, DTL.IsText a) => P ToUpper a where
+  type PP ToUpper a = a
+  eval _ opts as =
+    let msg0 = "ToUpper"
+        xs = as & DTL.text %~ toUpper
+    in pure $ mkNode opts (PresentT xs) (show01 opts msg0 xs as) []
+
+
+-- | converts a string 'Data.Text.Lens.IsText' value to title case
+--
+-- >>> pz @ToTitle "HeLlO wOrld!"
+-- PresentT "Hello world!"
+--
+-- >>> data Color = Red | White | Blue | Green | Black deriving (Show,Eq,Enum,Bounded,Read)
+-- >>> pz @(ToTitle >> ReadP Color Id) "red"
+-- PresentT Red
+--
+data ToTitle
+
+instance (Show a, DTL.IsText a) => P ToTitle a where
+  type PP ToTitle a = a
+  eval _ opts as =
+    let msg0 = "ToTitle"
+        xs = toTitleAll (as ^. DTL.unpacked) ^. DTL.packed
+    in pure $ mkNode opts (PresentT xs) (show01 opts msg0 xs as) []
+
+
+toTitleAll :: String -> String
+toTitleAll (x:xs) = toUpper x : map toLower xs
+toTitleAll [] = []
+
+
+-- | similar to 'Data.List.inits'
+--
+-- >>> pz @Inits [4,8,3,9]
+-- PresentT [[],[4],[4,8],[4,8,3],[4,8,3,9]]
+--
+-- >>> pz @Inits []
+-- PresentT [[]]
+--
+data Inits
+
+instance ([a] ~ x, Show a) => P Inits x where
+  type PP Inits x = [x]
+  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]
+-- PresentT [[4,8,3,9],[8,3,9],[3,9],[9],[]]
+--
+-- >>> pz @Tails []
+-- PresentT [[]]
+--
+data Tails
+
+instance ([a] ~ x, Show a) => P Tails x where
+  type PP Tails x = [x]
+  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]
+-- PresentT [[4],[8],[3],[9]]
+--
+-- >>> pz @(Ones Id) []
+-- 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 ->
+        case chkSize opts msg0 p [hh pp] of
+          Left e -> e
+          Right () ->
+            let d = map pure p
+            in mkNode opts (PresentT d) (show01 opts msg0 d p) [hh pp]
+
+-- | similar to 'show'
+--
+-- >>> pz @(ShowP Id) [4,8,3,9]
+-- PresentT "[4,8,3,9]"
+--
+-- >>> pz @(ShowP Id) 'x'
+-- PresentT "'x'"
+--
+-- >>> pz @(ShowP (42 -% 10)) 'x'
+-- 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) (readNote @LocalTime "invalid localtime" "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", readNote @Day "invalid day" "2019-05-24")
+-- 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"
+-- PresentT 2019-05-24 05:19:59
+--
+-- >>> pz @(ParseTimeP LocalTime "%F %T" "2019-05-24 05:19:59") (Right "never used")
+-- PresentT 2019-05-24 05:19:59
+--
+-- keeping \'q\' as we might want to extract from a tuple
+data ParseTimeP' 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
+
+data ParseTimeP (t :: Type) p q
+type ParseTimePT (t :: Type) p q = ParseTimeP' (Hole t) p q
+
+instance P (ParseTimePT t p q) x => P (ParseTimeP t p q) x where
+  type PP (ParseTimeP t p q) x = PP (ParseTimePT t p q) x
+  eval _ = eval (Proxy @(ParseTimePT t p q))
+
+-- | 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") ()
+-- 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")
+-- PresentT 2019-03-11 01:22:33
+--
+data ParseTimes' 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
+
+data ParseTimes (t :: Type) p q
+type ParseTimesT (t :: Type) p q = ParseTimes' (Hole t) p q
+
+instance P (ParseTimesT t p q) x => P (ParseTimes t p q) x where
+  type PP (ParseTimes t p q) x = PP (ParseTimesT t p q) x
+  eval _ = eval (Proxy @(ParseTimesT t p q))
+
+-- | create a 'Day' from three int values passed in as year month and day
+--
+-- >>> pz @(MkDay '(1,2,3) >> Just Id) ()
+-- PresentT 0001-02-03
+--
+-- >>> pz @(Just (MkDay '(1,2,3))) 1
+-- PresentT 0001-02-03
+--
+-- >>> pz @(MkDay Id) (2019,12,30)
+-- PresentT (Just 2019-12-30)
+--
+-- >>> pz @(MkDay' (Fst Id) (Snd Id) (Thd Id)) (2019,99,99999)
+-- PresentT Nothing
+--
+-- >>> pz @(MkDay Id) (1999,3,13)
+-- PresentT (Just 1999-03-13)
+--
+data MkDay' p q r
+
+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
+  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
+            in mkNode opts (PresentT mday) (show01' opts msg0 mday "(y,m,d)=" (p,q,r)) (hhs <> [hh rr])
+
+data MkDay p
+type MkDayT p = MkDay' (Fst p) (Snd p) (Thd p)
+
+instance P (MkDayT p) x => P (MkDay p) x where
+  type PP (MkDay p) x = PP (MkDayT p) x
+  eval _ = eval (Proxy @(MkDayT p))
+
+-- | uncreate a 'Day' returning year month and day
+--
+-- >>> pz @(UnMkDay Id) (readNote "invalid day" "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) [hh pp]
+
+
+-- | create a 'Day' + Week + Day of Week from three int values passed in as year month and day
+--
+-- >>> pz @(MkDayExtra '(1,2,3) >> Just Id >> Fst Id) ()
+-- PresentT 0001-02-03
+--
+-- >>> pz @(Fst (Just (MkDayExtra '(1,2,3)))) 1
+-- PresentT 0001-02-03
+--
+-- >>> pz @(MkDayExtra Id) (2019,12,30)
+-- PresentT (Just (2019-12-30,1,1))
+--
+-- >>> pz @(MkDayExtra' (Fst Id) (Snd Id) (Thd Id)) (2019,99,99999)
+-- PresentT Nothing
+--
+-- >>> pz @(MkDayExtra Id) (1999,3,13)
+-- PresentT (Just (1999-03-13,10,6))
+--
+data MkDayExtra' p q r
+
+instance (P p x
+        , P q x
+        , P r x
+        , PP p x ~ Int
+        , PP q x ~ Int
+        , PP r x ~ Int
+        ) => P (MkDayExtra' p q r) x where
+  type PP (MkDayExtra' p q r) x = Maybe (Day, Int, Int)
+  eval _ opts x = do
+    let msg0 = "MkDayExtra"
+    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])
+
+data MkDayExtra p
+type MkDayExtraT p = MkDayExtra' (Fst p) (Snd p) (Thd p)
+
+instance P (MkDayExtraT p) x => P (MkDayExtra p) x where
+  type PP (MkDayExtra p) x = PP (MkDayExtraT p) x
+  eval _ = eval (Proxy @(MkDayExtraT p))
+
+class ToDayC a where
+  getDay :: a -> Day
+instance ToDayC UTCTime where
+  getDay = utctDay
+instance ToDayC ZonedTime where
+  getDay = getDay . zonedTimeToLocalTime
+instance ToDayC LocalTime where
+  getDay = localDay
+instance ToDayC Day where
+  getDay = id
+instance ToDayC Rational where
+  getDay = getDay . P.posixSecondsToUTCTime . fromRational
+instance ToDayC CP.SystemTime where
+  getDay = getDay . CP.systemToUTCTime
+
+class ToTimeC a where
+  getTime :: a -> TimeOfDay
+instance ToTimeC UTCTime where
+  getTime = getTime . utctDayTime
+instance ToTimeC ZonedTime where
+  getTime = getTime . zonedTimeToLocalTime
+instance ToTimeC LocalTime where
+  getTime = localTimeOfDay
+instance ToTimeC TimeOfDay where
+  getTime = id
+instance ToTimeC DiffTime where
+  getTime = timeToTimeOfDay
+instance ToTimeC Rational where
+  getTime = getTime . P.posixSecondsToUTCTime . fromRational
+instance ToTimeC CP.SystemTime where
+  getTime = getTime . CP.systemToUTCTime
+
+-- | extract 'Day' from a DateTime
+--
+-- >>> pz @(ReadP UTCTime Id >> ToDay Id) "2020-07-06 12:11:13Z"
+-- PresentT 2020-07-06
+--
+data ToDay p
+
+instance (P p x, Show (PP p x), ToDayC (PP p x)) => P (ToDay p) x where
+  type PP (ToDay p) x = Day
+  eval _ opts x = do
+    let msg0 = "ToDay"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let ret = getDay p
+        in mkNode opts (PresentT ret) (show01 opts msg0 ret p) [hh pp]
+
+-- | extract 'TimeOfDay' from DateTime
+--
+-- >>> pz @(ReadP UTCTime Id >> ToDay Id) "2020-07-06 12:11:13Z"
+-- PresentT 2020-07-06
+--
+data ToTime p
+
+instance ( P p x
+         , Show (PP p x)
+         , ToTimeC (PP p x)
+         ) => P (ToTime p) x where
+  type PP (ToTime p) x = TimeOfDay
+  eval _ opts x = do
+    let msg0 = "ToTime"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let ret = getTime p
+        in mkNode opts (PresentT ret) (show01 opts msg0 ret p) [hh pp]
+
+
+-- | create a 'Time' from three int values passed in as year month and day
+--
+-- >>> pz @(MkTime '(1,2,3 % 12345)) ()
+-- PresentT 01:02:00.000243013365
+--
+-- >>> pz @(MkTime Id) (12,13,65)
+-- PresentT 12:13:65
+--
+-- >>> pz @(MkTime' (Fst Id) (Snd Id) (Thd Id)) (13,99,99999)
+-- PresentT 13:99:99999
+--
+-- >>> pz @(MkTime Id) (17,3,13)
+-- PresentT 17:03:13
+--
+data MkTime' p q r
+
+instance (P p x
+        , P q x
+        , P r x
+        , PP p x ~ Int
+        , PP q x ~ Int
+        , PP r x ~ Rational
+        ) => P (MkTime' p q r) x where
+  type PP (MkTime' p q r) x = TimeOfDay
+  eval _ opts x = do
+    let msg0 = "MkTime"
+    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 mtime = TimeOfDay p q (fromRational r)
+            in mkNode opts (PresentT mtime) (show01' opts msg0 mtime "(h,m,s)=" (p,q,r)) (hhs <> [hh rr])
+
+data MkTime p
+type MkTimeT p = MkTime' (Fst p) (Snd p) (Thd p)
+
+instance P (MkTimeT p) x => P (MkTime p) x where
+  type PP (MkTime p) x = PP (MkTimeT p) x
+  eval _ = eval (Proxy @(MkTimeT p))
+
+
+-- | uncreate a 'TimeOfDay' returning hour minute seconds picoseconds
+--
+-- >>> pz @(ReadP UTCTime "2019-01-01 12:13:14.1234Z" >> ToTime Id >> UnMkTime Id) ()
+-- PresentT (12,13,70617 % 5000)
+--
+data UnMkTime p
+
+instance (PP p x ~ TimeOfDay, P p x) => P (UnMkTime p) x where
+  type PP (UnMkTime p) x = (Int, Int, Rational)
+  eval _ opts x = do
+    let msg0 = "UnMkTime"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let TimeOfDay h m s = p
+            b = (h, m, toRational s)
+        in mkNode opts (PresentT b) (show01 opts msg0 b p) [hh pp]
+
+
+-- microsoft json date is x*1000 ie milliseconds
+
+-- | convert posix time (seconds since 01-01-1970) to 'UTCTime'
+--
+-- >>> pl @(PosixToUTCTime Id) 1593384312
+-- Present 2020-06-28 22:45:12 UTC (PosixToUTCTime 2020-06-28 22:45:12 UTC | 1593384312 % 1)
+-- PresentT 2020-06-28 22:45:12 UTC
+--
+-- >>> pl @(PosixToUTCTime Id >> UTCTimeToPosix Id) 1593384312
+-- Present 1593384312 % 1 ((>>) 1593384312 % 1 | {UTCTimeToPosix 1593384312 % 1 | 2020-06-28 22:45:12 UTC})
+-- PresentT (1593384312 % 1)
+--
+-- >>> pl @(PosixToUTCTime (Id % 1000)) 1593384312000
+-- Present 2020-06-28 22:45:12 UTC (PosixToUTCTime 2020-06-28 22:45:12 UTC | 1593384312 % 1)
+-- PresentT 2020-06-28 22:45:12 UTC
+--
+-- >>> pl @(PosixToUTCTime Id) (3600*4+60*7+12)
+-- Present 1970-01-01 04:07:12 UTC (PosixToUTCTime 1970-01-01 04:07:12 UTC | 14832 % 1)
+-- PresentT 1970-01-01 04:07:12 UTC
+--
+-- >>> pz @(Rescan "^Date\\((\\d+)([^\\)]+)\\)" Id >> Head Id >> Snd Id >> ReadP Integer (Id !! 0) >> PosixToUTCTime (Id % 1000)) "Date(1530144000000+0530)"
+-- PresentT 2018-06-28 00:00:00 UTC
+--
+data PosixToUTCTime p
+
+instance (PP p x ~ Rational, P p x) => P (PosixToUTCTime p) x where
+  type PP (PosixToUTCTime p) x = UTCTime
+  eval _ opts x = do
+    let msg0 = "PosixToUTCTime"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = P.posixSecondsToUTCTime (fromRational p)
+        in mkNode opts (PresentT d) (show01 opts msg0 d p) [hh pp]
+
+-- | convert 'UTCTime' to posix time (seconds since 01-01-1970)
+--
+-- >>> pl @(ReadP UTCTime Id >> UTCTimeToPosix Id) "2020-06-28 22:45:12 UTC"
+-- Present 1593384312 % 1 ((>>) 1593384312 % 1 | {UTCTimeToPosix 1593384312 % 1 | 2020-06-28 22:45:12 UTC})
+-- PresentT (1593384312 % 1)
+--
+-- >>> pz @(Rescan "^Date\\((\\d+)([^\\)]+)\\)" Id >> Head Id >> Snd Id >> ((ReadP Integer (Id !! 0) >> PosixToUTCTime (Id % 1000)) &&& ReadP TimeZone (Id !! 1))) "Date(1530144000000+0530)"
+-- PresentT (2018-06-28 00:00:00 UTC,+0530)
+--
+-- not so uesful: just use ParseTimeP FormatTimeP with %s %q %z etc
+
+-- >>> pz @(ParseTimeP ZonedTime "%s%Q%z" Id)  "153014400.000+0530"
+-- PresentT 1974-11-07 05:30:00 +0530
+--
+data UTCTimeToPosix p
+
+instance (PP p x ~ UTCTime, P p x) => P (UTCTimeToPosix p) x where
+  type PP (UTCTimeToPosix p) x = Rational
+  eval _ opts x = do
+    let msg0 = "UTCTimeToPosix"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = toRational $ P.utcTimeToPOSIXSeconds p
+        in mkNode opts (PresentT d) (show01 opts msg0 d p) [hh pp]
+
+-- | uses the 'Read' of the given type \'t\' and \'p\' which points to the content to read
+--
+-- >>> pz @(ReadP Rational Id) "4 % 5"
+-- PresentT (4 % 5)
+--
+-- >>> pz @(Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30") (ReadP Day Id)) "2018-10-12"
+-- TrueT
+--
+-- >>> pz @(Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30") (ReadP Day Id)) "2016-10-12"
+-- FalseT
+--
+data ReadP' 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 hhs = [hh pp]
+        in case reads @(PP t x) s of
+           [(b,"")] -> mkNode opts (PresentT b) (msg0 <> " " ++ show b) hhs
+           o -> mkNode opts (FailT (msg0 <> " (" ++ s ++ ")")) (msg0 <> " failed " <> show o <> " | s=" ++ s) hhs
+
+data ReadP (t :: Type) p
+type ReadPT (t :: Type) p = ReadP' (Hole t) p
+
+instance P (ReadPT t p) x => P (ReadP t p) x where
+  type PP (ReadP t p) x = PP (ReadPT t p) x
+  eval _ = eval (Proxy @(ReadPT t p))
+
+
+-- [] (a,s) (a,[])
+
+-- | Read but returns the Maybe of the value and any remaining unparsed string
+--
+-- >>> pz @(ReadMaybe Int Id) "123x"
+-- PresentT (Just (123,"x"))
+--
+-- >>> pz @(ReadMaybe Int Id) "123"
+-- PresentT (Just (123,""))
+--
+-- >>> pz @(ReadMaybe Int Id) "x123"
+-- PresentT Nothing
+--
+data ReadMaybe' 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
+
+data ReadMaybe (t :: Type) p
+type ReadMaybeT (t :: Type) p = ReadMaybe' (Hole t) p
+
+instance P (ReadMaybeT t p) x => P (ReadMaybe t p) x where
+  type PP (ReadMaybe t p) x = PP (ReadMaybeT t p) x
+  eval _ = eval (Proxy @(ReadMaybeT t p))
+
+-- | emulates ReadP
+data ReadQ' t p
+type ReadQT' t p = ReadMaybe' t p >> MaybeIn (Failp "read failed") (Guard "oops" (Snd Id >> Null) >> Fst Id)
+
+instance P (ReadQT' t p) x => P (ReadQ' t p) x where
+  type PP (ReadQ' t p) x = PP (ReadQT' t p) x
+  eval _ = eval (Proxy @(ReadQT' t p))
+
+data ReadQ (t :: Type) p
+type ReadQT (t :: Type) p = ReadQ' (Hole t) p
+
+instance P (ReadQT t p) x => P (ReadQ t p) x where
+  type PP (ReadQ t p) x = PP (ReadQT t p) x
+  eval _ = eval (Proxy @(ReadQT t p))
+
+-- | similar to 'sum'
+--
+-- >>> pz @Sum [10,4,5,12,3,4]
+-- PresentT 38
+--
+-- >>> pz @Sum []
+-- 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 'product'
+--
+-- >>> pz @Product [10,4,5,12,3,4]
+-- PresentT 28800
+--
+-- >>> pz @Product []
+-- PresentT 1
+--
+data Product
+
+instance (Num a, Show a) => P Product [a] where
+  type PP Product [a] = a
+  eval _ opts as =
+    let msg0 = "Product"
+        v = product as
+    in pure $ mkNode opts (PresentT v) (show01 opts msg0 v as) []
+
+-- | similar to 'minimum'
+--
+-- >>> pz @Min [10,4,5,12,3,4]
+-- PresentT 3
+--
+-- >>> pz @Min []
+-- 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]
+-- PresentT 12
+--
+-- >>> pz @Max []
+-- 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")]
+-- 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")]
+-- PresentT [(20,"bbb"),(10,"ab"),(4,"x")]
+--
+-- >>> pz @(SortBy 'LT Id) [1,5,2,4,7,0]
+-- PresentT [1,5,2,4,7,0]
+--
+-- >>> pz @(SortBy 'GT Id) [1,5,2,4,7,0]
+-- 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")]
+-- 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")]
+-- PresentT [(4,"y"),(4,"x"),(4,"a"),(10,"ab"),(20,"bbb")]
+--
+data SortBy p q
+
+type SortByHelperT 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") [hh qq]
+                [w] -> pure $ mkNode opts (PresentT [w]) (msg0 <> " one element " <> show w) [hh qq]
+                w:ys@(_:_) -> do
+                  pp <- (if isVerbose opts then
+                              eval (Proxy @(SortByHelperT p))
+                         else eval (Proxy @(Hide (SortByHelperT 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 [hh qq] of
+                    Left e -> pure e
+                    Right (ll', rr') -> do
+                      lhs <- ff (map snd ll')
+                      case getValueLR opts msg0 lhs [hh qq, hh pp] of
+                        Left _ -> pure lhs -- dont rewrap
+                        Right ll -> do
+                          rhs <- ff (map snd rr')
+                          case getValueLR opts msg0 rhs [hh qq, hh pp, hh lhs] of
+                            Left _ -> pure rhs
+                            Right rr ->
+                              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 else will double up messages: already handled
+          Right xs -> mkNode opts (_tBool ret) (msg0 <> show0 opts " " xs) [hh qq, hh ret]
+
+data SortOn p q
+type SortOnT p q = SortBy (OrdA p) q
+
+instance P (SortOnT p q) x => P (SortOn p q) x where
+  type PP (SortOn p q) x = PP (SortOnT p q) x
+  eval _ = eval (Proxy @(SortOnT p q))
+
+data SortOnDesc p q
+type SortOnDescT p q = SortBy (Swap >> OrdA p) q
+
+instance P (SortOnDescT p q) x => P (SortOnDesc p q) x where
+  type PP (SortOnDesc p q) x = PP (SortOnDescT p q) x
+  eval _ = eval (Proxy @(SortOnDescT p q))
+
+-- | similar to 'length'
+--
+-- >>> pz @Len [10,4,5,12,3,4]
+-- PresentT 6
+--
+-- >>> pz @Len []
+-- 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")
+-- PresentT 0
+--
+-- >>> pz @(Length Id) (Right "aa")
+-- PresentT 1
+--
+-- >>> pz @(Length (Right' Id)) (Right "abcd")
+-- PresentT 4
+--
+-- >>> pz @(Length (Thd (Snd Id))) (True,(23,'x',[10,9,1,3,4,2]))
+-- 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) [hh pp]
+
+-- | similar to 'fst'
+--
+-- >>> pz @(Fst Id) (10,"Abc")
+-- PresentT 10
+--
+-- >>> pz @(Fst Id) (10,"Abc",'x')
+-- PresentT 10
+--
+-- >>> pz @(Fst Id) (10,"Abc",'x',False)
+-- PresentT 10
+--
+data 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]
+
+data L1 p
+type L1T p = Fst p
+
+instance P (L1T p) x => P (L1 p) x where
+  type PP (L1 p) x = PP (L1T p) x
+  eval _ = eval (Proxy @(L1T p))
+
+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")
+-- PresentT "Abc"
+--
+-- >>> pz @(Snd Id) (10,"Abc",True)
+-- PresentT "Abc"
+--
+data 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]
+
+data L2 p
+type L2T p = Snd p
+
+instance P (L2T p) x => P (L2 p) x where
+  type PP (L2 p) x = PP (L2T p) x
+  eval _ = eval (Proxy @(L2T p))
+
+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)
+-- PresentT 133
+--
+-- >>> pz @(Thd Id) (10,"Abc",133,True)
+-- PresentT 133
+--
+data 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]
+
+data L3 p
+type L3T p = Thd p
+
+instance P (L3T p) x => P (L3 p) x where
+  type PP (L3 p) x = PP (L3T p) x
+  eval _ = eval (Proxy @(L3T p))
+
+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 _ = errorInProgram "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)
+-- PresentT True
+--
+-- >>> pz @(L4 (Fst (Snd Id))) ('x',((10,"Abc",'x',999),"aa",1),9)
+-- 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 _ = errorInProgram "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 _ = errorInProgram "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)
+-- 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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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)
+-- 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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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 _ = errorInProgram "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
+--
+-- >>> :set -XFlexibleContexts
+-- >>> pz @(FromString (Identity _) Id) "abc"
+-- PresentT (Identity "abc")
+--
+-- >>> pz @(FromString (Seq.Seq Char) Id) "abc"
+-- PresentT (fromList "abc")
+data FromString' t s
+
+instance (P s a
+        , PP s a ~ String
+        , Show (PP t a)
+        , IsString (PP t a)
+        ) => P (FromString' t s) a where
+  type PP (FromString' t s) a = PP t a
+  eval _ opts a = do
+    let msg0 = "FromString"
+    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]
+
+data FromString (t :: Type) p
+type FromStringPT (t :: Type) p = FromString' (Hole t) p
+
+instance P (FromStringPT t p) x => P (FromString t p) x where
+  type PP (FromString t p) x = PP (FromStringPT t p) x
+  eval _ = eval (Proxy @(FromStringPT t p))
+
+
+-- | 'fromInteger' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(FromInteger (SG.Sum _) Id) 23
+-- PresentT (Sum {getSum = 23})
+--
+-- >>> pz @(FromInteger Rational 44) 12
+-- PresentT (44 % 1)
+--
+-- >>> pz @(FromInteger Rational Id) 12
+-- PresentT (12 % 1)
+--
+data FromInteger' t 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]
+
+data FromInteger (t :: Type) p
+type FromIntegerT (t :: Type) p = FromInteger' (Hole t) p
+--type FromIntegerP n = FromInteger' Unproxy n
+
+instance P (FromIntegerT t p) x => P (FromInteger t p) x where
+  type PP (FromInteger t p) x = PP (FromIntegerT t p) x
+  eval _ = eval (Proxy @(FromIntegerT t p))
+
+-- | 'fromIntegral' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(FromIntegral (SG.Sum _) Id) 23
+-- PresentT (Sum {getSum = 23})
+data FromIntegral' t n
+
+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]
+
+data FromIntegral (t :: Type) p
+type FromIntegralT (t :: Type) p = FromIntegral' (Hole t) p
+
+instance P (FromIntegralT t p) x => P (FromIntegral t p) x where
+  type PP (FromIntegral t p) x = PP (FromIntegralT t p) x
+  eval _ = eval (Proxy @(FromIntegralT t p))
+
+-- | 'toRational' function
+--
+-- >>> pz @(ToRational Id) 23.5
+-- 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
+-- PresentT (47 % 2)
+data FromRational' t r
+
+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]
+
+data FromRational (t :: Type) p
+type FromRationalT (t :: Type) p = FromRational' (Hole t) p
+
+instance P (FromRationalT t p) x => P (FromRational t p) x where
+  type PP (FromRational t p) x = PP (FromRationalT t p) x
+  eval _ = eval (Proxy @(FromRationalT t p))
+
+-- | 'truncate' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(Truncate Int Id) (23 % 5)
+-- PresentT 4
+data Truncate' 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]
+
+data Truncate (t :: Type) p
+type TruncateT (t :: Type) p = Truncate' (Hole t) p
+
+instance P (TruncateT t p) x => P (Truncate t p) x where
+  type PP (Truncate t p) x = PP (TruncateT t p) x
+  eval _ = eval (Proxy @(TruncateT t p))
+
+-- | 'ceiling' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(Ceiling Int Id) (23 % 5)
+-- PresentT 5
+data Ceiling' 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]
+
+data Ceiling (t :: Type) p
+type CeilingT (t :: Type) p = Ceiling' (Hole t) p
+
+instance P (CeilingT t p) x => P (Ceiling t p) x where
+  type PP (Ceiling t p) x = PP (CeilingT t p) x
+  eval _ = eval (Proxy @(CeilingT t p))
+
+-- | 'floor' function where you need to provide the type \'t\' of the result
+--
+-- >>> pz @(Floor Int Id) (23 % 5)
+-- PresentT 4
+data Floor' 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]
+
+data Floor (t :: Type) p
+type FloorT (t :: Type) p = Floor' (Hole t) p
+
+instance P (FloorT t p) x => P (Floor t p) x where
+  type PP (Floor t p) x = PP (FloorT t p) x
+  eval _ = eval (Proxy @(FloorT t p))
+-- | converts a value to a 'Proxy': the same as '\'Proxy'
+--
+-- >>> pz @MkProxy 'x'
+-- 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) []
+
+-- | processes a type level list predicates running each in sequence: see 'Predicate.>>'
+--
+-- >>> pz @(Do [Pred Id, ShowP Id, Id &&& Len]) 9876543
+-- PresentT ("9876542",7)
+--
+-- >>> pz @(Do '[W 123, W "xyz", Len &&& Id, Pred Id *** Id<>Id]) ()
+-- 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))
+
+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)
+
+-- | 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
+-- PresentT (Just 24)
+--
+-- >>> pz @(MaybeBool (Id > 4) Id) (-5)
+-- 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))
+-- PresentT (Right 999)
+--
+-- >>> pz @(EitherBool (Fst Id > 4) (Fst (Snd Id)) (Snd (Snd Id))) (1,(-1,999))
+-- 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]
+-- PresentT [999,999,999,12,13]
+--
+-- >>> pz @(PadR 5 (Fst Id) '[12,13]) (999,'x')
+-- PresentT [12,13,999,999,999]
+--
+-- >>> pz @(PadR 2 (Fst Id) '[12,13,14]) (999,'x')
+-- PresentT [12,13,14]
+--
+data PadImpl (left :: Bool) 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 (PadImpl left n p q) a where
+  type PP (PadImpl left n p q) a = PP q a
+  eval _ opts a = do
+    let msg0 = "Pad" <> (if lft then "L" else "R")
+        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])
+
+data PadL n p q
+type PadLT n p q = PadImpl 'True n p q
+
+instance P (PadLT n p q) x => P (PadL n p q) x where
+  type PP (PadL n p q) x = PP (PadLT n p q) x
+  eval _ = eval (Proxy @(PadLT n p q))
+
+data PadR n p q
+type PadRT n p q = PadImpl 'False n p q
+
+instance P (PadRT n p q) x => P (PadR n p q) x where
+  type PP (PadR n p q) x = PP (PadRT n p q) x
+  eval _ = eval (Proxy @(PadRT n p q))
+
+-- | split a list \'p\' into parts using the lengths in the type level list \'ns\'
+--
+-- >>> pz @(SplitAts '[2,3,1,1] Id) "hello world"
+-- PresentT ["he","llo"," ","w","orld"]
+--
+-- >>> pz @(SplitAts '[2] Id) "hello world"
+-- PresentT ["he","llo world"]
+--
+-- >>> pz @(SplitAts '[10,1,1,5] Id) "hello world"
+-- 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) = splitAtNeg (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"
+-- PresentT ("hell","o world")
+--
+-- >>> pz @(SplitAt 20 Id) "hello world"
+-- PresentT ("hello world","")
+--
+-- >>> pz @(SplitAt 0 Id) "hello world"
+-- PresentT ("","hello world")
+--
+-- >>> pz @(SplitAt (Snd Id) (Fst Id)) ("hello world",4)
+-- PresentT ("hell","o world")
+--
+-- >>> pz @(SplitAt (Negate 2) Id) "hello world"
+-- PresentT ("hello wor","ld")
+--
+data 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
+            ret = splitAtNeg n p
+       in mkNode opts (PresentT ret) (show01' opts msg1 ret "n=" n <> show1 opts " | " p) [hh pp, hh qq]
+
+splitAtNeg :: Int -> [a] -> ([a], [a])
+splitAtNeg n as = splitAt (if n<0 then length as + n else n) as
+
+
+data Take n p
+type TakeT n p = Fst (SplitAt n p)
+
+instance P (TakeT n p) x => P (Take n p) x where
+  type PP (Take n p) x = PP (TakeT n p) x
+  eval _ = eval (Proxy @(TakeT n p))
+
+data Drop n p
+type DropT n p = Snd (SplitAt n p)
+
+instance P (DropT n p) x => P (Drop n p) x where
+  type PP (Drop n p) x = PP (DropT n p) x
+  eval _ = eval (Proxy @(DropT n p))
+
+--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.&&&'
+data p &&& q
+infixr 3 &&&
+type WAmpT p q = W '(p, q)
+
+instance P (WAmpT p q) x => P (p &&& q) x where
+  type PP (p &&& q) x = PP (WAmpT p q) x
+  eval _ = eval (Proxy @(WAmpT p q))
+
+-- | similar to 'Control.Arrow.***'
+--
+-- >>> pz @(Pred Id *** ShowP Id) (13, True)
+-- PresentT (12,"True")
+--
+-- >>> pl @(FlipT (***) Len (Id * 12)) (99,"cdef")
+-- Present (1188,4) ((***) (1188,4) | (99,"cdef"))
+-- PresentT (1188,4)
+--
+data p *** q
+infixr 3 ***
+
+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]
+
+data First p
+type FirstT p = p *** I
+
+instance P (FirstT p) x => P (First p) x where
+  type PP (First p) x = PP (FirstT p) x
+  eval _ = eval (Proxy @(FirstT p))
+
+data Second q
+type SecondT q = I *** q
+
+instance P (SecondT q) x => P (Second q) x where
+  type PP (Second q) x = PP (SecondT q) x
+  eval _ = eval (Proxy @(SecondT q))
+
+-- | similar 'Control.Arrow.|||'
+--
+-- >>> pz @(Pred Id ||| Id) (Left 13)
+-- PresentT 12
+--
+-- >>> pz @(ShowP Id ||| Id) (Right "hello")
+-- PresentT "hello"
+--
+data p ||| q
+infixr 2 |||
+type EitherIn p q = p ||| q
+
+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 to 'isLeft'
+--
+-- >>> pz @(IsLeft Id) (Right 123)
+-- FalseT
+--
+-- >>> pz @(IsLeft Id) (Left 'a')
+-- TrueT
+--
+data IsLeft p
+
+instance (P p x, PP p x ~ Either a b) => P (IsLeft p) x where
+  type PP (IsLeft p) x = Bool
+  eval _ opts x = do
+    let msg0 = "IsLeft"
+    pp <- eval (Proxy @p) opts x
+    let hhs = [hh pp]
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right (Left _) -> mkNodeB opts True msg0 hhs
+      Right (Right _) -> mkNodeB opts False msg0 hhs
+
+-- | similar to 'isRight'
+--
+-- >>> pz @(IsRight Id) (Right 123)
+-- TrueT
+--
+-- >>> pz @(IsRight Id) (Left "aa")
+-- FalseT
+--
+
+data IsRight p
+
+instance (P p x, PP p x ~ Either a b) => P (IsRight p) x where
+  type PP (IsRight p) x = Bool
+  eval _ opts x = do
+    let msg0 = "IsRight"
+    pp <- eval (Proxy @p) opts x
+    let hhs = [hh pp]
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right (Left _) -> mkNodeB opts False msg0 hhs
+      Right (Right _) -> mkNodeB opts True msg0 hhs
+
+
+-- | similar 'Control.Arrow.+++'
+--
+-- >>> pz @(Pred Id +++ Id) (Left 13)
+-- PresentT (Left 12)
+--
+-- >>> pz @(ShowP Id +++ Reverse) (Right "hello")
+-- 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]
+
+data Dup
+type DupT = W '(Id, Id)
+
+instance Show x => P Dup x where
+  type PP Dup x = PP DupT x
+  eval _ = eval (Proxy @DupT)
+
+data BinOp = BMult | BSub | BAdd deriving (Show,Eq)
+
+data p + q
+infixl 6 +
+
+type AddT p q = Bin 'BAdd p q
+
+instance P (AddT p q) x => P (p + q) x where
+  type PP (p + q) x = PP (AddT p q) x
+  eval _ = eval (Proxy @(AddT p q))
+
+data p - q
+infixl 6 -
+
+type SubT p q = Bin 'BSub p q
+
+instance P (SubT p q) x => P (p - q) x where
+  type PP (p - q) x = PP (SubT p q) x
+  eval _ = eval (Proxy @(SubT p q))
+
+data p * q
+infixl 7 *
+
+type MultT p q = Bin 'BMult p q
+
+instance P (MultT p q) x => P (p * q) x where
+  type PP (p * q) x = PP (MultT p q) x
+  eval _ = eval (Proxy @(MultT p q))
+
+-- | similar to '(^)'
+--
+-- >>> pz @(Fst Id ^ Snd Id) (10,4)
+-- PresentT 10000
+--
+data p ^ q
+infixr 8 ^
+
+instance (P p a
+        , P q a
+        , Show (PP p a)
+        , Show (PP q a)
+        , Num (PP p a)
+        , Integral (PP q a)
+        ) => P (p ^ q) a where
+  type PP (p ^ q) a = PP p a
+  eval _ opts a = do
+    let msg0 = "Pow"
+    pp <- eval (Proxy @p) opts a
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right p -> do
+        qq <- eval (Proxy @q) opts a
+        pure $ case getValueLR opts msg0 qq [hh pp] of
+          Left e -> e
+          Right q ->
+                let hhs = [hh pp, hh qq]
+                in if q < 0 then mkNode opts (FailT (msg0 <> " negative exponent")) msg0 hhs
+                   else let d = p ^ q
+                        in mkNode opts (PresentT d) (show p <> " ^ " <> show q <> " = " <> show d) hhs
+
+-- | similar to '(**)'
+--
+-- >>> pz @(Fst Id ** Snd Id) (10,4)
+-- PresentT 10000.0
+--
+data p ** q
+infixr 8 **
+
+instance (PP p a ~ PP q a
+        , P p a
+        , P q a
+        , Show (PP p a)
+        , Floating (PP p a)
+        , Ord (PP q a)
+        ) => P (p ** q) a where
+  type PP (p ** q) a = PP p a
+  eval _ opts a = do
+    let msg0 = "Exp"
+    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 if q < 0 then mkNode opts (FailT (msg0 <> " negative exponent")) msg0 hhs
+            else if p == 0 && q == 0 then mkNode opts (FailT (msg0 <> " zero/zero")) msg0 hhs
+            else let d = p ** q
+                in mkNode opts (PresentT d) (show p <> " ** " <> show q <> " = " <> show d) hhs
+
+-- | similar to 'logBase'
+--
+-- >>> pz @(Fst Id `LogBase` Snd Id >> Truncate Int Id) (10,12345)
+-- PresentT 4
+--
+data LogBase p q
+instance (PP p a ~ PP q a
+        , P p a
+        , P q a
+        , Show (PP q a)
+        , Floating (PP q a)
+        , Ord (PP p a)
+        ) => P (LogBase p q) a where
+  type PP (LogBase p q) a = PP p a
+  eval _ opts a = do
+    let msg0 = "LogBase"
+    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 if p <= 0 then mkNode opts (FailT (msg0 <> " non-positive base")) (msg0 <> " non-positive base") hhs
+            else let d = logBase p q
+                 in mkNode opts (PresentT d) (msg0 <> " " <> show p <> " " <> show q <> " = " <> show d) hhs
+
+data p > q
+infix 4 >
+
+instance P (Cmp 'CGt p q) x => P (p > q) x where
+  type PP (p > q) x = Bool
+  eval _ = evalBool (Proxy @(Cmp 'CGt p q))
+
+data p >= q
+infix 4 >=
+
+instance P (Cmp 'CGe p q) x => P (p >= q) x where
+  type PP (p >= q) x = Bool
+  eval _ = evalBool (Proxy @(Cmp 'CGe p q))
+
+data p == q
+infix 4 ==
+
+instance P (Cmp 'CEq p q) x => P (p == q) x where
+  type PP (p == q) x = Bool
+  eval _ = evalBool (Proxy @(Cmp 'CEq p q))
+
+data p <= q
+infix 4 <=
+
+instance P (Cmp 'CLe p q) x => P (p <= q) x where
+  type PP (p <= q) x = Bool
+  eval _ = evalBool (Proxy @(Cmp 'CLe p q))
+
+data p < q
+infix 4 <
+
+instance P (Cmp 'CLt p q) x => P (p < q) x where
+  type PP (p < q) x = Bool
+  eval _ = evalBool (Proxy @(Cmp 'CLt p q))
+
+data p /= q
+infix 4 /=
+
+instance P (Cmp 'CNe p q) x => P (p /= q) x where
+  type PP (p /= q) x = Bool
+  eval _ = evalBool (Proxy @(Cmp 'CNe p q))
+
+--type p + q = Bin 'BAdd p q
+--type p - q = Bin 'BSub p q
+--type p * q = Bin 'BMult p q
+
+--type p > q = Cmp 'CGt p q
+--type p >= q = Cmp 'CGe p q
+--type p == q = Cmp 'CEq p q
+--type p /= q = Cmp 'CNe p q
+--type p <= q = Cmp 'CLe p q
+--type p < q = Cmp 'CLt p q
+
+type Gt n = I > n
+type Ge n = I >= n
+type Same n = I == n
+type Le n = I <= n
+type Lt n = I < n
+type Ne n = I /= n
+
+--type p >~ q = CmpI 'CGt p q
+--type p >=~ q = CmpI 'CGe p q
+--type p ==~ q = CmpI 'CEq p q
+--type p <=~ q = CmpI 'CLe p q
+--type p <~ q = CmpI 'CLt p q
+--type p /=~ q = CmpI 'CNe p q
+
+data p >~ q
+infix 4 >~
+
+instance P (CmpI 'CGt p q) x => P (p >~ q) x where
+  type PP (p >~ q) x = Bool
+  eval _ = evalBool (Proxy @(CmpI 'CGt p q))
+
+data p >=~ q
+infix 4 >=~
+
+instance P (CmpI 'CGe p q) x => P (p >=~ q) x where
+  type PP (p >=~ q) x = Bool
+  eval _ = evalBool (Proxy @(CmpI 'CGe p q))
+
+data p ==~ q
+infix 4 ==~
+
+instance P (CmpI 'CEq p q) x => P (p ==~ q) x where
+  type PP (p ==~ q) x = Bool
+  eval _ = evalBool (Proxy @(CmpI 'CEq p q))
+
+data p <=~ q
+infix 4 <=~
+
+instance P (CmpI 'CLe p q) x => P (p <=~ q) x where
+  type PP (p <=~ q) x = Bool
+  eval _ = evalBool (Proxy @(CmpI 'CLe p q))
+
+data p <~ q
+infix 4 <~
+
+instance P (CmpI 'CLt p q) x => P (p <~ q) x where
+  type PP (p <~ q) x = Bool
+  eval _ = evalBool (Proxy @(CmpI 'CLt p q))
+
+data p /=~ q
+infix 4 /=~
+
+instance P (CmpI 'CNe p q) x => P (p /=~ q) x where
+  type PP (p /=~ q) x = Bool
+  eval _ = evalBool (Proxy @(CmpI 'CNe p q))
+
+
+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)
+-- PresentT 65
+--
+-- >>> pz @(Fst Id + 4 * Length (Snd Id) - 4) (3,"hello")
+-- 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)
+-- PresentT 6.5
+--
+-- >>> pz @(ToRational 13 / Id) 0
+-- FailT "(/) zero denominator"
+--
+-- >>> pz @(12 % 7 / 14 % 5 + Id) 12.4
+-- 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)
+-- TrueT
+--
+-- >>> pz @(Id < 21 % 5) 4.5
+-- FalseT
+--
+-- >>> pz @(Fst Id % Snd Id) (13,2)
+-- PresentT (13 % 2)
+--
+-- >>> pz @(13 % Id) 0
+-- FailT "(%) zero denominator"
+--
+-- >>> pz @(4 % 3 + 5 % 7) "asfd"
+-- PresentT (43 % 21)
+--
+-- >>> pz @(4 -% 7 * 5 -% 3) "asfd"
+-- PresentT (20 % 21)
+--
+-- >>> pz @(Negate (14 % 3)) ()
+-- PresentT ((-14) % 3)
+--
+-- >>> pz @(14 % 3) ()
+-- PresentT (14 % 3)
+--
+-- >>> pz @(Negate (14 % 3) ==! FromIntegral _ (Negate 5)) ()
+-- PresentT GT
+--
+-- >>> pz @(14 -% 3 ==! 5 -% 1) "aa"
+-- PresentT GT
+--
+-- >>> pz @(Negate (14 % 3) ==! Negate 5 % 2) ()
+-- PresentT LT
+--
+-- >>> pz @(14 -% 3 * 5 -% 1) ()
+-- PresentT (70 % 3)
+--
+-- >>> pz @(14 % 3 ==! 5 % 1) ()
+-- PresentT LT
+--
+-- >>> pz @(15 % 3 / 4 % 2) ()
+-- PresentT (5 % 2)
+--
+data 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 = "(%)"
+    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]
+
+data p -% q -- = Negate (p % q)
+infixl 8 -%
+type NegateRatioT p q = Negate (p % q)
+
+instance P (NegateRatioT p q) x => P (p -% q) x where
+  type PP (p -% q) x = PP (NegateRatioT p q) x
+  eval _ = eval (Proxy @(NegateRatioT p q))
+
+
+-- | similar to 'negate'
+--
+-- >>> pz @(Negate Id) 14
+-- PresentT (-14)
+--
+-- >>> pz @(Negate (Fst Id * Snd Id)) (14,3)
+-- PresentT (-42)
+--
+-- >>> pz @(Negate (15 -% 4)) "abc"
+-- PresentT (15 % 4)
+--
+-- >>> pz @(Negate (15 % 3)) ()
+-- PresentT ((-5) % 1)
+--
+-- >>> pz @(Negate (Fst Id % Snd Id)) (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)
+-- PresentT 14
+--
+-- >>> pz @(Abs (Snd Id)) ("xx",14)
+-- PresentT 14
+--
+-- >>> pz @(Abs Id) 0
+-- PresentT 0
+--
+-- >>> pz @(Abs (Negate 44)) "aaa"
+-- 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)
+-- PresentT (-1)
+--
+-- >>> pz @(Signum Id) 14
+-- PresentT 1
+--
+-- >>> pz @(Signum Id) 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))
+-- 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)
+-- PresentT (Sum {getSum = -13})
+--
+-- >>> pz @(Wrap SG.Any (Ge 4)) 13
+-- PresentT (Any {getAny = True})
+--
+-- >>> pz @(Wrap (NonEmpty _) (Uncons >> 'Just Id)) "abcd"
+-- PresentT ('a' :| "bcd")
+--
+data Wrap' 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]
+
+data Wrap (t :: Type) p
+type WrapT (t :: Type) p = Wrap' (Hole t) p
+
+instance P (WrapT t p) x => P (Wrap t p) x where
+  type PP (Wrap t p) x = PP (WrapT t p) x
+  eval _ = eval (Proxy @(WrapT t p))
+-- | similar to 'coerce'
+--
+-- >>> pz @(Coerce (SG.Sum Integer)) (Identity (-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]
+-- PresentT [Sum {getSum = -13},Sum {getSum = 4},Sum {getSum = 99}]
+--
+-- >>> pz @(Coerce2 (SG.Sum Integer)) (Just (Identity (-13)))
+-- PresentT (Just (Sum {getSum = -13}))
+--
+-- >>> pz @(Coerce2 (SG.Sum Int)) (Nothing @(Identity Int))
+-- 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 @(MEmpty2 (SG.Product Int)) [Identity (-13), Identity 4, Identity 99]
+-- PresentT [Product {getProduct = 1},Product {getProduct = 1},Product {getProduct = 1}]
+--
+data MEmpty2' t
+
+instance (Show (f a)
+        , Show (f (PP t (f a)))
+        , Functor f
+        , Monoid (PP t (f a))
+        ) => P (MEmpty2' t) (f a) where
+  type PP (MEmpty2' t) (f a) = f (PP t (f a))
+  eval _ opts fa =
+    let msg0 = "MEmpty2"
+        b = mempty <$> fa
+    in pure $ mkNode opts (PresentT b) (show01 opts msg0 b fa) []
+
+data MEmpty2 (t :: Type)
+type MEmpty2T (t :: Type) = MEmpty2' (Hole t)
+
+instance P (MEmpty2T t) x => P (MEmpty2 t) x where
+  type PP (MEmpty2 t) x = PP (MEmpty2T t) x
+  eval _ = eval (Proxy @(MEmpty2T t))
+
+-- | lift pure over a Functor
+--
+-- >>> pz @(Pure2 (Either String)) [1,2,4]
+-- PresentT [Right 1,Right 2,Right 4]
+--
+data Pure2 (t :: Type -> Type)
+
+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]
+-- PresentT [4,2,1]
+--
+-- >>> pz @Reverse "AbcDeF"
+-- 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")
+-- PresentT "FeDcbA"
+--
+-- >>> pz @ReverseL ("AbcDeF" :: String)
+-- 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 'SwapC'
+--
+-- >>> pz @Swap (Left 123)
+-- PresentT (Right 123)
+--
+-- >>> pz @Swap (Right 123)
+-- PresentT (Left 123)
+--
+-- >>> pz @Swap (These 'x' 123)
+-- PresentT (These 123 'x')
+--
+-- >>> pz @Swap (This 'x')
+-- PresentT (That 'x')
+--
+-- >>> pz @Swap (That 123)
+-- PresentT (This 123)
+--
+-- >>> pz @Swap (123,'x')
+-- PresentT ('x',123)
+--
+-- >>> pz @Swap (Left "abc")
+-- PresentT (Right "abc")
+--
+-- >>> pz @Swap (Right 123)
+-- PresentT (Left 123)
+--
+data Swap
+
+class Bifunctor p => SwapC p where -- (p :: Type -> Type -> Type) where
+  swapC :: p a b -> p b a
+instance SwapC Either where
+  swapC (Left a) = Right a
+  swapC (Right a) = Left a
+instance SwapC These where
+  swapC (This a) = That a
+  swapC (That b) = This b
+  swapC (These a b) = These b a
+instance SwapC (,) where
+  swapC (a,b) = (b,a)
+
+instance (Show (p a b)
+        , SwapC p
+        , Show (p b a)
+        ) => P Swap (p a b) where
+  type PP Swap (p a b) = p b a
+  eval _ opts pabx =
+    let msg0 = "Swap"
+        d = swapC pabx
+    in pure $ mkNode opts (PresentT d) (show01 opts msg0 d pabx) []
+
+-- | assoc using 'AssocC'
+--
+-- >>> pz @Assoc (This (These 123 'x'))
+-- PresentT (These 123 (This 'x'))
+--
+-- >>> pz @Assoc ((99,'a'),True)
+-- PresentT (99,('a',True))
+--
+-- >>> pz @Assoc ((99,'a'),True)
+-- PresentT (99,('a',True))
+--
+-- >>> pz @Assoc (Right "Abc" :: Either (Either () ()) String)
+-- PresentT (Right (Right "Abc"))
+--
+-- >>> pz @Assoc (Left (Left 'x'))
+-- PresentT (Left 'x')
+--
+data Assoc
+
+class AssocC p where
+  assoc :: p (p a b) c -> p a (p b c)
+  unassoc :: p a (p b c) -> p (p a b) c
+instance AssocC Either where
+  assoc (Left (Left a)) = Left a
+  assoc (Left (Right b)) = Right (Left b)
+  assoc (Right b) = Right (Right b)
+  unassoc (Left a) = Left (Left a)
+  unassoc (Right (Left b)) = Left (Right b)
+  unassoc (Right (Right b)) = Right b
+instance AssocC These where
+  assoc (This (This a)) = This a
+  assoc (This (That b)) = That (This b)
+  assoc (That b) = That (That b)
+  assoc (These (This a) c) = These a (That c)
+  assoc (These (That b) c) = That (These b c)
+  assoc (These (These a b) c) = These a (These b c)
+  assoc (This (These a b)) = These a (This b)
+  unassoc (This a) = This (This a)
+  unassoc (That (This b)) = This (That b)
+  unassoc (That (That b)) = That b
+  unassoc (These a (That c)) = These (This a) c
+  unassoc (That (These b c)) = These (That b) c
+  unassoc (These a (These b c)) = These (These a b) c
+  unassoc (These a (This b)) = This (These a b)
+
+-- copied from Data.These
+partitionThese :: [These a b] -> ([a], [b], [(a, b)])
+partitionThese [] = ([], [], [])
+partitionThese (t:ts) = case t of
+    This x    -> (x : xs,     ys,         xys)
+    That y    -> (    xs, y : ys,         xys)
+    These x y -> (    xs,     ys, (x,y) : xys)
+  where
+    ~(xs,ys,xys) = partitionThese ts
+
+instance AssocC (,) where
+  assoc ((a,b),c) = (a,(b,c))
+  unassoc (a,(b,c)) = ((a,b),c)
+
+instance (Show (p (p a b) c)
+        , Show (p a (p b c))
+        , AssocC 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 = assoc pabc
+    in pure $ mkNode opts (PresentT d) (show01 opts msg0 d pabc) []
+
+-- | unassoc using 'AssocC'
+--
+-- >>> pz @Unassoc (These 123 (This 'x'))
+-- PresentT (This (These 123 'x'))
+--
+-- >>> pz @Unassoc (99,('a',True))
+-- PresentT ((99,'a'),True)
+--
+-- >>> pz @Unassoc (This 10 :: These Int (These Bool ()))
+-- PresentT (This (This 10))
+--
+-- >>> pz @Unassoc (Right (Right 123))
+-- PresentT (Right 123)
+--
+-- >>> pz @Unassoc (Left 'x' :: Either Char (Either Bool Double))
+-- PresentT (Left (Left 'x'))
+--
+data Unassoc
+
+instance (Show (p (p a b) c)
+        , Show (p a (p b c))
+        , AssocC 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 = unassoc pabc
+    in pure $ mkNode opts (PresentT d) (show01 opts msg0 d pabc) []
+
+-- | bounded 'succ' function
+--
+-- >>> pz @(SuccB' Id) (13 :: Int)
+-- PresentT 14
+--
+-- >>> pz @(SuccB' Id) LT
+-- PresentT EQ
+--
+-- >>> pz @(SuccB 'LT Id) GT
+-- PresentT LT
+--
+-- >>> pz @(SuccB' Id) GT
+-- FailT "Succ bounded"
+--
+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 ->
+        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]
+
+data SuccB p q
+
+data SuccB' q
+type SuccBT' q = SuccB (Failp "Succ bounded") q
+
+instance P (SuccBT' q) x => P (SuccB' q) x where
+  type PP (SuccB' q) x = PP (SuccBT' q) x
+  eval _ = eval (Proxy @(SuccBT' q))
+
+-- | bounded 'pred' function
+--
+-- >>> pz @(PredB' Id) (13 :: Int)
+-- PresentT 12
+--
+-- >>> pz @(PredB' Id) LT
+-- FailT "Pred bounded"
+--
+data PredB' q
+type PredBT' q = PredB (Failp "Pred bounded") 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 ->
+        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
+-- PresentT 14
+--
+-- >>> pz @(Succ Id) LT
+-- PresentT EQ
+--
+-- >>> pz @(Succ Id) GT
+-- 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
+-- PresentT 12
+--
+-- >>> pz @(Pred Id) LT
+-- 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]
+
+data PredB p q
+
+instance P (PredBT' q) x => P (PredB' q) x where
+  type PP (PredB' q) x = PP (PredBT' q) x
+  eval _ = eval (Proxy @(PredBT' q))
+
+
+-- | 'fromEnum' function
+--
+-- >>> pz @(FromEnum Id) 'x'
+-- 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
+-- PresentT 'x'
+data ToEnum' 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]
+
+data ToEnum (t :: Type) p
+type ToEnumT (t :: Type) p = ToEnum' (Hole t) p
+
+instance P (ToEnumT t p) x => P (ToEnum t p) x where
+  type PP (ToEnum t p) x = PP (ToEnumT t p) x
+  eval _ = eval (Proxy @(ToEnumT t p))
+-- | bounded 'toEnum' function
+--
+-- >>> pz @(ToEnumBDef Ordering LT) 2
+-- PresentT GT
+--
+-- >>> pz @(ToEnumBDef Ordering LT) 6
+-- PresentT LT
+--
+-- >>> pz @(ToEnumBFail Ordering) 6
+-- FailT "ToEnum bounded"
+--
+data ToEnumBDef' t def
+
+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) []
+
+data ToEnumBDef (t :: Type) def
+type ToEnumBDefT (t :: Type) def = ToEnumBDef' (Hole t) def
+
+instance P (ToEnumBDefT t def) x => P (ToEnumBDef t def) x where
+  type PP (ToEnumBDef t def) x = PP (ToEnumBDefT t def) x
+  eval _ = eval (Proxy @(ToEnumBDefT t def))
+
+data ToEnumBFail (t :: Type)
+type ToEnumBFailT (t :: Type) = ToEnumBDef' (Hole t) (Failp "ToEnum bounded")
+
+instance P (ToEnumBFailT t) x => P (ToEnumBFail t) x where
+  type PP (ToEnumBFail t) x = PP (ToEnumBFailT t) x
+  eval _ = eval (Proxy @(ToEnumBFailT t))
+
+-- | a predicate on prime numbers
+--
+-- >>> pz @(Prime Id) 2
+-- TrueT
+--
+-- >>> pz @(Map '(Id,Prime Id) Id) [0..12]
+-- 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 = p > 1 && isPrime (fromIntegral p)
+        in mkNodeB opts b (msg0 <> show1 opts " | " p) [hh pp]
+
+isPrime :: Word -> Bool
+isPrime n = n==2 || n>2 && all ((> 0).rem n) (2:[3,5 .. floor . sqrt @Double . fromIntegral $ n+1])
+
+-- | get the next prime number
+--
+-- >>> pz @(PrimeNext Id) 6
+-- PresentT 7
+--
+-- >>> pz @(IterateN 4 (PrimeNext Id)) 3
+-- PresentT [3,5,7,11]
+--
+data PrimeNext p
+
+instance (PP p x ~ a
+        , P p x
+        , Show a
+        , Integral a
+        ) => P (PrimeNext p) x where
+  type PP (PrimeNext p) x = Word
+  eval _ opts x = do
+    let msg0 = "PrimeNext"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let ret = head $ dropWhile (not . isPrime) [max 0 (fromIntegral p + 1) ..]
+        in mkNode opts (PresentT ret) (msg0 <> show1 opts " | " p) [hh pp]
+
+-- 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]) ()
+-- PresentT [5,5,5]
+--
+-- >>> pz @(Keep '[0,1,1,5] '[1,5,5,2,5,2]) ()
+-- PresentT [1,5,5,5]
+--
+-- >>> pz @(Remove '[5] '[1,5,5,2,5,2]) ()
+-- PresentT [1,2,2]
+--
+-- >>> pz @(Remove '[0,1,1,5] '[1,5,5,2,5,2]) ()
+-- PresentT [2,2]
+--
+-- >>> pz @(Remove '[99] '[1,5,5,2,5,2]) ()
+-- PresentT [1,5,5,2,5,2]
+--
+-- >>> pz @(Remove '[99,91] '[1,5,5,2,5,2]) ()
+-- PresentT [1,5,5,2,5,2]
+--
+-- >>> pz @(Remove Id '[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!
+-- PresentT [1,5,5,2,5,2]
+--
+data KeepImpl (keep :: Bool) 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]
+
+data Keep p q
+type KeepT p q = KeepImpl 'True p q
+
+instance P (KeepT p q) x => P (Keep p q) x where
+  type PP (Keep p q) x = PP (KeepT p q) x
+  eval _ = eval (Proxy @(KeepT p q))
+
+data Remove p q
+type RemoveT p q = KeepImpl 'False p q
+
+instance P (RemoveT p q) x => P (Remove p q) x where
+  type PP (Remove p q) x = PP (RemoveT p q) x
+  eval _ = eval (Proxy @(RemoveT p q))
+
+-- | 'elem' function
+--
+-- >>> pz @(Elem (Fst Id) (Snd Id)) ('x',"abcdxy")
+-- TrueT
+--
+-- >>> pz @(Elem (Fst Id) (Snd Id)) ('z',"abcdxy")
+-- 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"))
+-- 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))
+-- 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) []
+-- PresentT 444
+--
+-- >>> pz @(HeadDef 444 Id) [1..5]
+-- PresentT 1
+--
+-- >>> pz @(HeadDef 444 Id) [1..5]
+-- PresentT 1
+--
+-- >>> pz @(HeadDef (Char1 "w") Id) (Seq.fromList "abcdef")
+-- PresentT 'a'
+--
+-- >>> pz @(HeadDef (Char1 "w") Id) Seq.empty
+-- PresentT 'w'
+--
+-- >>> :set -XFlexibleContexts
+-- >>> pz @(HeadDef (MEmptyT _) Id) ([] :: [SG.Sum Int])
+-- PresentT (Sum {getSum = 0})
+--
+-- >>> pz @(HeadDef (MEmptyT String) '[ "abc","def","asdfadf" ]) ()
+-- PresentT "abc"
+--
+-- >>> pz @(HeadDef (MEmptyT _) (Snd Id)) (123,[ "abc","def","asdfadf" ])
+-- PresentT "abc"
+--
+-- >>> pz @(HeadDef (MEmptyT _) (Snd Id)) (123,[])
+-- PresentT ()
+--
+data HeadDef p q
+type HeadDefT p q = JustDef p (q >> Uncons >> FMapFst)
+
+instance P (HeadDefT p q) x => P (HeadDef p q) x where
+  type PP (HeadDef p q) x = PP (HeadDefT p q) x
+  eval _ = eval (Proxy @(HeadDefT p q))
+
+
+-- | takes the head of a list or fail
+--
+-- see 'ConsT' for other supported types eg 'Seq.Seq'
+--
+-- >>> pz @(HeadFail "dude" Id) [ "abc","def","asdfadf" ]
+-- PresentT "abc"
+--
+-- >>> pz @(HeadFail "empty list" Id) []
+-- FailT "empty list"
+--
+data HeadFail msg q
+type HeadFailT msg q = JustFail msg (q >> Uncons >> FMapFst)
+
+instance P (HeadFailT msg q) x => P (HeadFail msg q) x where
+  type PP (HeadFail msg q) x = PP (HeadFailT msg q) x
+  eval _ = eval (Proxy @(HeadFailT msg q))
+
+data TailDef p q
+type TailDefT p q = JustDef p (q >> Uncons >> FMapSnd)
+
+instance P (TailDefT p q) x => P (TailDef p q) x where
+  type PP (TailDef p q) x = PP (TailDefT p q) x
+  eval _ = eval (Proxy @(TailDefT p q))
+
+
+data TailFail msg q
+type TailFailT msg q = JustFail msg (q >> Uncons >> FMapSnd)
+
+instance P (TailFailT msg q) x => P (TailFail msg q) x where
+  type PP (TailFail msg q) x = PP (TailFailT msg q) x
+  eval _ = eval (Proxy @(TailFailT msg q))
+
+
+data LastDef p q
+type LastDefT p q = JustDef p (q >> Unsnoc >> FMapSnd)
+
+instance P (LastDefT p q) x => P (LastDef p q) x where
+  type PP (LastDef p q) x = PP (LastDefT p q) x
+  eval _ = eval (Proxy @(LastDefT p q))
+
+data LastFail msg q
+type LastFailT msg q = JustFail msg (q >> Unsnoc >> FMapSnd)
+
+instance P (LastFailT msg q) x => P (LastFail msg q) x where
+  type PP (LastFail msg q) x = PP (LastFailT msg q) x
+  eval _ = eval (Proxy @(LastFailT msg q))
+
+data InitDef p q
+type InitDefT p q = JustDef p (q >> Unsnoc >> FMapFst)
+
+instance P (InitDefT p q) x => P (InitDef p q) x where
+  type PP (InitDef p q) x = PP (InitDefT p q) x
+  eval _ = eval (Proxy @(InitDefT p q))
+
+data InitFail msg q
+type InitFailT msg q = JustFail msg (q >> Unsnoc >> FMapFst)
+
+instance P (InitFailT msg q) x => P (InitFail msg q) x where
+  type PP (InitFail msg q) x = PP (InitFailT msg q) x
+  eval _ = eval (Proxy @(InitFailT msg q))
+
+data LookupDef' v w p q
+type LookupDefT' v w p q = JustDef p (q >> Lookup v w)
+
+instance P (LookupDefT' v w p q) x => P (LookupDef' v w p q) x where
+  type PP (LookupDef' v w p q) x = PP (LookupDefT' v w p q) x
+  eval _ = eval (Proxy @(LookupDefT' v w p q))
+
+data LookupFail' msg v w q
+type LookupFailT' msg v w q = JustFail msg (q >> Lookup v w)
+
+instance P (LookupFailT' msg v w q) x => P (LookupFail' msg v w q) x where
+  type PP (LookupFail' msg v w q) x = PP (LookupFailT' msg v w q) x
+  eval _ = eval (Proxy @(LookupFailT' msg v w q))
+
+data LookupDef v w p
+type LookupDefT v w p = LookupDef' v w p I
+
+instance P (LookupDefT v w p) x => P (LookupDef v w p) x where
+  type PP (LookupDef v w p) x = PP (LookupDefT v w p) x
+  eval _ = eval (Proxy @(LookupDefT v w p))
+
+data LookupFail msg v w
+type LookupFailT msg v w = LookupFail' msg v w I
+
+instance P (LookupFailT msg v w) x => P (LookupFail msg v w) x where
+  type PP (LookupFail msg v w) x = PP (LookupFailT msg v w) x
+  eval _ = eval (Proxy @(LookupFailT msg v w))
+
+--type Just'  p = JustFail  "expected Just" p
+data Left' p
+type LeftT' p = LeftFail "expected Left"  p
+
+instance P (LeftT' p) x => P (Left' p) x where
+  type PP (Left' p) x = PP (LeftT' p) x
+  eval _ = eval (Proxy @(LeftT' p))
+
+data Right' p
+type RightT' p = RightFail "expected Right" p
+
+instance P (RightT' p) x => P (Right' p) x where
+  type PP (Right' p) x = PP (RightT' p) x
+  eval _ = eval (Proxy @(RightT' p))
+
+data This'  p
+type ThisT'  p = ThisFail  "expected This"  p
+
+instance P (ThisT' p) x => P (This' p) x where
+  type PP (This' p) x = PP (ThisT' p) x
+  eval _ = eval (Proxy @(ThisT' p))
+
+data That'  p
+type ThatT'  p = ThatFail  "expected That"  p
+
+instance P (ThatT' p) x => P (That' p) x where
+  type PP (That' p) x = PP (ThatT' p) x
+  eval _ = eval (Proxy @(ThatT' p))
+
+data These' p
+type TheseT' p = TheseFail "expected These" p
+
+instance P (TheseT' p) x => P (These' p) x where
+  type PP (These' p) x = PP (TheseT' p) x
+  eval _ = eval (Proxy @(TheseT' 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)
+-- PresentT "132"
+--
+-- >>> pz @(EitherX (ShowP (Fst (Fst Id) + Snd Id)) (ShowP Id) (Snd Id)) (9,Right 'x')
+-- PresentT "((9,Right 'x'),'x')"
+--
+-- >>> pz @(EitherX (ShowP Id) (ShowP (Second (Succ Id))) (Snd Id)) (9,Right 'x')
+-- 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)
+-- PresentT "132"
+--
+-- >>> pz @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (This 123)
+-- PresentT (123,"fromthis")
+--
+-- >>> pz @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (That "fromthat")
+-- PresentT (-99,"fromthat")
+--
+-- >>> pz @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (These 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)
+-- PresentT "19"
+--
+-- >>> pz @(MaybeIn "found nothing" (ShowP (Pred Id))) Nothing
+-- PresentT "found nothing"
+--
+data MaybeIn p q
+
+-- 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 'isJust'
+--
+-- >>> pz @(IsJust Id) Nothing
+-- FalseT
+--
+-- >>> pz @(IsJust Id) (Just 'a')
+-- TrueT
+--
+data IsJust p
+
+instance (P p x, PP p x ~ Maybe a) => P (IsJust p) x where
+  type PP (IsJust p) x = Bool
+  eval _ opts x = do
+    let msg0 = "IsJust"
+    pp <- eval (Proxy @p) opts x
+    let hhs = [hh pp]
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right (Just _) -> mkNodeB opts True msg0 hhs
+      Right Nothing -> mkNodeB opts False msg0 hhs
+
+-- | similar to 'isNothing'
+--
+-- >>> pz @(IsNothing Id) (Just 123)
+-- FalseT
+--
+-- >>> pz @(IsNothing Id) Nothing
+-- TrueT
+--
+data IsNothing p
+
+instance (P p x, PP p x ~ Maybe a) => P (IsNothing p) x where
+  type PP (IsNothing p) x = Bool
+  eval _ opts x = do
+    let msg0 = "IsNothing"
+    pp <- eval (Proxy @p) opts x
+    let hhs = [hh pp]
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right (Just _) -> mkNodeB opts False msg0 hhs
+      Right Nothing -> mkNodeB opts True msg0 hhs
+
+data MapMaybe p q
+type MapMaybeT p q = ConcatMap (p >> MaybeIn MEmptyP '[Id]) q
+
+instance P (MapMaybeT p q) x => P (MapMaybe p q) x where
+  type PP (MapMaybe p q) x = PP (MapMaybeT p q) x
+  eval _ = eval (Proxy @(MapMaybeT p q))
+
+-- | similar to 'Data.Either.catMaybes'
+--
+-- >>> pl @(CatMaybes Id) [Just 'a',Nothing,Just 'c',Just 'd',Nothing]
+-- Present "acd" (Concat "acd" | ["a","","c","d",""])
+-- PresentT "acd"
+--
+data CatMaybes q
+type CatMaybesT q = MapMaybe Id q
+
+instance P (CatMaybesT q) x => P (CatMaybes q) x where
+  type PP (CatMaybes q) x = PP (CatMaybesT q) x
+  eval _ = eval (Proxy @(CatMaybesT q))
+
+-- | similar to 'SG.stimes'
+--
+-- >>> pz @(STimes 4 Id) (SG.Sum 3)
+-- PresentT (Sum {getSum = 12})
+--
+-- >>> pz @(STimes 4 Id) "ab"
+-- 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
+-- PresentT (Just 4)
+--
+-- >>> pz @(Pure [] Id) 4
+-- PresentT [4]
+--
+-- >>> pz @(Pure (Either String) (Fst Id)) (13,True)
+-- 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)) ()
+-- PresentT (Sum {getSum = 0})
+--
+-- no Monoid for Maybe a unless a is also a monoid but can use empty!
+data MEmptyT' t
+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 MEmptyT (t :: Type)
+type MEmptyTT (t :: Type) = MEmptyT' (Hole t)
+
+instance P (MEmptyTT t) x => P (MEmptyT t) x where
+  type PP (MEmptyT t) x = PP (MEmptyTT t) x
+  eval _ = eval (Proxy @(MEmptyTT t))
+
+data MEmptyP
+type MEmptyPT = MEmptyT' Unproxy -- expects a proxy: so only some things work with this: eg MaybeIn
+
+instance P MEmptyPT x => P MEmptyP x where
+  type PP MEmptyP x = PP MEmptyPT x
+  eval _ = eval (Proxy @MEmptyPT)
+
+-- | similar to 'empty'
+--
+-- >>> pz @(EmptyT Maybe Id) ()
+-- PresentT Nothing
+--
+-- >>> pz @(EmptyT [] Id) ()
+-- PresentT []
+--
+-- >>> pz @(EmptyT [] (Char1 "x")) (13,True)
+-- PresentT ""
+--
+-- >>> pz @(EmptyT (Either String) (Fst Id)) (13,True)
+-- 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'
+
+-- 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 []
+
+data MkNothing (t :: Type)
+type MkNothingT (t :: Type) = MkNothing' (Hole t)
+
+instance P (MkNothing t) x where
+  type PP (MkNothing t) x = PP (MkNothingT t) x
+  eval _ = eval (Proxy @(MkNothingT t))
+
+-- | 'GHC.Maybe.Just' constructor
+--
+-- >>> pz @(MkJust Id) 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
+-- PresentT (Left 44)
+--
+data MkLeft' 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 MkLeft (t :: Type) p
+type MkLeftT (t :: Type) p = MkLeft' (Hole t) p
+
+instance P (MkLeftT t p) x => P (MkLeft t p) x where
+  type PP (MkLeft t p) x = PP (MkLeftT t p) x
+  eval _ = eval (Proxy @(MkLeftT t p))
+
+-- | 'Data.Either.Right' constructor
+--
+-- >>> pz @(MkRight _ Id) 44
+-- PresentT (Right 44)
+--
+data MkRight' 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 MkRight (t :: Type) p
+type MkRightT (t :: Type) p = MkRight' (Hole t) p
+
+instance P (MkRightT t p) x => P (MkRight t p) x where
+  type PP (MkRight t p) x = PP (MkRightT t p) x
+  eval _ = eval (Proxy @(MkRightT t p))
+
+-- | 'Data.These.This' constructor
+--
+-- >>> pz @(MkThis _ Id) 44
+-- PresentT (This 44)
+--
+-- >>> pz @(Proxy Int >> MkThis' Unproxy 10) []
+-- PresentT (This 10)
+--
+data MkThis' 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 MkThis (t :: Type) p
+type MkThisT (t :: Type) p = MkThis' (Hole t) p
+
+instance P (MkThisT t p) x => P (MkThis t p) x where
+  type PP (MkThis t p) x = PP (MkThisT t p) x
+  eval _ = eval (Proxy @(MkThisT t p))
+
+-- | 'Data.These.That' constructor
+--
+-- >>> pz @(MkThat _ Id) 44
+-- PresentT (That 44)
+--
+data MkThat' 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]
+
+data MkThat (t :: Type) p
+type MkThatT (t :: Type) p = MkThat' (Hole t) p
+
+instance P (MkThatT t p) x => P (MkThat t p) x where
+  type PP (MkThat t p) x = PP (MkThatT t p) x
+  eval _ = eval (Proxy @(MkThatT t p))
+
+-- type MkThat t p = MkThis t p >> Swap
+-- type MkThat' (t :: Type) = Pure (These t) Id -- t has to be a semigroup
+
+-- | 'Data.These.These' constructor
+--
+-- >>> pz @(MkThese (Fst Id) (Snd Id)) (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]
+-- PresentT (Sum {getSum = 59})
+--
+data MConcat p
+
+instance (PP p x ~ [a]
+        , P p x
+        , Show a
+        , Monoid a
+        ) => P (MConcat p) x where
+  type PP (MConcat p) x = ExtractAFromList (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 a limited form of 'foldMap'
+--
+-- >>> pz @(FoldMap (SG.Sum _) Id) [44, 12, 3]
+-- PresentT 59
+--
+-- >>> pz @(FoldMap (SG.Product _) Id) [44, 12, 3]
+-- PresentT 1584
+--
+-- >>> type Ands' p = FoldMap SG.All p
+-- >>> pz @(Ands' Id) [True,False,True,True]
+-- PresentT False
+--
+-- >>> pz @(Ands' Id) [True,True,True]
+-- PresentT True
+--
+-- >>> pz @(Ands' Id) []
+-- PresentT True
+--
+-- >>> type Ors' p = FoldMap SG.Any p
+-- >>> pz @(Ors' Id) [False,False,False]
+-- PresentT False
+--
+-- >>> pz @(Ors' Id) []
+-- PresentT False
+--
+-- >>> pz @(Ors' Id) [False,False,False,True]
+-- PresentT True
+--
+-- >>> type AllPositive' = FoldMap SG.All (Map Positive Id)
+-- >>> pz @AllPositive' [3,1,-5,10,2,3]
+-- PresentT False
+--
+-- >>> type AllNegative' = FoldMap SG.All (Map Negative Id)
+-- >>> pz @AllNegative' [-1,-5,-10,-2,-3]
+-- 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]
+-- PresentT 12
+--
+data FoldMap (t :: Type) p
+type FoldMapT (t :: Type) p = Map (Wrap t Id) p >> Unwrap (MConcat Id)
+
+instance P (FoldMapT t p) x => P (FoldMap t p) x where
+  type PP (FoldMap t p) x = PP (FoldMapT t p) x
+  eval _ = eval (Proxy @(FoldMapT t p))
+
+-- | similar to 'concat'
+--
+-- >>> pz @(Concat Id) ["abc","D","eF","","G"]
+-- PresentT "abcDeFG"
+--
+-- >>> pz @(Concat (Snd Id)) ('x',["abc","D","eF","","G"])
+-- 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]
+-- 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
+
+instance P (ProxyT' t) x where
+  type PP (ProxyT' t) x = Proxy (PP t x)
+  eval _ opts _ =
+    pure $ mkNode opts (PresentT Proxy) "ProxyT" []
+
+data ProxyT (t :: Type)
+type ProxyTT (t :: Type) = ProxyT' (Hole t)
+
+instance P (ProxyT t) x where
+  type PP (ProxyT t) x = PP (ProxyTT t) x
+  eval _ = eval (Proxy @(ProxyTT t))
+
+-- | similar to 'Data.List.!!'
+--
+-- >>> pz @(Ix 4 "not found") ["abc","D","eF","","G"]
+-- PresentT "G"
+--
+-- >>> pz @(Ix 40 "not found") ["abc","D","eF","","G"]
+-- PresentT "not found"
+--
+data Ix (n :: Nat) def
+
+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) []
+
+data Ix' (n :: Nat)
+type IxT' (n :: Nat) = Ix n (Failp "Ix index not found")
+
+instance P (IxT' n) x => P (Ix' n) x where
+  type PP (Ix' n) x = PP (IxT' n) x
+  eval _ = eval (Proxy @(IxT' n))
+
+-- | similar to 'Data.List.!!' leveraging 'Ixed'
+--
+-- >>> pz @(IxL Id 2 "notfound") ["abc","D","eF","","G"]
+-- PresentT "eF"
+--
+-- >>> pz @(IxL Id 20 "notfound") ["abc","D","eF","","G"]
+-- PresentT "notfound"
+--
+data IxL p q def -- p is the big value and q is the index and def is the default
+
+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]
+
+-- | similar to 'Data.List.!!' leveraging 'Ixed'
+--
+-- >>> pz @(Id !! 2) ["abc","D","eF","","G"]
+-- PresentT "eF"
+--
+-- >>> pz @(Id !! 20) ["abc","D","eF","","G"]
+-- FailT "(!!) index not found"
+--
+-- >>> import qualified Data.Map.Strict as M
+-- >>> pz @(Id !! "eF") (M.fromList (flip zip [0..] ["abc","D","eF","","G"]))
+-- PresentT 2
+--
+data p !! q
+type BangBangT p q = IxL p q (Failp "(!!) index not found")
+
+instance P (BangBangT p q) a => P (p !! q) a where
+  type PP (p !! q) a = PP (BangBangT p q) a
+  eval _ = eval (Proxy @(BangBangT p q))
+
+-- | 'lookup' leveraging 'Ixed'
+--
+-- >>> pz @(Lookup Id 2) ["abc","D","eF","","G"]
+-- PresentT (Just "eF")
+--
+-- >>> pz @(Lookup Id 20) ["abc","D","eF","","G"]
+-- PresentT Nothing
+--
+-- >>> pl @((Id !!? Char1 "d") > MkJust 99 || Length Id <= 3) (M.fromList $ zip "abcd" [1..])
+-- False (False || False | (Just 4 > Just 99) || (4 <= 3))
+-- FalseT
+--
+-- >>> pz @((Id !!? Char1 "d") > MkJust 2 || Length Id <= 3) (M.fromList $ zip "abcd" [1..])
+-- TrueT
+--
+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 p !!? q
+type BangBangQT p q = Lookup p q
+
+instance P (BangBangQT p q) a => P (p !!? q) a where
+  type PP (p !!? q) a = PP (BangBangQT p q) a
+  eval _ = eval (Proxy @(BangBangQT p q))
+
+
+-- | 'Data.List.ands'
+--
+-- >>> pz @(Ands Id) [True,True,True]
+-- TrueT
+--
+-- >>> pl @(Ands Id) [True,True,True,False]
+-- False (Ands(4) i=3 | [True,True,True,False])
+-- FalseT
+--
+-- >>> pz @(Ands Id) []
+-- 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]
+-- 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]
+
+
+-- | similar to (++)
+--
+-- >>> pz @(Fst Id ++ Snd Id) ([9,10,11],[1,2,3,4])
+-- PresentT [9,10,11,1,2,3,4]
+--
+-- >>> pz @(Snd Id ++ Fst Id) ([],[5])
+-- PresentT [5]
+--
+-- >>> pz @(Char1 "xyz" :+ W "ab" ++ W "cdefg") ()
+-- PresentT "xabcdefg"
+--
+-- >>> pz @([1,2,3] ++ EmptyList _) "somestuff"
+-- PresentT [1,2,3]
+--
+data p ++ q
+infixr 5 ++
+
+instance (P p x
+        , P q x
+        , Show (PP p x)
+        , PP p x ~ [a]
+        , PP q x ~ [a]
+        ) => 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 ++ q
+        in mkNode opts (PresentT b) (show01' opts msg0 b "p=" p <> show1 opts " | q=" q) [hh pp, hh qq]
+
+
+
+-- 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])
+-- PresentT [99,1,2,3,4]
+--
+-- >>> pz @(Snd Id :+ Fst Id) ([],5)
+-- PresentT [5]
+--
+-- >>> pz @(123 :+ EmptyList _) "somestuff"
+-- 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])
+-- PresentT [1,2,3,4,99]
+--
+-- >>> pz @(Fst Id +: Snd Id) ([],5)
+-- PresentT [5]
+--
+-- >>> pz @(EmptyT [] Id +: 5) 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]
+-- PresentT (Just (1,[2,3,4]))
+--
+-- >>> pz @Uncons []
+-- PresentT Nothing
+--
+-- >>> pz @Uncons (Seq.fromList "abc")
+-- PresentT (Just ('a',fromList "bc"))
+--
+-- >>> pz @Uncons ("xyz" :: T.Text)
+-- 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]
+-- PresentT (Just ([1,2,3],4))
+--
+-- >>> pz @Unsnoc []
+-- PresentT Nothing
+--
+-- >>> pz @Unsnoc ("xyz" :: T.Text)
+-- 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]
+-- FalseT
+--
+-- >>> pz @IsEmpty []
+-- TrueT
+--
+-- >>> pz @IsEmpty LT
+-- FalseT
+--
+-- >>> pz @IsEmpty EQ
+-- 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) []
+
+data Null' p
+
+instance (Show (t a)
+        , Foldable t
+        , t a ~ PP p x
+        , P p x
+        ) => P (Null' p) x where
+  type PP (Null' p) x = Bool
+  eval _ opts x = do
+    let msg0 = "Null"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = null p
+        in mkNodeB opts b ("Null" <> show1 opts " | " p) [hh pp]
+
+-- | similar to 'null' using 'Foldable'
+--
+-- >>> pz @Null [1,2,3,4]
+-- FalseT
+--
+-- >>> pz @Null []
+-- TrueT
+--
+-- >>> pz @Null Nothing
+-- TrueT
+--
+data Null
+type NullT = Null' Id
+instance P NullT a => P Null a where
+  type PP Null a = Bool
+  eval _ = evalBool (Proxy @NullT)
+
+-- | similar to 'enumFromTo'
+--
+-- >>> pz @(EnumFromTo 2 5) ()
+-- PresentT [2,3,4,5]
+--
+-- >>> pz @(EnumFromTo 'LT 'GT) ()
+-- PresentT [LT,EQ,GT]
+--
+-- >>> pz @(EnumFromTo 'GT 'LT) ()
+-- PresentT []
+--
+-- >>> pz @(EnumFromTo (Pred Id) (Succ Id)) (SG.Max 10)
+-- 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]
+
+-- | similar to 'partitionEithers'
+--
+-- >>> pz @PartitionEithers [Left 'a',Right 2,Left 'c',Right 4,Right 99]
+-- PresentT ("ac",[2,4,99])
+--
+-- >>> pz @PartitionEithers [Right 2,Right 4,Right 99]
+-- PresentT ([],[2,4,99])
+--
+-- >>> pz @PartitionEithers [Left 'a',Left 'c']
+-- PresentT ("ac",[])
+--
+-- >>> pz @PartitionEithers ([] :: [Either () Int])
+-- 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]
+-- 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) []
+
+data Thiss
+type ThissT = Fst PartitionThese
+
+instance P ThissT x => P Thiss x where
+  type PP Thiss x = PP ThissT x
+  eval _ = eval (Proxy @ThissT)
+
+data Thats
+type ThatsT = Snd PartitionThese
+
+instance P ThatsT x => P Thats x where
+  type PP Thats x = PP ThatsT x
+  eval _ = eval (Proxy @ThatsT)
+
+data Theses
+type ThesesT = Thd PartitionThese
+
+instance P ThesesT x => P Theses x where
+  type PP Theses x = PP ThesesT x
+  eval _ = eval (Proxy @ThesesT)
+
+-- 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])
+-- 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'
+-- PresentT "cdefg"
+--
+-- >>> pz @(FoldN 4 Id (Succ Id)) 'c'
+-- PresentT 'g'
+--
+-- >>> pz @(Dup >> ScanN 4 Id (Pred Id *** Succ Id)) 'g'
+-- PresentT [('g','g'),('f','h'),('e','i'),('d','j'),('c','k')]
+--
+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]
+
+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) ->
+        case chkSize opts msg0 r [hh rr] of
+          Left e -> pure e
+          Right () -> do
+            let msg1 = msg0  -- <> show0 opts " " q <> show0 opts " " r
+                ff i b as' rs
+                   | i >= oRecursion opts = pure (rs, Left $ mkNode opts (FailT (msg1 <> ":failed at i=" <> showIndex i)) (msg1 <> " (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 -> errorInProgram $ "Scanl e=" ++ show (fromTT e)
+                 Right abcs ->
+                   let vals = map (view _1) abcs
+                       itts = map (view _2 &&& view _3) abcs
+                   in 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)
+
+data ScanN n p q
+type ScanNT n p q = Scanl (Fst Id >> q) p (EnumFromTo 1 n) -- n times using q then run p
+
+instance P (ScanNT n p q) x => P (ScanN n p q) x where
+  type PP (ScanN n p q) x = PP (ScanNT n p q) x
+  eval _ = eval (Proxy @(ScanNT n p q))
+
+data ScanNA q
+type ScanNAT q = ScanN (Fst Id) (Snd Id) q
+
+instance P (ScanNAT q) x => P (ScanNA q) x where
+  type PP (ScanNA q) x = PP (ScanNAT q) x
+  eval _ = eval (Proxy @(ScanNAT q))
+
+data FoldN n p q
+type FoldNT n p q = Last (ScanN n p q)
+
+instance P (FoldNT n p q) x => P (FoldN n p q) x where
+  type PP (FoldN n p q) x = PP (FoldNT n p q) x
+  eval _ = eval (Proxy @(FoldNT n p q))
+
+data FoldL p q r
+type FoldLT p q r = Last (Scanl p q r)
+
+instance P (FoldLT p q r) x => P (FoldL p q r) x where
+  type PP (FoldL p q r) x = PP (FoldLT p q r) x
+  eval _ = eval (Proxy @(FoldLT p q r))
+
+-- | similar to 'unfoldr'
+--
+-- >>> pz @(Unfoldr (MaybeBool (Not Null) (SplitAt 2 Id)) Id) [1..5]
+-- PresentT [[1,2],[3,4],[5]]
+--
+-- >>> pz @(IterateN 4 (Succ Id)) 4
+-- PresentT [4,5,6,7]
+--
+data Unfoldr p q
+--type IterateN (t :: Type) n f = Unfoldr (If (Fst Id == 0) (MkNothing t) (Snd Id &&& (Pred Id *** f) >> MkJust Id)) '(n, Id)
+
+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 >= oRecursion opts = pure (rs, Left $ mkNode opts (FailT (msg1 <> ":failed at i=" <> showIndex i)) (msg1 <> " 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 -> errorInProgram $ "Unfoldr e=" ++ show (fromTT e)
+             Right abcs ->
+               let vals = map (view _1) abcs
+                   itts = map (view _2 &&& view _3) abcs
+               in 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)
+
+type family UnfoldT mbs where
+  UnfoldT (Maybe (b,s)) = b
+
+data IterateN n f
+type IterateNT n f = Unfoldr (MaybeBool (Fst Id > 0) '(Snd Id, Pred Id *** f)) '(n, Id)
+
+instance P (IterateNT n f) x => P (IterateN n f) x where
+  type PP (IterateN n f) x = PP (IterateNT n f) x
+  eval _ = eval (Proxy @(IterateNT n f))
+
+data IterateUntil p f
+type IterateUntilT p f = IterateWhile (Not p) f
+
+instance P (IterateUntilT p f) x => P (IterateUntil p f) x where
+  type PP (IterateUntil p f) x = PP (IterateUntilT p f) x
+  eval _ = eval (Proxy @(IterateUntilT p f))
+
+data IterateWhile p f
+type IterateWhileT p f = Unfoldr (MaybeBool p '(Id, f)) Id
+
+instance P (IterateWhileT p f) x => P (IterateWhile p f) x where
+  type PP (IterateWhile p f) x = PP (IterateWhileT p f) x
+  eval _ = eval (Proxy @(IterateWhileT p f))
+
+data IterateNWhile n p f
+type IterateNWhileT n p f = '(n, Id) >> IterateWhile (Fst Id > 0 && (Snd Id >> p)) (Pred Id *** f) >> Map (Snd Id) Id
+
+instance P (IterateNWhileT n p f) x => P (IterateNWhile n p f) x where
+  type PP (IterateNWhile n p f) x = PP (IterateNWhileT n p f) x
+  eval _ = eval (Proxy @(IterateNWhileT n p f))
+
+data IterateNUntil n p f
+type IterateNUntilT n p f = IterateNWhile n (Not p) f
+
+instance P (IterateNUntilT n p f) x => P (IterateNUntil n p f) x where
+  type PP (IterateNUntil n p f) x = PP (IterateNUntilT n p f) x
+  eval _ = eval (Proxy @(IterateNUntilT n p f))
+
+-- | similar to 'map'
+--
+-- >>> pz @(Map (Pred Id) Id) [1..5]
+-- PresentT [0,1,2,3,4]
+--
+data 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 abcs ->
+               let vals = map (view _1) abcs
+               in mkNode opts (PresentT vals) (show01 opts msg0 vals q) (hh qq : map (hh . fixit) ts)
+
+data ConcatMap p q
+type ConcatMapT p q = Concat (Map p q)
+
+instance P (ConcatMapT p q) x => P (ConcatMap p q) x where
+  type PP (ConcatMap p q) x = PP (ConcatMapT p q) x
+  eval _ = eval (Proxy @(ConcatMapT p q))
+
+-- | if p then run q else run r
+--
+-- >>> pz @(If (Gt 4) "greater than 4" "less than or equal to 4" ) 10
+-- PresentT "greater than 4"
+--
+-- >>> pz @(If (Gt 4) "greater than 4" "less than or equal to 4") 0
+-- 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]
+-- PresentT [(1,2),(2,3),(3,4)]
+--
+-- >>> pz @Pairs []
+-- FailT "Pairs no data found"
+--
+-- >>> pz @Pairs [1]
+-- 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]
+-- PresentT ([10,4,7,3,3,5],[1,1])
+--
+-- >>> pz @(Partition (Prime Id) Id) [10,4,1,7,3,1,3,5]
+-- PresentT ([7,3,3,5],[10,4,1,1])
+--
+-- >>> pz @(Partition (Ge 300) Id) [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]
+-- PresentT ([10,4,1,7,3,1,3,5],[])
+--
+data Partition p q
+
+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 ->
+        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 abcs ->
+                 let itts = map (view _2 &&& view _3) abcs
+                     w0 = partition (view _1) abcs
+                     zz1 = (map (view (_2 . _2)) *** map (view (_2 . _2))) w0
+                 in mkNode opts (PresentT zz1) (show01' opts msg0 zz1 "s=" q) (hh qq : map (hh . fixit) itts)
+
+-- | groups values based on a function
+--
+-- >>> pl @(GroupOn Ordering (Case (Failt _ "asdf") '[Id < 2, Id == 2, Id > 2] '[ 'LT, 'EQ, 'GT] Id) Id) [-4,2,5,6,7,1,2,3,4]
+-- Present fromList [(LT,[1,-4]),(EQ,[2,2]),(GT,[4,3,7,6,5])] (GroupOn fromList [(LT,[1,-4]),(EQ,[2,2]),(GT,[4,3,7,6,5])] | s=[-4,2,5,6,7,1,2,3,4])
+-- PresentT (fromList [(LT,[1,-4]),(EQ,[2,2]),(GT,[4,3,7,6,5])])
+--
+-- >>> pl @(GroupOn Ordering (Case (Failt _ "xyzxyzxyzzyyysyfsyfydf") '[Id < 2, Id == 2, Id > 3] '[ 'LT, 'EQ, 'GT] Id) Id) [-4,2,5,6,7,1,2,3,4]
+-- Error xyzxyzxyzzyyysyfsyfydf (GroupOn(i=7, a=3) excnt=1)
+-- FailT "xyzxyzxyzzyyysyfsyfydf"
+--
+data GroupOn t p q
+
+instance (P p x
+        , Ord t
+        , Show x
+        , Show t
+        , PP q a ~ [x]
+        , PP p x ~ t
+        , P q a
+        ) => P (GroupOn t p q) a where
+  type PP (GroupOn t p q) a = M.Map t (PP q a)
+  eval _ opts a' = do
+    let msg0 = "GroupOn"
+    qq <- eval (Proxy @q) opts a'
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q ->
+        case chkSize opts msg0 q [hh qq] of
+          Left e -> pure e
+          Right () -> do
+             ts <- zipWithM (\i a -> ((i, a),) <$> eval (Proxy @p) opts a) [0::Int ..] q
+             pure $ case splitAndAlign opts msg0 ts of
+                   Left e -> e
+                   Right abcs ->
+                     let kvs = map (view _1 &&& ((:[]) . view (_2 . _2))) abcs
+                         itts = map (view _2 &&& view _3) abcs
+                         ret = M.fromListWith (++) kvs
+                     in mkNode opts (PresentT ret) (show01' opts msg0 ret "s=" q ) (hh qq : map (hh . fixit) itts)
+
+data Filter p q
+type FilterT p q = Fst (Partition p q)
+
+instance P (FilterT p q) x => P (Filter p q) x where
+  type PP (Filter p q) x = PP (FilterT p q) x
+  eval _ = eval (Proxy @(FilterT p q))
+
+-- | similar to 'break'
+--
+-- >>> pz @(Break (Ge 3) Id) [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]
+-- PresentT ([10,4],[1,7,3,1,3,5])
+--
+data Break 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 ->
+        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 failure
+                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 (itoList 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 -> errorInProgram "Break"
+                     Left e -> e
+
+data Span p q
+type SpanT p q = Break (Not p) q
+
+instance P (SpanT p q) x => P (Span p q) x where
+  type PP (Span p q) x = PP (SpanT p q) x
+  eval _ = eval (Proxy @(SpanT p q))
+
+-- | Fails the computation with a message
+--
+-- >>> pz @(Failt Int (PrintF "value=%03d" Id)) 99
+-- FailT "value=099"
+--
+-- >>> pz @(FailS (PrintT "value=%03d string=%s" Id)) (99,"somedata")
+-- FailT "value=099 string=somedata"
+--
+data Fail t 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 | isVerbose opts]
+
+data FailS p
+instance P (Fail I p) x => P (FailS p) x where
+  type PP (FailS p) x = PP (Fail I p) x
+  eval _ = eval (Proxy @(Fail I p))
+
+data Failt (t :: Type) p
+instance P (Fail (Hole t) p) x => P (Failt t p) x where
+  type PP (Failt t p) x = PP (Fail (Hole t) p) x
+  eval _ = eval (Proxy @(Fail (Hole t) p))
+
+data Failp p
+instance P (Fail Unproxy p) x => P (Failp p) x where
+  type PP (Failp p) x = PP (Fail Unproxy p) x
+  eval _ = eval (Proxy @(Fail Unproxy p))
+
+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 'ParseTimeP', 'ReadBase'
+--
+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
+-- PresentT LT
+--
+-- >>> pz @(Catch' (Succ Id) (Second (ShowP Id) >> PrintT "%s %s" Id)) GT
+-- FailT "Succ IO e=Prelude.Enum.Ordering.succ: bad argument GT"
+--
+-- >>> pz @(Catch' (Succ Id) (Second (ShowP Id) >> PrintT "%s %s" Id)) LT
+-- 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
+
+data Catch' p s
+type CatchT' 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 (CatchT' p s) x => P (Catch' p s) x where
+  type PP (Catch' p s) x = PP (CatchT' p s) x
+  eval _ = eval (Proxy @(CatchT' p 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]
+-- PresentT [False,True,True,False,True,False]
+--
+-- >>> pz @(Map '(Even,Odd) Id) [9,-4,12,1,2,3]
+-- PresentT [(False,True),(True,False),(True,False),(False,True),(True,False),(False,True)]
+--
+data Even
+type EvenT = Mod I 2 == 0
+
+instance P EvenT x => P Even x where
+  type PP Even x = Bool
+  eval _ = evalBool (Proxy @EvenT)
+
+data Odd
+type OddT = Mod I 2 == 1
+
+instance P OddT x => P Odd x where
+  type PP Odd x = Bool
+  eval _ = evalBool (Proxy @OddT)
+
+
+--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)
+-- PresentT 2
+--
+-- >>> pz @(Div (Fst Id) (Snd Id)) (10,0)
+-- 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 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)
+-- PresentT 1
+--
+-- >>> pz @(Mod (Fst Id) (Snd Id)) (10,0)
+-- 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 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)
+-- PresentT (3,1)
+--
+-- >>> pz @(DivMod (Fst Id) (Snd Id)) (10,-3)
+-- PresentT (-4,-2)
+--
+-- >>> pz @(DivMod (Fst Id) (Snd Id)) (-10,3)
+-- PresentT (-4,2)
+--
+-- >>> pz @(DivMod (Fst Id) (Snd Id)) (-10,-3)
+-- PresentT (3,-1)
+--
+-- >>> pz @(DivMod (Fst Id) (Snd Id)) (10,0)
+-- 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 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)
+-- PresentT (3,1)
+--
+-- >>> pz @(QuotRem (Fst Id) (Snd Id)) (10,-3)
+-- PresentT (-3,1)
+--
+-- >>> pz @(QuotRem (Fst Id) (Snd Id)) (-10,-3)
+-- PresentT (3,-1)
+--
+-- >>> pz @(QuotRem (Fst Id) (Snd Id)) (-10,3)
+-- PresentT (-3,-1)
+--
+-- >>> pz @(QuotRem (Fst Id) (Snd Id)) (10,0)
+-- 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 hhs
+             _ -> let d = p `quotRem` q
+                  in mkNode opts (PresentT d) (show p <> " `quotRem` " <> show q <> " = " <> show d) hhs
+
+data Quot p q
+type QuotT p q = Fst (QuotRem p q)
+
+instance P (QuotT p q) x => P (Quot p q) x where
+  type PP (Quot p q) x = PP (QuotT p q) x
+  eval _ = eval (Proxy @(QuotT p q))
+
+data Rem p q
+type RemT p q = Snd (QuotRem p q)
+
+instance P (RemT p q) x => P (Rem p q) x where
+  type PP (Rem p q) x = PP (RemT p q) x
+  eval _ = eval (Proxy @(RemT 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
+-- 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]
+-- PresentT [17,4]
+--
+-- >>> pz @(Guards '[ '("arg1 failed",Gt 4), '("arg2 failed", Same 5)]) [17,4]
+-- FailT "arg2 failed"
+--
+-- >>> pz @(Guards '[ '("arg1 failed",Gt 99), '("arg2 failed", Same 4)]) [17,4]
+-- FailT "arg1 failed"
+--
+-- >>> pz @(Guards '[ '(PrintT "arg %d failed with value %d" Id,Gt 4), '(PrintT "%d %d" Id, Same 4)]) [17,3]
+-- FailT "1 3"
+--
+-- >>> pz @(GuardsQuick (PrintT "arg %d failed with value %d" Id) '[Gt 4, Ge 3, Same 4]) [17,3,5]
+-- FailT "arg 2 failed with value 5"
+--
+-- >>> pz @(GuardsQuick (PrintT "arg %d failed with value %d" Id) '[Gt 4, Ge 3, Same 4]) [17,3,5,99]
+-- FailT "Guards:invalid length(4) expected 3"
+--
+data GuardsImpl (n :: Nat) (os :: [(k,k1)])
+
+data Guards (ps :: [(k,k1)])
+
+instance ([a] ~ x, GetLen ps, P (GuardsImpl (LenT ps) ps) x) => P (Guards ps) x where
+  type PP (Guards ps) x = PP (GuardsImpl (LenT ps) ps) x
+  eval _ opts as = do
+    let msg0 = "Guards"
+        n = getLen @ps
+    if n /= length as then
+       let msg1 = msg0 <> badLength as n
+       in pure $ mkNode opts (FailT msg1) msg1 []
+    else eval (Proxy @(GuardsImpl (LenT ps) ps)) opts as
+
+badLength :: (Foldable t, Show n, Num n) => t a -> n -> String
+badLength as n = ":invalid length(" <> show (length as) <> ") expected " ++ show (n+0)
+
+instance ([a] ~ x, Show a)
+         => P (GuardsImpl n ('[] :: [(k,k1)])) x where
+  type PP (GuardsImpl n ('[] :: [(k,k1)])) x = x
+  eval _ opts as =
+    let msg0 = "Guards"
+    in if not (null as) then errorInProgram $ "GuardsImpl base case has extra data " ++ show as
+       else pure $ mkNode opts (PresentT as) (msg0 <> " no data") []
+
+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
+        , [a] ~ x
+        ) => P (GuardsImpl n ('(prt,p) ': ps)) x where
+  type PP (GuardsImpl n ('(prt,p) ': ps)) x = x
+  eval _ opts as' = do
+     let cpos = n-pos-1
+         msgbase1 = "Guard(" <> show 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 (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 -> mkNode opts (FailT msgx) (msgbase1 <> " failed [" <> msgx <> "]" <> show0 opts " " a) (hh pp : [hh qq | isVerbose opts])
+                 Right True ->
+                   if pos == 0 then -- we are at the bottom of the tree
+                      pure $ mkNode opts (PresentT [a]) msgbase2 [hh pp]
+                   else 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 -> (ss & tForest %~ \x -> fromTT pp : x) & tBool .~ PresentT (a:zs)
+         _ -> errorInProgram "GuardsImpl n+1 case has no data"
+
+data GuardsQuick (prt :: k) (ps :: [k1])
+type GuardsQuickT (prt :: k) (ps :: [k1]) = Guards (ToGuardsT prt ps)
+
+instance P (GuardsQuickT prt ps) x => P (GuardsQuick prt ps) x where
+  type PP (GuardsQuick prt ps) x = PP (GuardsQuickT prt ps) x
+  eval _ = eval (Proxy @(GuardsQuickT prt ps))
+
+-- | boolean guard which checks a given a list of predicates against the list of values
+--
+-- prefer 'Bools' as 'BoolsQuick' doesnt give much added value: passes in the index and the value to prt but you already have the index in the message
+--
+-- pulls the top message from the tree if a predicate is false
+--
+-- >>> pl @(Bools '[ '(W "hh",Between 0 23 Id), '(W "mm",Between 0 59 Id), '(PrintT "<<<%d %d>>>" Id,Between 0 59 Id) ] ) [12,93,14]
+-- False (Bool(1) [mm] (93 <= 59))
+-- FalseT
+--
+-- >>> pl @(Bools '[ '(W "hh",Between 0 23 Id), '(W "mm",Between 0 59 Id), '(PrintT "<<<%d %d>>>" Id,Between 0 59 Id) ] ) [12,13,94]
+-- False (Bool(2) [<<<2 94>>>] (94 <= 59))
+-- FalseT
+--
+-- >>> pl @(Bools '[ '(W "hh",Between 0 23 Id), '(W "mm",Between 0 59 Id), '(PrintT "<<<%d %d>>>" Id,Between 0 59 Id) ] ) [12,13,14]
+-- True (Bools)
+-- TrueT
+--
+-- >>> pl @(BoolsQuick "abc" '[Between 0 23 Id, Between 0 59 Id, Between 0 59 Id]) [12,13,14]
+-- True (Bools)
+-- TrueT
+--
+-- >>> pl @(BoolsQuick (PrintT "id=%d val=%d" Id) '[Between 0 23 Id, Between 0 59 Id, Between 0 59 Id]) [12,13,14]
+-- True (Bools)
+-- TrueT
+--
+-- >>> pl @(BoolsQuick (PrintT "id=%d val=%d" Id) '[Between 0 23 Id, Between 0 59 Id, Between 0 59 Id]) [12,13,99]
+-- False (Bool(2) [id=2 val=99] (99 <= 59))
+-- FalseT
+--
+-- >>> pl @(Bools '[ '("hours",Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ] ) [12,13,14]
+-- True (Bools)
+-- TrueT
+--
+-- >>> pl @(Bools '[ '("hours",Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ] ) [12,60,14]
+-- False (Bool(1) [minutes] (60 <= 59))
+-- FalseT
+--
+-- >>> pl @(Bools '[ '("hours",Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ] ) [12,60,14,20]
+-- False (Bools:invalid length(4) expected 3)
+-- FalseT
+--
+data Bools (ps :: [(k,k1)])
+
+instance ([a] ~ x
+        , GetLen ps
+        , P (BoolsImpl (LenT ps) ps) x
+        , PP (BoolsImpl (LenT ps) ps) x ~ Bool
+        ) => P (Bools ps) x where
+  type PP (Bools ps) x = Bool
+  eval _ opts as = do
+    let msg0 = "Bools"
+        msg1 = "Bool("++show n++")"
+        n = getLen @ps
+    case chkSize opts msg1 as [] of
+      Left e -> pure e
+      Right () ->
+        if n /= length as then
+           let msg2 = msg0 <> badLength as n
+           in pure $ mkNodeB opts False msg2 [] -- was FailT but now just FalseT
+        else evalBool (Proxy @(BoolsImpl (LenT ps) ps)) opts as
+
+data BoolsImpl (n :: Nat) (os :: [(k,k1)])
+
+instance (KnownNat n
+        , Show a
+        , [a] ~ x
+        ) => P (BoolsImpl n ('[] :: [(k,k1)])) x where
+  type PP (BoolsImpl n ('[] :: [(k,k1)])) x = Bool
+  eval _ opts as =
+    let msg0 = "Bool(" <> show n <> ")"
+        n :: Int = nat @n
+    in if not (null as) then errorInProgram $ "BoolsImpl base case has extra data " ++ show as
+       else pure $ mkNodeB opts True (msg0 <> " empty") []
+
+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) x
+        , PP (BoolsImpl n ps) [a] ~ Bool
+--        , Show a
+        , [a] ~ x
+        ) => P (BoolsImpl n ('(prt,p) ': ps)) x where
+  type PP (BoolsImpl n ('(prt,p) ': ps)) x = Bool
+  eval _ opts as' = do
+     let cpos = n-pos-1
+         msgbase1 = "Bool(" <> 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 : [hh qq | isVerbose opts])
+                 Right True ->
+                   if pos == 0 then -- we are at the bottom of the tree
+                      pure $ mkNodeB opts True msgbase2 [hh pp]
+                   else 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 _ ->  ss & tForest %~ \x -> fromTT pp : x
+         _ -> errorInProgram "BoolsImpl n+1 case has no data"
+
+data BoolsQuick (prt :: k) (ps :: [k1])
+type BoolsQuickT (prt :: k) (ps :: [k1]) = Bools (ToGuardsT prt ps)
+
+-- why do we need this? when BoolsN works without [use the x ~ [a] trick in BoolsN]
+instance (PP (Bools (ToGuardsT prt ps)) x ~ Bool
+        , P (BoolsQuickT prt ps) x
+          ) => P (BoolsQuick prt ps) x where
+  type PP (BoolsQuick prt ps) x = PP (BoolsQuickT prt ps) x
+  eval _ = evalBool (Proxy @(BoolsQuickT prt ps))
+
+-- | 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 Id)) [121,33,7,256]
+-- False (Bool(3) [id=3 must be between 0 and 255, found 256] (256 <= 255))
+-- FalseT
+--
+-- >>> pl @(BoolsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255 Id)) [121,33,7,44]
+-- True (Bools)
+-- TrueT
+--
+data BoolsN prt (n :: Nat) (p :: k1)
+type BoolsNT prt (n :: Nat) (p :: k1) = Bools (ToGuardsT prt (RepeatT n p))
+
+instance (x ~ [a], P (BoolsNT prt n p) x) => P (BoolsN prt n p) x where
+  type PP (BoolsN prt n p) x = PP (BoolsNT prt n p) x
+  eval _ = evalBool (Proxy @(BoolsNT prt n p))
+
+-- | 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 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)]) [13,59,61]
+-- FailT "seconds invalid: found 61"
+--
+-- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)]) [27,59,12]
+-- FailT "hours invalid: found 27"
+--
+-- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)]) [23,59,12]
+-- PresentT [23,59,12]
+--
+data GuardsDetailImpl (ps :: [(k,k1)])
+
+instance ([a] ~ x
+        , GetLen ps
+        , P (GuardsImplX (LenT ps) ps) x
+        ) => P (GuardsDetailImpl ps) x where
+  type PP (GuardsDetailImpl ps) x = PP (GuardsImplX (LenT ps) ps) x
+  eval _ opts as = do
+    let msg0 = "Guards"
+        n = getLen @ps
+    if n /= length as then
+       let msg1 = msg0 <> badLength as n
+       in pure $ mkNode opts (FailT msg1) msg1 []
+    else eval (Proxy @(GuardsImplX (LenT ps) ps)) opts as
+
+data GuardsImplX (n :: Nat) (os :: [(k,k1)])
+
+instance ([a] ~ x, Show a)
+        => P (GuardsImplX n ('[] :: [(k,k1)])) x where
+  type PP (GuardsImplX n ('[] :: [(k,k1)])) x = x
+  eval _ opts as =
+    let msg0 = "Guards"
+        -- n :: Int = nat @n
+    in if not (null as) then errorInProgram $ "GuardsImplX base case has extra data " ++ show as
+       else pure $ mkNode opts (PresentT as) msg0 []
+
+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
+        , [a] ~ x
+        ) => P (GuardsImplX n ('(prt,p) ': ps)) x where
+  type PP (GuardsImplX n ('(prt,p) ': ps)) x = x
+  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 : [hh qq | isVerbose opts])
+                 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]
+         _ -> errorInProgram "GuardsImplX n+1 case has no data"
+
+data GuardsDetail prt (ps :: [(k0,k1)])
+type GuardsDetailT prt (ps :: [(k0,k1)]) = GuardsDetailImpl (ToGuardsDetailT prt ps)
+
+instance P (GuardsDetailT prt ps) x => P (GuardsDetail prt ps) x where
+  type PP (GuardsDetail prt ps) x = PP (GuardsDetailT prt ps) x
+  eval _ = eval (Proxy @(GuardsDetailT prt ps))
+
+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")
+
+-- | 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 Id)) [121,33,7,256]
+-- FailT "id=3 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 Id)) [121,33,7,44]
+-- PresentT [121,33,7,44]
+--
+data GuardsN prt (n :: Nat) p
+type GuardsNT prt (n :: Nat) p = Guards (ToGuardsT prt (RepeatT n p))
+
+instance (x ~ [a], P (GuardsNT prt n p) x) => P (GuardsN prt n p) x where
+  type PP (GuardsN prt n p) x = PP (GuardsNT prt n p) x
+  eval _ = eval (Proxy @(GuardsNT prt n p))
+
+-- | \'p\' is the predicate and on failure of the predicate runs \'prt\'
+--
+-- >>> pz @(Guard "expected > 3" (Gt 3)) 17
+-- PresentT 17
+--
+-- >>> pz @(Guard "expected > 3" (Gt 3)) 1
+-- FailT "expected > 3"
+--
+-- >>> pz @(Guard (PrintF "%d not > 3" Id) (Gt 3)) (-99)
+-- FailT "-99 not > 3"
+--
+data Guard prt p
+
+data ExitWhen prt p
+type ExitWhenT prt p = Guard prt (Not p)
+
+instance P (ExitWhenT prt p) x => P (ExitWhen prt p) x where
+  type PP (ExitWhen prt p) x = PP (ExitWhenT prt p) x
+  eval _ = eval (Proxy @(ExitWhenT prt 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 msg1 -> mkNode opts (FailT msg1) (msg0 <> "(failed) [" <> msg1 <> "]" <> show0 opts " | " a) (hh pp : [hh qq | isVerbose opts])
+      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 a boolean predicate unless you require a failure message instead of true/false
+--
+-- >>> pz @(GuardSimple (Luhn Id)) [1..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]
+-- PresentT [1,2,3,0]
+--
+-- >>> pz @(GuardSimple (Len > 30)) [1,2,3,0]
+-- 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) (subopts opts) a -- temporarily lift DZero to DLite so as not to lose the failure message
+    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 failure
+data Skip p
+
+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]
+
+data p |> q
+type SkipLT p q = Skip p >> q
+infixr 1 |>
+
+instance P (SkipLT p q) x => P (p |> q) x where
+  type PP (p |> q) x = PP (SkipLT p q) x
+  eval _ = eval (Proxy @(SkipLT p q))
+
+data p >| q
+type SkipRT p q = p >> Skip q
+infixr 1 >|
+
+instance P (SkipRT p q) x => P (p >| q) x where
+  type PP (p >| q) x = PP (SkipRT p q) x
+  eval _ = eval (Proxy @(SkipRT p q))
+
+data p >|> q
+type SkipBothT p q = Skip p >> Skip q
+infixr 1 >|>
+
+instance P (SkipBothT p q) x => P (p >|> q) x where
+  type PP (p >|> q) x = PP (SkipBothT p q) x
+  eval _ = eval (Proxy @(SkipBothT p q))
+
+-- 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')
+-- PresentT 12
+--
+-- >>> pz @(Len *** Succ Id >> ShowP (First (Pred Id))) ([11,12],'x')
+-- PresentT "(1,'y')"
+--
+data p >> q
+infixr 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 (topMessageEgregious qq)) [hh pp, hh qq]
+
+-- bearbeiten! only used by >>
+topMessageEgregious :: TT a -> String
+topMessageEgregious pp = innermost (pp ^. tString)
+  where innermost = ('{':) . reverse . ('}':) . takeWhile (/='{') . dropWhile (=='}') . reverse
+
+data p << q
+type LeftArrowsT p q = q >> p
+infixr 1 <<
+
+instance P (LeftArrowsT p q) x => P (p << q) x where
+  type PP (p << q) x = PP (LeftArrowsT p q) x
+  eval _ = eval (Proxy @(LeftArrowsT p q))
+
+type p >>> q = p >> q
+infixl 1 >>>
+
+-- | similar to 'Prelude.&&'
+--
+-- >>> pz @(Fst Id && Snd Id) (True, True)
+-- TrueT
+--
+-- >>> pz @(Id > 15 && Id < 17) 16
+-- TrueT
+--
+-- >>> pz @(Id > 15 && Id < 17) 30
+-- FalseT
+--
+-- >>> pz @(Fst Id && (Length (Snd Id) >= 4)) (True,[11,12,13,14])
+-- TrueT
+--
+-- >>> pz @(Fst Id && (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
+-- 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 <- runPQBool 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])
+-- TrueT
+--
+-- >>> pz @(Not (Fst Id) || (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
+-- 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 <- runPQBool 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])
+-- TrueT
+--
+-- >>> pz @(Fst Id ~> (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
+-- FalseT
+--
+-- >>> pz @(Fst Id ~> (Length (Snd Id) == 4)) (False,[12,11,12,13,14])
+-- TrueT
+--
+-- >>> pz @(Fst Id ~> (Length (Snd Id) >= 4)) (False,[11,12,13,14])
+-- 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 <- runPQBool 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
+-- TrueT
+--
+-- >>> pz @(Not Id) True
+-- FalseT
+--
+-- >>> pz @(Not (Fst Id)) (True,22)
+-- 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 <- evalBool (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]
+
+-- | 'id' function on a boolean
+--
+-- >>> pz @(IdBool Id) False
+-- FalseT
+--
+-- >>> pz @(IdBool Id) True
+-- TrueT
+--
+-- >>> pz @(IdBool (Fst Id)) (True,22)
+-- TrueT
+--
+-- >>> pl @(IdBool (Lt 3)) 13
+-- False (IdBool (13 < 3))
+-- FalseT
+--
+data IdBool p
+
+instance (PP p x ~ Bool, P p x) => P (IdBool p) x where
+  type PP (IdBool p) x = Bool
+  eval _ opts x = do
+    let msg0 = "IdBool"
+    pp <- evalBool (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let b = p
+        in mkNodeB opts b (msg0 <> " " <> topMessage pp) [hh pp]
+
+-- | similar to 'compare'
+--
+-- >>> pz @(Fst Id ==! Snd Id) (10,9)
+-- PresentT GT
+--
+-- >>> pz @(14 % 3 ==! Fst Id -% Snd Id) (-10,7)
+-- PresentT GT
+--
+-- >>> pz @(Fst Id ==! Snd Id) (10,11)
+-- PresentT LT
+--
+-- >>> pz @(Snd Id ==! (Fst Id >> Snd Id >> Head Id)) (('x',[10,12,13]),10)
+-- PresentT EQ
+--
+-- >>> pz @(Snd Id ==! Head (Snd (Fst Id))) (('x',[10,12,13]),10)
+-- PresentT EQ
+--
+
+data p ==! q
+infix 4 ==!
+
+type OrdP p q = p ==! q
+
+instance (Ord (PP p a)
+        , PP p a ~ PP q a
+        , P p a
+        , Show (PP q a)
+        , P q a
+        ) => P (p ==! q) a where
+  type PP (p ==! q) a = Ordering
+  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 d = compare p q
+        in mkNode opts (PresentT d) (msg0 <> " " <> show p <> " " <> prettyOrd d <> show0 opts " " q) [hh pp, hh qq]
+
+data OrdA p
+
+instance P (OrdA' p p) x => P (OrdA p) x where
+  type PP (OrdA p) x = PP (OrdA' p p) x
+  eval _ = eval (Proxy @(OrdA' p p))
+
+data OrdA' p q
+type OrdAT' p q = (Fst Id >> p) ==! (Snd Id >> q)
+
+instance P (OrdAT' p q) x => P (OrdA' p q) x where
+  type PP (OrdA' p q) x = PP (OrdAT' p q) x
+  eval _ = eval (Proxy @(OrdAT' p q))
+
+-- | compare two strings ignoring case
+--
+-- >>> pz @(Fst Id ===~ Snd Id) ("abC","aBc")
+-- PresentT EQ
+--
+-- >>> pz @(Fst Id ===~ Snd Id) ("abC","DaBc")
+-- PresentT LT
+--
+type OrdI p q = p ===~ q
+data p ===~ q
+infix 4 ===~
+
+instance (PP p a ~ String
+        , PP p a ~ PP q a
+        , P p a
+        , P q a
+        ) => P (p ===~ q) a where
+  type PP (p ===~ q) a = Ordering
+  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 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\'
+--
+-- >>> pl @(Lt 4) 123
+-- False (123 < 4)
+-- FalseT
+--
+-- >>> pl @(Lt 4) 1
+-- True (1 < 4)
+-- TrueT
+--
+-- >>> pl @(Negate 7 <..> 20) (-4)
+-- True (-7 <= -4 <= 20)
+-- TrueT
+--
+-- >>> pl @(Negate 7 <..> 20) 21
+-- False (21 <= 20)
+-- FalseT
+--
+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 _ Id) ("aBc" :: String)
+-- PresentT [(0,'a'),(1,'B'),(2,'c')]
+--
+data IToList' t p
+
+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]
+
+data IToList (t :: Type) p
+type IToListT (t :: Type) p = IToList' (Hole t) p
+
+instance P (IToListT t p) x => P (IToList t p) x where
+  type PP (IToList t p) x = PP (IToListT t p) x
+  eval _ = eval (Proxy @(IToListT t p))
+
+-- | similar to 'toList'
+--
+-- >>> pz @ToList ("aBc" :: String)
+-- PresentT "aBc"
+--
+-- >>> pz @ToList (Just 14)
+-- PresentT [14]
+--
+-- >>> pz @ToList Nothing
+-- PresentT []
+--
+-- >>> pz @ToList (Left "xx")
+-- PresentT []
+--
+-- >>> pz @ToList (These 12 "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)
+-- PresentT "aBc"
+--
+-- >>> pz @(ToList' Id) (Just 14)
+-- PresentT [14]
+--
+-- >>> pz @(ToList' Id) Nothing
+-- PresentT []
+--
+-- >>> pz @(ToList' Id) (Left "xx")
+-- PresentT []
+--
+-- >>> pz @(ToList' Id) (These 12 "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 pan (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')])
+-- PresentT [(1,'x'),(4,'y')]
+--
+-- >>> pz @ToListExt (T.pack "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) []
+
+-- | invokes 'GE.fromList'
+--
+-- >>> import qualified Data.Set as Set
+-- >>> run @('OMsg "Fred" ':# 'ODebug 'DLite ':# 'ONoColor 'True) @(FromList (Set.Set Int) << '[2,1,5,5,2,5,2]) ()
+-- Fred >>> Present fromList [1,2,5] ((>>) fromList [1,2,5] | {FromList fromList [1,2,5]})
+-- PresentT (fromList [1,2,5])
+--
+data FromList (t :: Type) -- doesnt work with OverloadedLists unless you cast to [a] explicitly
+
+instance (a ~ GE.Item t
+        , Show t
+        , GE.IsList t
+        , [a] ~ x
+        ) => P (FromList t) x where
+  type PP (FromList t) x = 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")]
+-- 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")
+-- TrueT
+--
+-- >>> pz @(IsThis Id) (These 1 'a')
+-- FalseT
+--
+-- >>> pz @(IsThese Id) (These 1 'a')
+-- TrueT
+--
+-- >>> pl @(IsThat Id) (This 12)
+-- False (IsThat | This 12)
+-- FalseT
+--
+-- >>> pl @(IsThis Id) (This 12)
+-- True (IsThis | This 12)
+-- TrueT
+--
+-- >>> pl @(IsThese Id) (This 12)
+-- False (IsThese | This 12)
+-- FalseT
+--
+-- >>> pl @(IsThese Id) (These 'x' 12)
+-- True (IsThese | These 'x' 12)
+-- TrueT
+--
+data IsTh (th :: These x y) p -- x y can be anything
+
+-- 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 = "Is"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let (t,f) = getThese @th
+            b = f p
+        in mkNodeB opts b (msg0 <> t <> show1 opts " | " p) [hh pp]
+
+data IsThis p
+type IsThisT p = IsTh ('This '()) p
+
+instance P (IsThisT p) x => P (IsThis p) x where
+  type PP (IsThis p) x = PP (IsThisT p) x
+  eval _ = evalBool (Proxy @(IsThisT p))
+
+data IsThat p
+type IsThatT p = IsTh ('That '()) p
+
+instance P (IsThatT p) x => P (IsThat p) x where
+  type PP (IsThat p) x = PP (IsThatT p) x
+  eval _ = evalBool (Proxy @(IsThatT p))
+
+data IsThese p
+type IsTheseT p = IsTh ('These '() '()) p
+
+instance P (IsTheseT p) x => P (IsThese p) x where
+  type PP (IsThese p) x = PP (IsTheseT p) x
+  eval _ = evalBool (Proxy @(IsTheseT p))
+
+-- | similar to 'Data.These.these'
+--
+-- >>> pz @(TheseIn Id Len (Fst Id + Length (Snd Id))) (This 13)
+-- PresentT 13
+--
+-- >>> pz @(TheseIn Id Len (Fst Id + Length (Snd Id))) (That "this is a long string")
+-- PresentT 21
+--
+-- >>> pz @(TheseIn Id Len (Fst Id + Length (Snd Id))) (These 20 "somedata")
+-- PresentT 28
+--
+-- >>> pz @(TheseIn (MkLeft _ Id) (MkRight _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (That "this is a long string")
+-- PresentT (Right "this is a long string")
+--
+-- >>> pz @(TheseIn (MkLeft _ Id) (MkRight _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (These 1 "this is a long string")
+-- PresentT (Right "this is a long string")
+--
+-- >>> pz @(TheseIn (MkLeft _ Id) (MkRight _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (These 100 "this is a long string")
+-- PresentT (Left 100)
+--
+data TheseIn p q r
+
+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 th = do
+     let msg0 = "TheseIn"
+     case th of
+        This a -> do
+          let msg1 = "This "
+              msg2 = msg0 <> msg1
+          pp <- eval (Proxy @p) opts a
+          pure $ case getValueLR opts (msg2 <> "p failed") pp [] of
+               Left e -> e
+               Right c -> mkNode opts (PresentT c) (show01' opts msg0 c msg1 a) [hh pp]
+        That b -> do
+          let msg1 = "That "
+              msg2 = msg0 <> msg1
+          qq <- eval (Proxy @q) opts b
+          pure $ case getValueLR opts (msg2 <> "q failed") qq [] of
+               Left e -> e
+               Right c -> mkNode opts (PresentT c) (show01' opts msg0 c msg1 b) [hh qq]
+        These a b -> do
+          let msg1 = "These "
+              msg2 = msg0 <> msg1
+          rr <- eval (Proxy @r) opts (a,b)
+          pure $ case getValueLR opts (msg2 <> "r failed") rr [] of
+               Left e -> e
+               Right c -> mkNode opts (PresentT c) (show01 opts msg0 c (These a b)) [hh rr]
+
+data TheseId p q
+type TheseIdT p q = TheseIn '(I, p) '(q, I) I
+
+instance P (TheseIdT p q) x => P (TheseId p q) x where
+  type PP (TheseId p q) x = PP (TheseIdT p q) x
+  eval _ = eval (Proxy @(TheseIdT p q))
+-- | creates an empty list of the given type
+--
+-- >>> pz @(Id :+ EmptyList _) 99
+-- PresentT [99]
+--
+data EmptyList' t
+
+instance P (EmptyList' t) x where
+  type PP (EmptyList' t) x = [PP t x]
+  eval _ opts _ =
+    pure $ mkNode opts (PresentT []) "EmptyList" []
+
+data EmptyList (t :: Type)
+type EmptyListT (t :: Type) = EmptyList' (Hole t)
+
+instance P (EmptyList t) x where
+  type PP (EmptyList t) x = PP (EmptyListT t) x
+  eval _ = eval (Proxy @(EmptyListT t))
+
+-- | creates a singleton from a value
+--
+-- >>> pz @(Singleton (Char1 "aBc")) ()
+-- PresentT "a"
+--
+-- >>> pz @(Singleton Id) False
+-- PresentT [False]
+--
+-- >>> pz @(Singleton (Snd Id)) (False,"hello")
+-- PresentT ["hello"]
+--
+data Singleton p
+
+instance P p x => P (Singleton p) x where
+  type PP (Singleton p) x = [PP p x]
+  eval _ opts x = do
+    let msg0 = "Singleton"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p -> mkNode opts (PresentT [p]) msg0 [hh pp]
+
+--type Singleton p = p :+ EmptyT [] p
+
+-- | extracts the first character from a non empty 'Symbol'
+--
+-- >>> pz @(Char1 "aBc") ()
+-- PresentT 'a'
+--
+data Char1 (s :: Symbol)  -- gets the first char from the Symbol [requires that Symbol is not empty]
+instance (KnownSymbol s, GL.CmpSymbol s "" ~ 'GT) => P (Char1 s) a where
+  type PP (Char1 s) a = Char
+  eval _ opts _ =
+     case symb @s of
+       [] -> errorInProgram "Char1: found empty Symbol/string"
+       c:_ -> 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])
+-- PresentT [These 'a' 1,These 'B' 2,These 'c' 3,That 4,That 5]
+--
+-- >>> pz @(ZipThese (Fst Id) (Snd Id)) ("aBcDeF", [1..3])
+-- PresentT [These 'a' 1,These 'B' 2,These 'c' 3,This 'D',This 'e',This 'F']
+--
+-- >>> pz @(ZipThese Id Reverse) "aBcDeF"
+-- PresentT [These 'a' 'F',These 'B' 'e',These 'c' 'D',These 'D' 'c',These 'e' 'B',These 'F' 'a']
+--
+-- >>> pz @(ZipThese Id '[]) "aBcDeF"
+-- PresentT [This 'a',This 'B',This 'c',This 'D',This 'e',This 'F']
+--
+-- >>> pz @(ZipThese '[] Id) "aBcDeF"
+-- PresentT [That 'a',That 'B',That 'c',That 'D',That 'e',That 'F']
+--
+-- >>> pz @(ZipThese '[] '[]) "aBcDeF"
+-- PresentT []
+--
+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 hhs = [hh pp, hh qq]
+        in case chkSize opts msg0 p hhs <* chkSize opts msg0 q hhs of
+          Left e -> e
+          Right () ->
+            let d = simpleAlign p q
+            in mkNode opts (PresentT d) (show01' opts msg0 d "p=" p <> show1 opts " | q=" q) hhs
+
+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 failure 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])
+-- PresentT [('a',1),('b',2),('c',3),('Z',4),('Z',5)]
+--
+-- >>> pz @(ZipPad (Char1 "Z") 99 (Fst Id) (Snd Id)) ("abcdefg", [1..5])
+-- 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])
+-- PresentT [('a',1),('b',2),('c',3),('d',4),('e',5)]
+--
+-- >>> pz @(ZipPad (Char1 "Z") 99 (Fst Id) (Snd Id)) ("", [1..5])
+-- PresentT [('Z',1),('Z',2),('Z',3),('Z',4),('Z',5)]
+--
+-- >>> pz @(ZipPad (Char1 "Z") 99 (Fst Id) (Snd Id)) ("abcde", [])
+-- 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 (ZipL(3,2) | p=[1,2,3] | q="ab")
+-- 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 <> 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 (ZipR(2,3) | p=[1,2] | q="abc")
+-- 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 <> 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 (Zip(3,2) | p=[1,2,3] | q="ab")
+-- FailT "Zip(3,2) length mismatch"
+--
+-- >>> pl @(Zip '[1,2] "abc") ()
+-- Error Zip(2,3) length mismatch (Zip(2,3) | p=[1,2] | q="abc")
+-- 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 <> show1 opts " | p=" p <> show1 opts " | q=" q) hhs
+
+-- | Luhn predicate check on last digit
+--
+-- >>> pz @(Luhn Id) [1,2,3,0]
+-- TrueT
+--
+-- >>> pz @(Luhn Id) [1,2,3,4]
+-- FalseT
+--
+-- >>> pz @(GuardSimple (Luhn Id)) [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"
+-- PresentT 4077
+--
+-- >>> pz @(ReadBase Int 16 Id) "-ff"
+-- PresentT (-255)
+--
+-- >>> pz @(ReadBase Int 2 Id) "10010011"
+-- PresentT 147
+--
+-- >>> pz @(ReadBase Int 8 Id) "Abff"
+-- FailT "invalid base 8"
+--
+-- >>> pl @(ReadBase Int 16 Id >> GuardSimple (Id > 0xffff) >> ShowBase 16 Id) "12344"
+-- Present "12344" ((>>) "12344" | {ShowBase(16) 12344 | 74564})
+-- PresentT "12344"
+--
+-- >>> :set -XBinaryLiterals
+-- >>> pz @(ReadBase Int 16 Id >> GuardSimple (Id > 0b10011111) >> ShowBase 16 Id) "7f"
+-- FailT "(127 > 159)"
+--
+
+-- supports negative numbers unlike readInt
+data ReadBase' t (n :: Nat) p
+
+instance (Typeable (PP t x)
+        , ZwischenT 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]
+
+data ReadBase (t :: Type) (n :: Nat) p
+type ReadBaseT (t :: Type) (n :: Nat) p = ReadBase' (Hole t) n p
+
+instance P (ReadBaseT t n p) x => P (ReadBase t n p) x where
+  type PP (ReadBase t n p) x = PP (ReadBaseT t n p) x
+  eval _ = eval (Proxy @(ReadBaseT t n p))
+
+getValidBase :: Int -> String
+getValidBase n =
+  let xs = ['0'..'9'] <> ['a'..'z']
+      len = length xs
+  in if n > len || n < 2 then errorInProgram $ "getValidBase: 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
+-- PresentT "fed"
+--
+-- >>> pz @(ShowBase 16 Id) (-255)
+-- PresentT "-ff"
+--
+-- >>> pz @(ShowBase 2 Id) 147
+-- PresentT "10010011"
+--
+-- >>> pz @(ShowBase 2 (Negate 147)) "whatever"
+-- 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) [hh pp]
+
+-- | intercalate two lists
+--
+-- >>> pz @(Intercalate '["aB"] '["xxxx","yz","z","www","xyz"]) ()
+-- PresentT ["xxxx","aB","yz","aB","z","aB","www","aB","xyz"]
+--
+-- >>> pz @(Intercalate '[W 99,Negate 98] Id) [1..5]
+-- PresentT [1,99,-98,2,99,-98,3,99,-98,4,99,-98,5]
+--
+-- >>> pz @(Intercalate '[99,100] Id) [1..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 hhs = [hh pp, hh qq]
+        in case chkSize opts msg0 p hhs <* chkSize opts msg0 q hhs of
+          Left e -> e
+          Right () ->
+            let d = intercalate p (map pure q)
+            in mkNode opts (PresentT d) (show01 opts msg0 d p <> show1 opts " | " q) hhs
+
+-- | uses PrintF to format output for a single value
+--
+-- >>> pz @(PrintF "value=%03d" Id) 12
+-- PresentT "value=012"
+--
+-- >>> pz @(PrintF "%s" (Fst Id)) ("abc",'x')
+-- PresentT "abc"
+--
+-- >>> pz @(PrintF "%d" (Fst Id)) ("abc",'x')
+-- 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]
+-- PresentT [10,21,120]
+--
+-- >>> pz @(Para '[Id,Id + 1,Id * 4]) [10,20,30,40]
+-- FailT "Para:invalid length(4) expected 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 ([a] ~ x
+        , GetLen ps
+        , P (ParaImpl (LenT ps) ps) x
+        ) => P (Para ps) x where
+  type PP (Para ps) x = PP (ParaImpl (LenT ps) ps) x
+  eval _ opts as = do
+    let msg0 = "Para"
+        n = getLen @ps
+    if n /= length as then
+       let msg1 = msg0 <> badLength as n
+       in pure $ mkNode opts (FailT msg1) msg1 []
+    else eval (Proxy @(ParaImpl (LenT ps) ps)) opts as
+
+-- only allow non empty lists -- might need [a] ~ x but it seems fine
+instance GL.TypeError ('GL.Text "ParaImpl '[] invalid: requires at least one value in the list")
+   => P (ParaImpl n ('[] :: [k])) x where
+  type PP (ParaImpl n ('[] :: [k])) x = Void
+  eval _ _ _ = errorInProgram "ParaImpl empty list"
+
+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 problem
+          Right b -> mkNode opts (PresentT [b]) (msgbase1 <> show0 opts " " [b] <> show1 opts " | " a) [hh pp]
+      _ -> errorInProgram $ "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]
+       _ -> errorInProgram "ParaImpl n+1 case has no data left"
+
+-- | leverages 'Para' for repeating predicates (passthrough method)
+--
+-- >>> pz @(ParaN 4 (Succ Id)) [1..4]
+-- PresentT [2,3,4,5]
+--
+-- >>> pz @(ParaN 4 (Succ Id)) "azwxm"
+-- FailT "Para:invalid length(5) expected 4"
+--
+-- >>> pz @(ParaN 4 (Succ Id)) "azwx"
+-- PresentT "b{xy"
+--
+data ParaN (n :: Nat) p
+
+instance ( P (ParaImpl (LenT (RepeatT n p)) (RepeatT n p)) x
+         , GetLen (RepeatT n p)
+         , x ~ [a]
+         ) => P (ParaN n p) x where
+  type PP (ParaN n p) x = PP (Para (RepeatT n p)) x
+  eval _ = eval (Proxy @(Para (RepeatT n p)))
+
+-- | 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 (Failt _ "asdf") '[Lt 4,Lt 10,Same 50] '[PrintF "%d is lt4" Id, PrintF "%d is lt10" Id, PrintF "%d is same50" Id] Id) 50
+-- PresentT "50 is same50"
+--
+-- >>> pz @(Case (Failt _ "asdf") '[Lt 4,Lt 10,Same 50] '[PrintF "%d is lt4" Id, PrintF "%d is lt10" Id, PrintF "%d is same50" Id] Id) 9
+-- PresentT "9 is lt10"
+--
+-- >>> pz @(Case (Failt _ "asdf") '[Lt 4,Lt 10,Same 50] '[PrintF "%d is lt4" Id, PrintF "%d is lt10" Id, PrintF "%d is same50" Id] Id) 3
+-- PresentT "3 is lt4"
+--
+-- >>> pz @(Case (Failt _ "asdf") '[Lt 4,Lt 10,Same 50] '[PrintF "%d is lt4" Id, PrintF "%d is lt10" Id, PrintF "%d is same50" Id] Id) 99
+-- FailT "asdf"
+--
+-- >>> pz @(Case (FailS "asdf" >> Snd Id >> Unproxy) '[Lt 4,Lt 10,Same 50] '[PrintF "%d is lt4" Id, PrintF "%d is lt10" Id, PrintF "%d is same50" Id] Id) 99
+-- FailT "asdf"
+--
+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)
+data Case' (ps :: [k]) (qs :: [k1]) (r :: k2)
+data Case'' s (ps :: [k]) (qs :: [k1]) (r :: k2)
+
+type CaseT' (ps :: [k]) (qs :: [k1]) (r :: k2) = Case (Snd Id >> Failp "Case:no match") ps qs r
+type CaseT'' s (ps :: [k]) (qs :: [k1]) (r :: k2) = Case (FailCaseT s) ps qs r -- eg s= PrintF "%s" (ShowP Id)
+
+instance P (CaseT'' s ps qs r) x => P (Case'' s ps qs r) x where
+  type PP (Case'' s ps qs r) x = PP (CaseT'' s ps qs r) x
+  eval _ = eval (Proxy @(CaseT'' s ps qs r))
+
+instance P (CaseT' ps qs r) x => P (Case' ps qs r) x where
+  type PP (Case' ps qs r) x = PP (CaseT' ps qs r) x
+  eval _ = eval (Proxy @(CaseT' ps qs r))
+
+type FailCaseT p = Fail (Snd Id >> Unproxy) (Fst Id >> p)
+
+type CaseImplT e ps qs r = CaseImpl (LenT ps) e ps qs r
+
+-- 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 (CaseImplT e ps qs r) x
+        ) => P (Case e ps qs r) x where
+  type PP (Case e ps qs r) x = PP (CaseImplT e ps qs r) x
+  eval _ = eval (Proxy @(CaseImplT 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 _ _ _ = errorInProgram "CaseImpl lhs empty"
+
+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 _ _ _ = errorInProgram "CaseImpl rhs empty"
+
+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 _ _ _ = errorInProgram "CaseImpl both lists empty"
+
+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 | isVerbose opts])
+          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 : [hh qq | isVerbose opts])
+          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]
+-- PresentT (Just [10,20,30])
+--
+-- >>> pz @Sequence [Just 10, Just 20, Just 30, Nothing, Just 40]
+-- PresentT Nothing
+--
+data 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 Traverse p q
+type TraverseT p q = Map p q >> Sequence
+
+instance P (TraverseT p q) x => P (Traverse p q) x where
+  type PP (Traverse p q) x = PP (TraverseT p q) x
+  eval _ = eval (Proxy @(TraverseT p q))
+
+-- | 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 "LICENSE" >> 'Just Id >> Len > 0) ()
+-- TrueT
+--
+-- >>> pz @(FileExists "xyzzy") ()
+-- FalseT
+--
+data ReadFile p
+
+data FileExists p
+type FileExistsT p = IsJust (ReadFile p)
+
+instance P (FileExistsT p) x => P (FileExists p) x where
+  type PP (FileExists p) x = PP (FileExistsT p) x
+  eval _ = evalBool (Proxy @(FileExistsT p))
+
+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) msg1 [hh pp]
+          Just Nothing -> mkNode opts (PresentT Nothing) (msg1 <> " does not exist") [hh pp]
+          Just (Just b) -> mkNode opts (PresentT (Just b)) (msg1 <> " len=" <> show (length b) <> showLit0 opts " Just " b) [hh pp]
+
+-- | does the directory exists
+--
+-- >>> pz @(DirExists ".") ()
+-- TrueT
+--
+data ReadDir p
+data DirExists p
+type DirExistsT p = IsJust (ReadDir p)
+
+instance P (DirExistsT p) x => P (DirExists p) x where
+  type PP (DirExists p) x = PP (DirExistsT p) x
+  eval _ = evalBool (Proxy @(DirExistsT p))
+
+
+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) msg1 [hh pp]
+          Just Nothing -> mkNode opts (PresentT Nothing) (msg1 <> " does not exist") [hh pp]
+          Just (Just b) -> mkNode opts (PresentT (Just b)) (msg1 <> " len=" <> show (length b) <> show0 opts " Just " b) [hh pp]
+
+-- | read an environment variable
+--
+-- >>> pz @(ReadEnv "PATH" >> 'Just Id >> '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) msg1 [hh pp]
+          Just Nothing -> mkNode opts (PresentT Nothing) (msg1 <> " does not exist") [hh pp]
+          Just (Just v) -> mkNode opts (PresentT (Just v)) (msg1 <> showLit0 opts " " v) [hh pp]
+
+-- | read all the environment variables as key value pairs
+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)) []
+
+-- | get the current time using 'UTCTime'
+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) []
+
+-- | get the current time using 'ZonedTime'
+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
+
+-- | append to a file
+data AppendFile (s :: Symbol) p
+type AppendFileT (s :: Symbol) p = WriteFileImpl ('FOther s 'WFAppend) p
+
+instance P (AppendFileT s p) x => P (AppendFile s p) x where
+  type PP (AppendFile s p) x = PP (AppendFileT s p) x
+  eval _ = eval (Proxy @(AppendFileT s p))
+
+
+-- | write to file, overwriting if needed
+data WriteFile' (s :: Symbol) p
+type WriteFileT' (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWriteForce) p
+
+instance P (WriteFileT' s p) x => P (WriteFile' s p) x where
+  type PP (WriteFile' s p) x = PP (WriteFileT' s p) x
+  eval _ = eval (Proxy @(WriteFileT' s p))
+
+-- | write to file, without overwriting
+data WriteFile (s :: Symbol) p
+type WriteFileT (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWrite) p
+
+instance P (WriteFileT s p) x => P (WriteFile s p) x where
+  type PP (WriteFile s p) x = PP (WriteFileT s p) x
+  eval _ = eval (Proxy @(WriteFileT s p))
+
+-- | write a string value to stdout
+data Stdout p
+type StdoutT p = WriteFileImpl 'FStdout p
+
+instance P (StdoutT p) x => P (Stdout p) x where
+  type PP (Stdout p) x = PP (StdoutT p) x
+  eval _ = eval (Proxy @(StdoutT p))
+
+-- | write a string value to stderr
+data Stderr p
+type StderrT p = WriteFileImpl 'FStderr p
+
+instance P (StderrT p) x => P (Stderr p) x where
+  type PP (Stderr p) x = PP (StderrT p) x
+  eval _ = eval (Proxy @(StderrT 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 $ case fh of
+                  FStdout -> fmap (left show) $ E.try @E.SomeException $ putStr ss
+                  FStderr -> fmap (left show) $ E.try @E.SomeException $ putStr 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 (`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]
+
+-- | read in a value of a given type from stdin with a prompt: similar to 'System.IO.readIO'
+type ReadIO (t :: Type) = ReadIO' t "Enter value"
+type ReadIO' (t :: Type) s = Stdout (s <> ":") >> Stdin >> ReadP t Id
+-- eg pa @(ReadIO Int + ReadIO Int) ()
+
+-- | read a value from stdin
+data Stdin
+
+instance P Stdin x where
+  type PP Stdin x = String
+  eval _ opts _x = do
+    let msg0 = "Stdin"
+    mb <- runIO $ do
+                      lr <- E.try getLine
+                      pure $ case lr of
+                        Left (e :: E.SomeException) -> Left $ show e
+                        Right ss -> Right ss
+    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") ()
+-- TrueT
+--
+-- >>> pz @(IsPrefixI "abc" "aBcbCd") ()
+-- TrueT
+--
+-- >>> pz @(IsPrefix "abc" "aBcbCd") ()
+-- FalseT
+--
+-- >>> pz @(IsSuffix "bCd" "aBcbCd") ()
+-- TrueT
+--
+data IsFixImpl (cmp :: Ordering) (ignore :: Bool) 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]
+
+data IsPrefix p q
+type IsPrefixT p q = IsFixImpl 'LT 'False p q
+
+instance P (IsPrefixT p q) x => P (IsPrefix p q) x where
+  type PP (IsPrefix p q) x = PP (IsPrefixT p q) x
+  eval _ = evalBool (Proxy @(IsPrefixT p q))
+
+data IsInfix p q
+type IsInfixT p q = IsFixImpl 'EQ 'False p q
+
+instance P (IsInfixT p q) x => P (IsInfix p q) x where
+  type PP (IsInfix p q) x = PP (IsInfixT p q) x
+  eval _ = evalBool (Proxy @(IsInfixT p q))
+
+data IsSuffix p q
+type IsSuffixT p q = IsFixImpl 'GT 'False p q
+
+instance P (IsSuffixT p q) x => P (IsSuffix p q) x where
+  type PP (IsSuffix p q) x = PP (IsSuffixT p q) x
+  eval _ = evalBool (Proxy @(IsSuffixT p q))
+
+data IsPrefixI p q
+type IsPrefixIT p q = IsFixImpl 'LT 'True p q
+
+instance P (IsPrefixIT p q) x => P (IsPrefixI p q) x where
+  type PP (IsPrefixI p q) x = PP (IsPrefixIT p q) x
+  eval _ = evalBool (Proxy @(IsPrefixIT p q))
+
+data IsInfixI p q
+type IsInfixIT p q = IsFixImpl 'EQ 'True p q
+
+instance P (IsInfixIT p q) x => P (IsInfixI p q) x where
+  type PP (IsInfixI p q) x = PP (IsInfixIT p q) x
+  eval _ = evalBool (Proxy @(IsInfixIT p q))
+
+data IsSuffixI p q
+type IsSuffixIT p q = IsFixImpl 'GT 'True p q
+
+instance P (IsSuffixIT p q) x => P (IsSuffixI p q) x where
+  type PP (IsSuffixI p q) x = PP (IsSuffixIT p q) x
+  eval _ = evalBool (Proxy @(IsSuffixIT p q))
+
+-- | similar to 'SG.<>'
+--
+-- >>> pz @(Fst Id <> Snd Id) ("abc","def")
+-- PresentT "abcdef"
+--
+-- >>> pz @("abcd" <> "ef" <> Id) "ghi"
+-- PresentT "abcdefghi"
+--
+-- >>> pz @("abcd" <> "ef" <> Id) "ghi"
+-- PresentT "abcdefghi"
+--
+-- >>> pz @(Wrap (SG.Sum _) Id <> FromInteger _ 10) 13
+-- PresentT (Sum {getSum = 23})
+--
+-- >>> pz @(Wrap (SG.Product _) Id <> FromInteger _ 10) 13
+-- PresentT (Product {getProduct = 130})
+--
+-- >>> pz @('(FromInteger _ 10,"def") <> Id) (SG.Sum 12, "_XYZ")
+-- PresentT (Sum {getSum = 22},"def_XYZ")
+--
+-- >>> pz @(SapA' (SG.Max _)) (10,12)
+-- PresentT (Max {getMax = 12})
+--
+-- >>> pz @(SapA' (SG.Sum _)) (10,12)
+-- PresentT (Sum {getSum = 22})
+--
+data p <> q
+infixr 6 <>
+
+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]
+
+data SapA' (t :: Type)
+type SapAT' (t :: Type) = Wrap t (Fst Id) <> Wrap t (Snd Id)
+
+instance P (SapAT' t) x => P (SapA' t) x where
+  type PP (SapA' t) x = PP (SapAT' t) x
+  eval _ = eval (Proxy @(SapAT' t))
+
+data SapA
+type SapAT = Fst Id <> Snd Id
+
+instance P SapAT x => P SapA x where
+  type PP SapA x = PP SapAT x
+  eval _ = eval (Proxy @SapAT)
+
+-- | 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 of size two or larger
+--
+-- >>> 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)
+-- PresentT "fst=ab snd=123"
+--
+-- >>> pz @(PrintT "fst=%s snd=%03d thd=%s" Id) ("ab",123,"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) (PrintT s=%d %c %s)
+-- 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) (PrintT s=%d %c %s)
+-- 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  -- use 'PrintT' as it is safer than 'PrintL'
+--
+-- >>> 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"
+--
+-- >>> pz @(PrintL 1 "%05d" '[Id]) 123  -- tick is required for a one element list (use 'PrintF')
+-- PresentT "00123"
+--
+-- >>> pz @(PrintL 2 "%d %05d" [Fst Id,Snd Id]) (29,123)
+-- PresentT "29 00123"
+--
+-- >>> 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 (PrintL(2) wrong length 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 (PrintL(4) wrong length 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)
+-- 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)
+-- PresentT (Just "abc")
+--
+type ArrowRT p q = q <* p
+data p *> q
+infixl 4 *>
+
+instance P (ArrowRT p q) x => P (p *> q) x where
+  type PP (p *> q) x = PP (ArrowRT p q) x
+  eval _ = eval (Proxy @(ArrowRT p q))
+
+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)
+-- PresentT (Just 20)
+--
+-- >>> pz @(Fst Id <|> Snd Id) (Just 10,Just 20)
+-- PresentT (Just 10)
+--
+-- >>> pz @(Fst Id <|> Snd Id) (Nothing,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)
+-- PresentT (Just 20)
+--
+-- >>> pz @Extract (Identity 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")
+-- 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))
+-- PresentT (Just 20)
+--
+-- >>> pz @Join  ["ab","cd","","ef"]
+-- 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)
+-- PresentT 64
+--
+-- pz @(Id $$ "def") ("abc"<>)
+-- 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) (msg0 <> " " <> 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)
+-- PresentT 64
+--
+-- pz @("def" $& Id) ("abc"<>)
+-- 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) (msg0 <> " " <> 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 @(TrimBoth (Snd Id)) (20," abc   " :: String)
+-- PresentT "abc"
+--
+-- >>> pz @(TrimBoth (Snd Id)) (20,T.pack " abc   ")
+-- PresentT "abc"
+--
+-- >>> pz @(TrimL (Snd Id)) (20," abc   ")
+-- PresentT "abc   "
+--
+-- >>> pz @(TrimR (Snd Id)) (20," abc   ")
+-- PresentT " abc"
+--
+-- >>> pz @(TrimR "  abc ") ()
+-- PresentT "  abc"
+--
+-- >>> pz @(TrimR "") ()
+-- PresentT ""
+--
+-- >>> pz @(TrimBoth "         ") ()
+-- PresentT ""
+--
+-- >>> pz @(TrimBoth "") ()
+-- PresentT ""
+--
+data TrimImpl (left :: Bool) (right :: Bool) p
+
+instance (FailUnlessT (OrT l r)
+           ('GL.Text "TrimImpl: left and right cannot both be False")
+        , GetBool l
+        , GetBool r
+        , DTL.IsText (PP p x)
+        , P p x
+        ) => P (TrimImpl l r p) x where
+  type PP (TrimImpl l r p) x = PP p x
+  eval _ opts x = do
+    let msg0 = "Trim" ++ (if l && r then "Both" else if l then "L" else "R")
+        l = getBool @l
+        r = getBool @r
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right (view DTL.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 ^. DTL.packed)) (msg0 <> showLit0 opts "" b <> showLit1 opts " | " p) [hh pp]
+
+data TrimL p
+type TrimLT p = TrimImpl 'True 'False p
+
+instance P (TrimLT p) x => P (TrimL p) x where
+  type PP (TrimL p) x = PP (TrimLT p) x
+  eval _ = eval (Proxy @(TrimLT p))
+
+data TrimR p
+type TrimRT p = TrimImpl 'False 'True p
+
+instance P (TrimRT p) x => P (TrimR p) x where
+  type PP (TrimR p) x = PP (TrimRT p) x
+  eval _ = eval (Proxy @(TrimRT p))
+
+data TrimBoth p
+type TrimBothT p = TrimImpl 'True 'True p
+
+instance P (TrimBothT p) x => P (TrimBoth p) x where
+  type PP (TrimBoth p) x = PP (TrimBothT p) x
+  eval _ = eval (Proxy @(TrimBothT p))
+
+-- | similar to 'T.stripLeft' 'T.stripRight'
+--
+-- >>> pz @(StripL "xyz" Id) ("xyzHello" :: String)
+-- PresentT (Just "Hello")
+--
+-- >>> pz @(StripL "xyz" Id) (T.pack "xyzHello")
+-- PresentT (Just "Hello")
+--
+-- >>> pz @(StripL "xyz" Id) "xywHello"
+-- PresentT Nothing
+--
+-- >>> pz @(StripR "xyz" Id) "Hello xyz"
+-- PresentT (Just "Hello ")
+--
+-- >>> pz @(StripR "xyz" Id) "xyzHelloxyw"
+-- PresentT Nothing
+--
+-- >>> pz @(StripR "xyz" Id) ""
+-- PresentT Nothing
+--
+-- >>> pz @(StripR "xyz" "xyz") ()
+-- PresentT (Just "")
+--
+data StripImpl(left :: Bool) p q
+
+instance (GetBool l
+        , PP p x ~ String
+        , P p x
+        , DTL.IsText (PP q x)
+        , P q x
+        ) => P (StripImpl l p q) x where
+  type PP (StripImpl l p q) x = Maybe (PP q x)
+  eval _ opts x = do
+    let msg0 = "Strip" ++ if l then "L" else "R"
+        l = getBool @l
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    pure $ case lr of
+      Left e -> e
+      Right (p,view DTL.unpacked -> q,pp,qq) ->
+        let b = if l then
+                  let (before,after) = splitAt (length p) q
+                  in if before == p then Just after else Nothing
+                else
+                  let (before,after) = splitAt (length q - length p) q
+                  in if after == p then Just before else Nothing
+        in mkNode opts (PresentT (fmap (view DTL.packed) b)) (msg0 <> show0 opts "" b <> showLit1 opts " | p=" p <> showLit1 opts " | q=" q) [hh pp, hh qq]
+
+data StripL p q
+type StripLT p q = StripImpl 'True p q
+
+instance P (StripLT p q) x => P (StripL p q) x where
+  type PP (StripL p q) x = PP (StripLT p q) x
+  eval _ = eval (Proxy @(StripLT p q))
+
+data StripR p q
+type StripRT p q = StripImpl 'False p q
+
+instance P (StripRT p q) x => P (StripR p q) x where
+  type PP (StripR p q) x = PP (StripRT p q) x
+  eval _ = eval (Proxy @(StripRT p q))
+
+-- | creates a promoted list of predicates and then evaluates them into a list. see PP instance for '[k]
+--
+-- >>> pz @(Repeat 4 (Succ Id)) 'c'
+-- PresentT "dddd"
+--
+-- >>> pz @(Repeat 4 "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 _ = eval (Proxy @(RepeatT n p))
+
+-- | 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'
+-- PresentT 'g'
+--
+-- >>> pz @(DoN 4 (Id <> " | ")) "abc"
+-- PresentT "abc |  |  |  | "
+--
+-- >>> pz @(DoN 4 (Id <> "|" <> Id)) "abc"
+-- PresentT "abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc"
+--
+data DoN (n :: Nat) p
+type DoNT (n :: Nat) p = Do (RepeatT n p)
+instance P (DoNT n p) a => P (DoN n p) a where
+  type PP (DoN n p) a = PP (DoNT n p) a
+  eval _ = eval (Proxy @(DoNT n p))
+
+-- | extract the value from a 'Maybe' otherwise use the default value
+--
+-- >>> pz @(JustDef (1 % 4) Id) (Just 20.4)
+-- PresentT (102 % 5)
+--
+-- >>> pz @(JustDef (1 % 4) Id) Nothing
+-- PresentT (1 % 4)
+--
+-- >>> pz @(JustDef (MEmptyT _) Id) (Just "xy")
+-- PresentT "xy"
+--
+-- >>> pz @(JustDef (MEmptyT _) Id) Nothing
+-- PresentT ()
+--
+-- >>> pz @(JustDef (MEmptyT (SG.Sum _)) Id) Nothing
+-- 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 ->
+        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)
+-- PresentT 99
+--
+-- >>> pz @(JustFail "nope" Id) Nothing
+-- FailT "nope"
+--
+-- >>> pz @(JustFail (PrintF "oops=%d" (Snd Id)) (Fst Id)) (Nothing, 123)
+-- FailT "oops=123"
+--
+-- >>> pz @(JustFail (PrintF "oops=%d" (Snd Id)) (Fst Id)) (Just 'x', 123)
+-- 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 ->
+        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)
+-- PresentT (102 % 5)
+--
+-- >>> pz @(LeftDef (1 % 4) Id) (Right "aa")
+-- PresentT (1 % 4)
+--
+-- >>> pz @(LeftDef (PrintT "found right=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Right "xy")
+-- PresentT "found right=xy fst=123"
+--
+-- >>> pz @(LeftDef (MEmptyT _) Id) (Right 222)
+-- PresentT ()
+--
+-- >>> pz @(LeftDef (MEmptyT (SG.Sum _)) Id) (Right 222)
+-- 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 ->
+        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)
+-- PresentT (102 % 5)
+--
+-- >>> pz @(RightDef (1 % 4) Id) (Left "aa")
+-- PresentT (1 % 4)
+--
+-- >>> pz @(RightDef (PrintT "found left=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Left "xy")
+-- PresentT "found left=xy fst=123"
+--
+-- >>> pz @(RightDef (MEmptyT _) Id) (Left 222)
+-- PresentT ()
+--
+-- >>> pz @(RightDef (MEmptyT (SG.Sum _)) Id) (Left 222)
+-- 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 ->
+        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 a 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)
+-- PresentT 20.4
+--
+-- >>> pz @(LeftFail "oops" Id) (Right "aa")
+-- FailT "oops"
+--
+-- >>> pz @(LeftFail (PrintT "found right=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Right "xy")
+-- FailT "found right=xy fst=123"
+--
+-- >>> pz @(LeftFail (MEmptyT _) Id) (Right 222)
+-- 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 ->
+        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 a 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)
+-- PresentT 20.4
+--
+-- >>> pz @(RightFail "oops" Id) (Left "aa")
+-- FailT "oops"
+--
+-- >>> pz @(RightFail (PrintT "found left=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Left "xy")
+-- FailT "found left=xy fst=123"
+--
+-- >>> pz @(RightFail (MEmptyT _) Id) (Left 222)
+-- 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 ->
+        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)
+-- PresentT (102 % 5)
+--
+-- >>> pz @(ThisDef (1 % 4) Id) (That "aa")
+-- PresentT (1 % 4)
+--
+-- >>> pz @(ThisDef (1 % 4) Id) (These 2.3 "aa")
+-- PresentT (1 % 4)
+--
+-- >>> pz @(ThisDef (PrintT "found %s fst=%d" '(ShowP (Snd Id), Fst Id)) (Snd Id)) (123,That "xy")
+-- PresentT "found That \"xy\" fst=123"
+--
+-- >>> pz @(ThisDef (MEmptyT _) Id) (That 222)
+-- PresentT ()
+--
+-- >>> pz @(ThisDef (MEmptyT (SG.Sum _)) Id) (These 222 'x')
+-- 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 ->
+        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 <> " " <> showThese 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)
+-- PresentT (102 % 5)
+--
+-- >>> pz @(ThatDef (1 % 4) Id) (This "aa")
+-- PresentT (1 % 4)
+--
+-- >>> pz @(ThatDef (1 % 4) Id) (These "aa" 2.3)
+-- PresentT (1 % 4)
+--
+-- >>> pz @(ThatDef (PrintT "found %s fst=%d" '(ShowP (Snd Id), Fst Id)) (Snd Id)) (123,This "xy")
+-- PresentT "found This \"xy\" fst=123"
+--
+-- >>> pz @(ThatDef (MEmptyT _) Id) (This 222)
+-- PresentT ()
+--
+-- >>> pz @(ThatDef (MEmptyT (SG.Sum _)) Id) (These 'x' 1120)
+-- 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 ->
+        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 <> " " <> showThese 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")
+-- PresentT (102 % 5,"x")
+--
+-- >>> pz @(TheseDef '(1 % 4,"zz") Id) (This 20.4)
+-- PresentT (1 % 4,"zz")
+--
+-- >>> pz @(TheseDef '(1 % 4,"zz") Id) (That "x")
+-- PresentT (1 % 4,"zz")
+--
+-- >>> pz @(TheseDef '(PrintT "found %s fst=%d" '(ShowP (Snd Id), Fst Id),999) (Snd Id)) (123,This "xy")
+-- PresentT ("found This \"xy\" fst=123",999)
+--
+-- >>> pz @(TheseDef (MEmptyT (SG.Sum _, String)) Id) (This 222)
+-- PresentT (Sum {getSum = 0},"")
+--
+-- >>> pz @(TheseDef (MEmptyT _) Id) (These (222 :: SG.Sum Int) "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 ->
+        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 <> " " <> showThese q) [hh qq, hh pp]
+
+
+-- | extract the This value from a 'These' otherwise fail with a message
+--
+-- if there is no This value then \p\ is passed the whole context only
+--
+-- >>> pz @(ThisFail "oops" Id) (This 20.4)
+-- PresentT 20.4
+--
+-- >>> pz @(ThisFail "oops" Id) (That "aa")
+-- FailT "oops"
+--
+-- >>> pz @(ThisFail (PrintT "found %s fst=%d" '(ShowP (Snd Id),Fst Id)) (Snd Id)) (123,That "xy")
+-- FailT "found That \"xy\" fst=123"
+--
+-- >>> pz @(ThisFail (MEmptyT _) Id) (That 222)
+-- 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 ->
+        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 <> " " <> showThese q) [hh qq, hh pp]
+
+
+-- | extract the That value from a 'These' otherwise fail with a message
+--
+-- if there is no That value then \p\ is passed the whole context only
+--
+-- >>> pz @(ThatFail "oops" Id) (That 20.4)
+-- PresentT 20.4
+--
+-- >>> pz @(ThatFail "oops" Id) (This "aa")
+-- FailT "oops"
+--
+-- >>> pz @(ThatFail (PrintT "found %s fst=%d" '(ShowP (Snd Id),Fst Id)) (Snd Id)) (123,This "xy")
+-- FailT "found This \"xy\" fst=123"
+--
+-- >>> pz @(ThatFail (MEmptyT _) Id) (This 222)
+-- 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 ->
+        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 <> " " <> showThese q) [hh qq, hh pp]
+
+
+
+
+-- | extract the These value from a 'These' otherwise fail with a message
+--
+-- if there is no These value then \p\ is passed the whole context only
+--
+-- >>> pz @(TheseFail "oops" Id) (These "abc" 20.4)
+-- PresentT ("abc",20.4)
+--
+-- >>> pz @(TheseFail "oops" Id) (That "aa")
+-- FailT "oops"
+--
+-- >>> pz @(TheseFail (PrintT "found %s fst=%d" '(ShowP (Snd Id),Fst Id)) (Snd Id)) (123,That "xy")
+-- FailT "found That \"xy\" fst=123"
+--
+-- >>> pz @(TheseFail (MEmptyT _) Id) (That 222)
+-- 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 ->
+        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 <> " " <> showThese q) [hh qq, hh pp]
+
+-- | takes the head of a list like container
+--
+-- >>> pz @(Head Id) "abcd"
+-- PresentT 'a'
+--
+-- >>> pz @(Head Id) []
+-- 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"
+-- PresentT "bcd"
+--
+-- >>> pz @(Tail Id) []
+-- 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"
+-- PresentT 'd'
+--
+-- >>> pz @(Last Id) []
+-- 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"
+-- PresentT "abc"
+--
+-- >>> pz @(Init Id) (T.pack "abcd")
+-- PresentT "abc"
+--
+-- >>> pz @(Init Id) []
+-- 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")
+-- PresentT "abc"
+--
+-- >>> pz @(Just Id) Nothing
+-- 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]
+
+
+-- | compose simple functions
+--
+-- >>> pl @(Dot '[Thd,Snd,Fst] Id) ((1,(2,9,10)),(3,4))
+-- Present 10 (Thd 10 | (2,9,10))
+-- PresentT 10
+--
+data Dot (ps :: [Type -> Type]) (q :: Type)
+instance (P (DotExpandT ps q) a) => P (Dot ps q) a where
+  type PP (Dot ps q) a = PP (DotExpandT ps q) a
+  eval _ = eval (Proxy @(DotExpandT ps q))
+
+type family DotExpandT (ps :: [Type -> Type]) (q :: Type) :: Type where
+  DotExpandT '[] _ = GL.TypeError ('GL.Text "'[] invalid: requires at least one predicate in the list")
+  DotExpandT '[p] q = p $ q
+  DotExpandT (p ': p1 ': ps) q = p $ DotExpandT (p1 ': ps) q
+
+-- | reversed dot
+--
+-- >>> pl @(RDot '[Fst,Snd,Thd] Id) ((1,(2,9,10)),(3,4))
+-- Present 10 (Thd 10 | (2,9,10))
+-- PresentT 10
+--
+-- >>> pl @(RDot '[Fst,Snd] Id) (('a',2),(True,"zy"))
+-- Present 2 (Snd 2 | ('a',2))
+-- PresentT 2
+--
+data RDot (ps :: [Type -> Type]) (q :: Type)
+instance P (RDotExpandT ps q) a => P (RDot ps q) a where
+  type PP (RDot ps q) a = PP (RDotExpandT ps q) a
+  eval _ = eval (Proxy @(RDotExpandT ps q))
+
+type family RDotExpandT (ps :: [Type -> Type]) (q :: Type) :: Type where
+  RDotExpandT '[] _ = GL.TypeError ('GL.Text "'[] invalid: requires at least one predicate in the list")
+  RDotExpandT '[p] q = p $ q
+  RDotExpandT (p ': p1 ': ps) q = RDotExpandT (p1 ': ps) (p $ q)
+
+-- | like 'GHC.Base.$' for expressions
+--
+-- >>> pl @(Fst $ Snd $ Id) ((1,2),(3,4))
+-- Present 3 (Fst 3 | (3,4))
+-- PresentT 3
+--
+-- >>> pl @((<=) 4 $ Fst $ Snd $ Id) ((1,2),(3,4))
+-- False (4 <= 3)
+-- FalseT
+--
+data (p :: k -> k1) $ (q :: k)
+infixr 0 $
+
+instance P (p q) a => P (p $ q) a where
+  type PP (p $ q) a = PP (p q) a
+  eval _  = eval (Proxy @(p q))
+
+-- | similar to 'Control.Lens.&'
+--
+-- >>> pl @(Id & Fst & Singleton & Length) (13,"xyzw")
+-- Present 1 (Length 1 | [13])
+-- PresentT 1
+--
+-- >>> pl @(2 & (&&&) "abc") ()
+-- Present ("abc",2) (W'(,))
+-- PresentT ("abc",2)
+--
+-- >>> pl @(2 & '(,) "abc") ()
+-- Present ("abc",2) ('(,))
+-- PresentT ("abc",2)
+--
+-- >>> pl @('(,) 4 $ '(,) 7 $ "aa") ()
+-- Present (4,(7,"aa")) ('(,))
+-- PresentT (4,(7,"aa"))
+--
+-- >>> pl @(Thd $ Snd $ Fst Id) ((1,("W",9,'a')),(3,4))
+-- Present 'a' (Thd 'a' | ("W",9,'a'))
+-- PresentT 'a'
+--
+data (q :: k) & (p :: k -> k1)
+infixl 1 &
+
+instance P (p q) a => P (q & p) a where
+  type PP (q & p) a = PP (p q) a
+  eval _ = eval (Proxy @(p q))
+
+-- | creates a constant expression ignoring the second argument
+--
+-- >>> pl @(RDot '[Fst,Snd,Thd,K "xxx"] Id) ((1,(2,9,10)),(3,4))
+-- Present "xxx" (K'xxx)
+-- PresentT "xxx"
+--
+-- >>> pl @(RDot '[Fst,Snd,Thd,K '("abc",Id)] Id) ((1,(2,9,10)),(3,4))
+-- Present ("abc",((1,(2,9,10)),(3,4))) (K'(,))
+-- PresentT ("abc",((1,(2,9,10)),(3,4)))
+--
+-- >>> pl @(Thd $ Snd $ Fst $ K Id "dud") ((1,("W",9,'a')),(3,4))
+-- Present 'a' (Thd 'a' | ("W",9,'a'))
+-- PresentT 'a'
+--
+-- >>> pl @((Thd $ Snd $ Fst $ K Id "dud") >> Pred Id) ((1,("W",9,'a')),(3,4))
+-- Present '`' ((>>) '`' | {Pred '`' | 'a'})
+-- PresentT '`'
+--
+data K (p :: k) (q :: k1)
+instance P p a => P (K p q) a where
+  type PP (K p q) a = PP p a
+  eval _ = eval (Proxy @(Msg "K" p))
+
+-- | applies \'p\' to the first and second slot of an n-tuple
+--
+-- >>> pl @(Both Len (Fst Id)) (("abc",[10..17],1,2,3),True)
+-- Present (3,8) (Both)
+-- PresentT (3,8)
+--
+-- >>> pl @(Both (Pred Id) $ Fst Id) ((12,'z',[10..17]),True)
+-- Present (11,'y') (Both)
+-- PresentT (11,'y')
+--
+-- >>> pl @(Both (Succ Id) Id) (4,'a')
+-- Present (5,'b') (Both)
+-- PresentT (5,'b')
+--
+-- >>> pl @(Both Len (Fst Id)) (("abc",[10..17]),True)
+-- Present (3,8) (Both)
+-- PresentT (3,8)
+--
+-- >>> pl @(Both (ReadP Day Id) Id) ("1999-01-01","2001-02-12")
+-- Present (1999-01-01,2001-02-12) (Both)
+-- PresentT (1999-01-01,2001-02-12)
+--
+data Both p q
+instance ( ExtractL1C (PP q x)
+         , ExtractL2C (PP q x)
+         , P p (ExtractL1T (PP q x))
+         , P p (ExtractL2T (PP q x))
+         , P q x
+   ) => P (Both p q) x where
+  type PP (Both p q) x = (PP p (ExtractL1T (PP q x)), PP p (ExtractL2T (PP q x)))
+  eval _ opts x = do
+    let msg0 = "Both"
+    qq <- eval (Proxy @q) opts x
+    case getValueLR opts msg0 qq [] of
+      Left e -> pure e
+      Right q -> do
+        let (a,a') = (extractL1C q, extractL2C q)
+        pp <- eval (Proxy @p) opts a
+        case getValueLR opts msg0 pp [hh qq] of
+          Left e -> pure e
+          Right b -> do
+            pp' <- eval (Proxy @p) opts a'
+            pure $ case getValueLR opts msg0 pp' [hh qq, hh pp] of
+              Left e -> e
+              Right b' ->
+                mkNode opts (PresentT (b,b')) msg0 [hh qq, hh pp, hh pp']
+
+-- | gets the singleton value from a foldable
+--
+-- >>> pl @(OneP Id) [10..15]
+-- Error OneP 6 elements (OneP expected one element)
+-- FailT "OneP 6 elements"
+--
+-- >>> pl @(OneP Id) [10]
+-- Present 10 (OneP)
+-- PresentT 10
+--
+-- >>> pl @(OneP Id) []
+-- Error OneP empty (OneP expected one element)
+-- FailT "OneP empty"
+--
+-- >>> pl @(OneP Id) (Just 10)
+-- Present 10 (OneP)
+-- PresentT 10
+--
+-- >>> pl @(OneP Id) Nothing
+-- Error OneP empty (OneP expected one element)
+-- FailT "OneP empty"
+--
+data OneP p
+instance (Foldable t
+        , PP p x ~ t a
+        , P p x
+        ) => P (OneP p) x where
+  type PP (OneP p) x = ExtractAFromTA (PP p x)
+  eval _ opts x = do
+    let msg0 = "OneP"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p -> case toList p of
+                   [] -> mkNode opts (FailT (msg0 <> " empty")) (msg0 <> " expected one element") [hh pp]
+                   [a] -> mkNode opts (PresentT a) msg0 [hh pp]
+                   as -> let n = length as
+                         in mkNode opts (FailT (msg0 <> " " <> show n <> " elements")) (msg0 <> " expected one element") [hh pp]
+
+-- | parse json data
+--
+-- >>> pl @(ParseJson (Int,String) Id) "[10,\"abc\"]"
+-- Present (10,"abc") (ParseJson (Int,[Char]) (10,"abc"))
+-- PresentT (10,"abc")
+--
+-- >>> pl @(ParseJson (Int,String) Id) "[10,\"abc\",99]"
+-- Error ParseJson (Int,[Char])([10,"abc",...) Error in $ (ParseJson (Int,[Char]) failed Error in $: cannot unpack array of length 3 into a tuple of length 2 | [10,"abc",99])
+-- FailT "ParseJson (Int,[Char])([10,\"abc\",...) Error in $"
+--
+-- >>> pl @(ParseJson (Int,Bool) (FromString _ Id)) ("[1,true]" :: String)
+-- Present (1,True) (ParseJson (Int,Bool) (1,True))
+-- PresentT (1,True)
+--
+-- >>> pl @(ParseJson (Int,Bool) Id) (A.encode (1,True))
+-- Present (1,True) (ParseJson (Int,Bool) (1,True))
+-- PresentT (1,True)
+--
+-- >>> pl @(ParseJson () Id) "[1,true]"
+-- Error ParseJson ()([1,true]) Error in $ (ParseJson () failed Error in $: parsing () failed, expected an empty array | [1,true])
+-- FailT "ParseJson ()([1,true]) Error in $"
+--
+data ParseJson' t p
+
+instance (P p x
+        , PP p x ~ BL8.ByteString
+        , Typeable (PP t x)
+        , Show (PP t x)
+        , A.FromJSON (PP t x)
+        ) => P (ParseJson' t p) x where
+  type PP (ParseJson' t p) x = PP t x
+  eval _ opts x = do
+    let msg0 = "ParseJson " <> 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 hhs = [hh pp]
+            msg1 = msg0 <> "(" ++ litBL 10 s ++ ")"
+        in case A.eitherDecode' s of
+           Right b -> mkNode opts (PresentT b) (msg0 <> " " ++ showL 30 b) hhs
+           Left e -> mkNode opts (FailT (msg1 <> " " <> takeWhile (/=':') e) ) (msg0 <> " failed " <> e <> " | " <> litBL (oWidth opts) s) hhs
+
+data ParseJson (t :: Type) p
+type ParseJsonT (t :: Type) p = ParseJson' (Hole t) p
+
+instance P (ParseJsonT t p) x => P (ParseJson t p) x where
+  type PP (ParseJson t p) x = PP (ParseJsonT t p) x
+  eval _ = eval (Proxy @(ParseJsonT t p))
+
+-- | parse a json file
+--
+-- >>> pz @(ParseJsonFile [A.Value] "test1.json" >> Id !! 2) ()
+-- PresentT (Object (fromList [("lastName",String "Doe"),("age",Number 45.0),("firstName",String "John"),("likesPizza",Bool False)]))
+--
+data ParseJsonFile' t p
+
+instance (P p x
+        , PP p x ~ String
+        , Typeable (PP t x)
+        , Show (PP t x)
+        , A.FromJSON (PP t x)
+        ) => P (ParseJsonFile' t p) x where
+  type PP (ParseJsonFile' t p) x = PP t x
+  eval _ opts x = do
+    let msg0 = "ParseJsonFile " <> t
+        t = showT @(PP t x)
+    pp <- eval (Proxy @p) opts x
+    case getValueLR opts msg0 pp [] of
+      Left e -> pure e
+      Right p -> do
+        let hhs = [hh pp]
+            msg1 = msg0 <> "(" <> p <> ")"
+        mb <- runIO $ do
+                b <- doesFileExist p
+                if b then Just <$> BS8.readFile p
+                else pure Nothing
+        pure $ case mb of
+          Nothing -> mkNode opts (FailT msg1) msg1 hhs
+          Just Nothing -> mkNode opts (FailT (msg1 <> " file does not exist")) msg1 hhs
+          Just (Just s) ->
+            case A.eitherDecodeStrict' s of
+               Right b -> mkNode opts (PresentT b) (msg1 <> " " ++ showL (if isVerbose opts then oWidth opts else min (oWidth opts) 80) b) hhs
+               Left e -> mkNode opts (FailT (msg1 <> " " <> takeWhile (/=':') e)) (msg0 <> " failed " <> e <> " | " <> litBS (oWidth opts) s) hhs
+
+data ParseJsonFile (t :: Type) p
+type ParseJsonFileT (t :: Type) p = ParseJsonFile' (Hole t) p
+
+instance P (ParseJsonFileT t p) x => P (ParseJsonFile t p) x where
+  type PP (ParseJsonFile t p) x = PP (ParseJsonFileT t p) x
+  eval _ = eval (Proxy @(ParseJsonFileT t p))
+
+-- | encode json
+--
+-- >>> pl @(EncodeJson Id) (10,"def")
+-- Present "[10,\"def\"]" (EncodeJson [10,"def"])
+-- PresentT "[10,\"def\"]"
+--
+-- >>> pl @(EncodeJson Id >> ParseJson (Int,Bool) Id) (1,True)
+-- Present (1,True) ((>>) (1,True) | {ParseJson (Int,Bool) (1,True)})
+-- PresentT (1,True)
+--
+data EncodeJson p
+
+instance (A.ToJSON (PP p x), P p x) => P (EncodeJson p) x where
+  type PP (EncodeJson p) x = BL8.ByteString
+  eval _ opts x = do
+    let msg0 = "EncodeJson"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = A.encode p
+        in mkNode opts (PresentT d) (msg0 <> showLit0 opts " " (litBL (oWidth opts) d)) [hh pp]
+
+-- | encode a json file
+data EncodeJsonFile p q
+
+instance (PP p x ~ String
+        , P p x
+        , A.ToJSON (PP q x)
+        , P q x
+        ) => P (EncodeJsonFile p q) x where
+  type PP (EncodeJsonFile p q) x = ()
+  eval _ opts x = do
+    let msg0 = "EncodeJsonFile"
+    lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x []
+    case lr of
+      Left e -> pure e
+      Right (p,q,pp,qq) -> do
+        let d = A.encode q
+            hhs = [hh pp, hh qq]
+        mb <- runIO $ BL8.writeFile p d
+        pure $ case mb of
+          Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) (msg0 <> " must run in IO") hhs
+          Just () -> mkNode opts (PresentT ()) (msg0 <> showLit0 opts " " (litBL (oWidth opts) d)) hhs
+
+-- | uncurry experiment
+--
+-- >>> pl @(Uncurry Between (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2019-10-12"
+-- False (Uncurry (2019-10-12 <= 2018-12-30))
+-- FalseT
+--
+-- >>> pl @(Uncurry Between (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2017-10-12"
+-- True (Uncurry (2017-04-11 <= 2017-10-12 <= 2018-12-30))
+-- TrueT
+--
+-- >>> pl @(Uncurry Between (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2016-10-12"
+-- False (Uncurry (2017-04-11 <= 2016-10-12))
+-- FalseT
+--
+data Uncurry (p :: Type -> Type -> Type -> Type) q r
+
+instance (PP q x ~ (a,b)
+        , PP (p a b (PP r x)) x ~ PP (p (Fst Id) (Snd Id) (Thd Id)) (a, b, PP r x)
+        , P q x
+        , P r x
+        , P (p (Fst Id) (Snd Id) (Thd Id)) (a,b,PP r x)
+     ) => P (Uncurry p q r) x where
+  type PP (Uncurry p q r) x = PP (p (ExtractL1T (PP q x)) (ExtractL2T (PP q x)) (PP r x)) x
+  eval _ opts x = do
+    let msg0 = "Uncurry"
+    lr <- runPQ msg0 (Proxy @q) (Proxy @r) opts x []
+    case lr of
+      Left e -> pure e
+      Right ((q1,q2),r,qq,rr) -> do
+        let hhs0 = [hh qq, hh rr]
+        pp <- eval (Proxy @(p (Fst Id) (Snd Id) (Thd Id))) opts (q1,q2,r)
+        pure $ case getValueLR opts msg0 pp hhs0 of
+          Left e -> e
+          Right _ ->
+            let hhs = hhs0 ++ [hh pp]
+            in mkNode opts (_tBool pp) (msg0 <> " " <> topMessage pp) hhs
+
+-- | like 'Predicate.Prelude.&&' but for a tuple
+--
+-- >>> pl @(SplitAt 4 "abcdefg" >> Len > 4 &* Len < 5) ()
+-- False ((>>) False | {False (&*) True | (4 > 4)})
+-- FalseT
+--
+data AndA p q r
+instance (PP r x ~ (a,b)
+        , PP p a ~ Bool
+        , PP q b ~ Bool
+        , P p a
+        , P q b
+        , P r x
+        ) => P (AndA p q r) x where
+  type PP (AndA p q r) x = Bool
+  eval _ opts x = do
+    let msg0 = "(&*)"
+    rr <- eval (Proxy @r) opts x
+    case getValueLR opts msg0 rr [] of
+      Left e -> pure e
+      Right (r1,r2) -> do
+        pp <- evalBool (Proxy @p) opts r1
+        case getValueLR opts msg0 pp [hh rr] of
+          Left e -> pure e
+          Right p -> do
+            qq <- evalBool (Proxy @q) opts r2
+            pure $ case getValueLR opts msg0 qq [hh rr, hh pp] of
+              Left e -> e
+              Right q ->
+                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 rr, hh pp, hh qq]
+
+data p &* q
+type AndAT p q = AndA p q Id
+infixr 3 &*
+
+instance P (AndAT p q) x => P (p &* q) x where
+  type PP (p &* q) x = PP (AndAT p q) x
+  eval _ = evalBool (Proxy @(AndAT p q))
+
+{-
+data p &&! q
+type AndAT' p q = (Fst Id >> p) && (Snd Id >> q)
+infixr 3 &&!
+
+instance (P (AndAT' p q) x
+        ) => P (p &&! q) x where
+  type PP (p &&! q) x = PP (AndAT' p q) x
+  eval _ = evalBool (Proxy @(AndAT' p q))
+-}
+
+-- | like 'Predicate.Prelude.||' but for a tuple
+--
+-- >>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,8,14,44],9)
+-- True (True (|+) False)
+-- TrueT
+--
+-- >>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,14],9)
+-- False (False (|+) False | (32 > 44) (|+) (9 < 2))
+-- FalseT
+--
+-- >>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,14],1)
+-- True (False (|+) True)
+-- TrueT
+--
+data OrA p q r
+instance (PP r x ~ (a,b)
+        , PP p a ~ Bool
+        , PP q b ~ Bool
+        , P p a
+        , P q b
+        , P r x
+        ) => P (OrA p q r) x where
+  type PP (OrA p q r) x = Bool
+  eval _ opts x = do
+    let msg0 = "(|+)"
+    rr <- eval (Proxy @r) opts x
+    case getValueLR opts msg0 rr [] of
+      Left e -> pure e
+      Right (r1,r2) -> do
+        pp <- evalBool (Proxy @p) opts r1
+        case getValueLR opts msg0 pp [hh rr] of
+          Left e -> pure e
+          Right p -> do
+            qq <- evalBool (Proxy @q) opts r2
+            pure $ case getValueLR opts msg0 qq [hh rr, hh pp] of
+              Left e -> e
+              Right q ->
+                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 rr, hh pp, hh qq]
+
+data p |+ q
+type OrAT p q = OrA p q Id
+infixr 3 |+
+
+instance P (OrAT p q) x => P (p |+ q) x where
+  type PP (p |+ q) x = PP (OrAT p q) x
+  eval _ = evalBool (Proxy @(OrAT p q))
+
+-- | very simple conversion to a string
+data ToString p
+instance (ToStringC (PP p x), P p x) => P (ToString p) x where
+  type PP (ToString p) x = String
+  eval _ opts x = do
+    let msg0 = "ToString"
+    pp <- eval (Proxy @p) opts x
+    pure $ case getValueLR opts msg0 pp [] of
+      Left e -> e
+      Right p ->
+        let d = toStringC p
+        in mkNode opts (PresentT d) msg0 [hh pp]
+
+class ToStringC a where
+  toStringC :: a -> String
+instance ToStringC String where
+  toStringC = id
+instance ToStringC T.Text where
+  toStringC = T.unpack
+instance ToStringC TL.Text where
+  toStringC = TL.unpack
+instance ToStringC BL8.ByteString where
+  toStringC = BL8.unpack
+instance ToStringC BS8.ByteString where
+  toStringC = BS8.unpack
+
+-- | splits a list pointed to by \'p\' into lists of size \'n\'
+--
+-- >>> pz @(ChunksOf 2 Id) "abcdef"
+-- PresentT ["ab","cd","ef"]
+--
+-- >>> pz @(ChunksOf 2 Id) "abcdefg"
+-- PresentT ["ab","cd","ef","g"]
+--
+-- >>> pz @(ChunksOf 2 Id) ""
+-- PresentT []
+--
+-- >>> pz @(ChunksOf 2 Id) "a"
+-- PresentT ["a"]
+--
+data ChunksOf n p
+
+instance (PP p a ~ [b]
+        , P n a
+        , P p a
+        , Show b
+        , Integral (PP n a)
+        ) => P (ChunksOf n p) a where
+  type PP (ChunksOf n p) a = [PP p a]
+  eval _ opts a = do
+    let msg0 = "ChunksOf"
+    lr <- runPQ msg0 (Proxy @n) (Proxy @p) opts a []
+    pure $ case lr of
+      Left e -> e
+      Right (fromIntegral -> n,p,pp,qq) ->
+        let hhs = [hh pp, hh qq]
+            msg1 = msg0 <> show0 opts " " n <> show0 opts " " p
+        in if n <= 0 then mkNode opts (FailT (msg0 <> " n<1")) msg1 hhs
+           else let ret = unfoldr (\s -> if null s then Nothing else Just $ splitAt n s) p
+                in mkNode opts (PresentT ret) (show01' opts msg1 ret "n=" n <> show1 opts " | " p) hhs
+
+data Rotate n p
+type RotateT n p = SplitAt n p >> Swap >> First Reverse >> SapA
+
+instance P (RotateT n p) x => P (Rotate n p) x where
+  type PP (Rotate n p) x = PP (RotateT n p) x
+  eval _ = eval (Proxy @(RotateT n p))
+
+type Tuple2 p = '(p !! 0, p !! 1)
+type Tuple3 p = '(p !! 0, p !! 1, p !! 2)
+type Tuple4 p = '(p !! 0, p !! 1, p !! 2, p !! 3)
+type Tuple5 p = '(p !! 0, p !! 1, p !! 2, p !! 3, p !! 4)
+type Tuple6 p = '(p !! 0, p !! 1, p !! 2, p !! 3, p !! 4, p !! 5)