predicate-typed 0.5.1.0 → 0.6.0.0

raw patch · 10 files changed

+678/−262 lines, 10 filesdep +hashablePVP ok

version bump matches the API change (PVP)

Dependencies added: hashable

API changes (from Hackage documentation)

Files

• predicate-typed.cabal +5/−2
• src/Predicate/Prelude.hs +569/−213
• src/Predicate/Refined.hs +7/−0
• src/Predicate/Refined2.hs +13/−10
• src/Predicate/Refined3.hs +31/−10
• src/Predicate/Util.hs +22/−12
• test/TestJson.hs +5/−4
• test/TestPredicate.hs +10/−10
• test/TestRefined2.hs +7/−0
• test/TestRefined3.hs +9/−1

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: cb25822f4cf9d47fb5e8793e47a05aba5041df2929f5497e50d7897f9f1d6c17+-- hash: 91077e765e3f765a00629565212c20b373d1e8cd724f4f9c4f381835f0e4f561  name:           predicate-typed-version:        0.5.1.0+version:        0.6.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@@ -54,6 +54,7 @@     , deepseq     , directory     , ghc-prim+    , hashable     , lens     , mtl     , pcre-heavy >=1.0.0.2@@ -91,6 +92,7 @@     , directory     , doctest     , ghc-prim+    , hashable     , lens     , mtl     , pcre-heavy >=1.0.0.2@@ -135,6 +137,7 @@     , deepseq     , directory     , ghc-prim+    , hashable     , lens     , mtl     , pcre-heavy >=1.0.0.2

@@ -1,3 +1,4 @@+-- 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 #-}
@@ -42,6 +43,7 @@   , Desc
   , Desc'
   , Between
+  , BetweenA
   , type (<..>)
   , All
   , Any
@@ -105,6 +107,17 @@   , IsSeparator
   , IsLatin1
 
+  , IsLowerAll
+  , IsUpperAll
+  , IsNumberAll
+  , IsSpaceAll
+  , IsPunctuationAll
+  , IsControlAll
+  , IsHexDigitAll
+  , IsOctDigitAll
+  , IsSeparatorAll
+  , IsLatin1All
+
   -- ** datetime expressions
   , FormatTimeP
   , ParseTimeP
@@ -171,6 +184,7 @@   , ParseJson'
   , ParseJson
   , EncodeJson
+  , EncodeJsonFile
   , ParseJsonFile'
   , ParseJsonFile
 
@@ -201,8 +215,8 @@   , Le
   , Lt
   , Ne
-  , OrdP
   , type (==!)
+  , OrdP
   , OrdA'
   , OrdA
   , OrdI
@@ -254,11 +268,14 @@   , Cycle
   , SplitAts
   , SplitAt
+  , ChunksOf
+  , Rotate
   , Take
   , Drop
   , Min
   , Max
   , Sum
+  , Product
   , IsEmpty
   , Null
   , Null'
@@ -316,8 +333,8 @@   , type (<>)
   , MConcat
   , STimes
-  , Sapa
-  , Sapa'
+  , SapA
+  , SapA'
   , MEmptyT
   , MEmptyT'
   , MEmptyP
@@ -457,8 +474,9 @@   , IsPrefixI
   , IsInfixI
   , IsSuffixI
-  , FromStringP
-  , FromStringP'
+  , ToString
+  , FromString
+  , FromString'
 
   -- ** print expressions
   , PrintF
@@ -558,6 +576,8 @@ 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
@@ -682,6 +702,61 @@   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]
@@ -1278,75 +1353,200 @@       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 @IsLower "abc"
+-- >>> pz @IsSpace '\t'
 -- True
 -- TrueT
 --
--- >>> pz @IsLower "abcX"
+-- >>> pz @IsSpace ' '
+-- True
+-- TrueT
+--
+-- >>> pz @IsSpace 'x'
 -- False
 -- FalseT
 --
--- >>> pz @IsLower (T.pack "abcX")
+-- >>> pz @IsLower 'a'
+-- True
+-- TrueT
+--
+-- >>> pz @IsLower 'X'
 -- False
 -- FalseT
 --
--- >>> pz @IsHexDigit "01efA"
+-- >>> pz @IsHexDigit 'A'
 -- True
 -- TrueT
 --
--- >>> pz @IsHexDigit "01egfA"
+-- >>> pz @IsHexDigit 'g'
 -- False
 -- FalseT
 --
 -- | predicate for determining if a string is all lowercase
 --
--- >>> pz @IsLower "abcdef213"
+-- >>> pz @IsLower '1'
 -- False
 -- FalseT
 --
--- >>> pz @IsLower "abcdef"
+-- >>> pz @IsLower 'a'
 -- True
 -- TrueT
 --
--- >>> pz @IsLower ""
+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]] []
+
+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 string is all digits
+--
+-- >>> pz @IsNumber 'g'
+-- False
+-- FalseT
+--
+-- >>> pz @IsNumber '9'
 -- True
 -- TrueT
 --
--- >>> pz @IsLower "abcdefG"
+data IsNumber
+type IsNumberT = IsCharSet 'CNumber
+instance P IsNumberT x => P IsNumber x where
+  type PP IsNumber x = Bool
+  eval _ = evalBool (Proxy @IsNumberT)
+
+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
 --
--- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "AbcdE"
--- False ((>>) False | {True (&*) False | (IsLower | "bcdE")})
+-- >>> pz @IsLowerAll (T.pack "abcX")
+-- False
 -- FalseT
 --
--- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "Abcde"
+-- >>> 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 >> ('[Id] >> IsUpper) &* IsLower) "xbcde"
--- False ((>>) False | {IsUpper | "x"})})
+-- >>> pl @(Just Uncons >> IsUpper &* IsLowerAll) "xbcde"
+-- False ((>>) False | {False (&*) True | (IsUpper | "x")})
 -- FalseT
 --
--- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "X"
+-- >>> pl @(Just Uncons >> IsUpper &* IsLowerAll) "X"
 -- True ((>>) True | {True (&*) True})
 -- TrueT
 --
+data IsCharSetAll (cs :: CharSet)
+
 instance (GetCharSet cs
         , Show a
         , TL.IsText a
-        ) => P (IsCharSet cs) a where
-  type PP (IsCharSet cs) a = Bool
+        ) => 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)
+        msg0 = "Is" ++ drop 1 (show cs) ++ "All"
         (cs,f) = getCharSet @cs
     in pure $ mkNodeB opts b [msg0 <> show1 opts " | " as] []
 
-data IsCharSet (cs :: CharSet)
-
 data CharSet = CLower
              | CUpper
              | CNumber
@@ -1367,6 +1567,8 @@   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
@@ -1380,77 +1582,91 @@ instance GetCharSet 'CLatin1 where
   getCharSet = (CLatin1, isLatin1)
 
-data IsLower
-type IsLowerT = IsCharSet 'CLower
+data IsLowerAll
+type IsLowerAllT = IsCharSetAll 'CLower
 
-instance P IsLowerT x => P IsLower x where
-  type PP IsLower x = PP IsLowerT x
-  eval _ = evalBool (Proxy @IsLowerT)
+instance P IsLowerAllT x => P IsLowerAll x where
+  type PP IsLowerAll x = PP IsLowerAllT x
+  eval _ = evalBool (Proxy @IsLowerAllT)
 
-data IsUpper
-type IsUpperT = IsCharSet 'CUpper
+data IsUpperAll
+type IsUpperAllT = IsCharSetAll 'CUpper
 
-instance P IsUpperT x => P IsUpper x where
-  type PP IsUpper x = PP IsUpperT x
-  eval _ = evalBool (Proxy @IsUpperT)
+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 @IsNumber "213G"
+-- >>> pz @IsNumberAll "213G"
 -- False
 -- FalseT
 --
--- >>> pz @IsNumber "929"
+-- >>> pz @IsNumberAll "929"
 -- True
 -- TrueT
 --
-data IsNumber
-type IsNumberT = IsCharSet 'CNumber
-instance P IsNumberT x => P IsNumber x where
-  type PP IsNumber x = PP IsNumberT x
-  eval _ = evalBool (Proxy @IsNumberT)
+data IsNumberAll
+type IsNumberAllT = IsCharSetAll 'CNumber
+instance P IsNumberAllT x => P IsNumberAll x where
+  type PP IsNumberAll x = Bool
+  eval _ = evalBool (Proxy @IsNumberAllT)
 
-data IsSpace
-type IsSpaceT = IsCharSet 'CSpace
-instance P IsSpaceT x => P IsSpace x where
-  type PP IsSpace x = PP IsSpaceT x
-  eval _ = evalBool (Proxy @IsSpaceT)
+-- | 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 IsPunctuation
-type IsPunctuationT = IsCharSet 'CPunctuation
-instance P IsPunctuationT x => P IsPunctuation x where
-  type PP IsPunctuation x = PP IsPunctuationT x
-  eval _ = evalBool (Proxy @IsPunctuationT)
+data IsPunctuationAll
+type IsPunctuationAllT = IsCharSetAll 'CPunctuation
+instance P IsPunctuationAllT x => P IsPunctuationAll x where
+  type PP IsPunctuationAll x = Bool
+  eval _ = evalBool (Proxy @IsPunctuationAllT)
 
-data IsControl
-type IsControlT = IsCharSet 'CControl
-instance P IsControlT x => P IsControl x where
-  type PP IsControl x = PP IsControlT x
-  eval _ = evalBool (Proxy @IsControlT)
+data IsControlAll
+type IsControlAllT = IsCharSetAll 'CControl
+instance P IsControlAllT x => P IsControlAll x where
+  type PP IsControlAll x = Bool
+  eval _ = evalBool (Proxy @IsControlAllT)
 
-data IsHexDigit
-type IsHexDigitT = IsCharSet 'CHexDigit
-instance P IsHexDigitT x => P IsHexDigit x where
-  type PP IsHexDigit x = PP IsHexDigitT x
-  eval _ = evalBool (Proxy @IsHexDigitT)
+data IsHexDigitAll
+type IsHexDigitAllT = IsCharSetAll 'CHexDigit
+instance P IsHexDigitAllT x => P IsHexDigitAll x where
+  type PP IsHexDigitAll x = Bool
+  eval _ = evalBool (Proxy @IsHexDigitAllT)
 
-data IsOctDigit
-type IsOctDigitT = IsCharSet 'COctDigit
-instance P IsOctDigitT x => P IsOctDigit x where
-  type PP IsOctDigit x = PP IsOctDigitT x
-  eval _ = evalBool (Proxy @IsOctDigitT)
+data IsOctDigitAll
+type IsOctDigitAllT = IsCharSetAll 'COctDigit
+instance P IsOctDigitAllT x => P IsOctDigitAll x where
+  type PP IsOctDigitAll x = Bool
+  eval _ = evalBool (Proxy @IsOctDigitAllT)
 
-data IsSeparator
-type IsSeparatorT = IsCharSet 'CSeparator
-instance P IsSeparatorT x => P IsSeparator x where
-  type PP IsSeparator x = PP IsSeparatorT x
-  eval _ = evalBool (Proxy @IsSeparatorT)
+data IsSeparatorAll
+type IsSeparatorAllT = IsCharSetAll 'CSeparator
+instance P IsSeparatorAllT x => P IsSeparatorAll x where
+  type PP IsSeparatorAll x = Bool
+  eval _ = evalBool (Proxy @IsSeparatorAllT)
 
-data IsLatin1
-type IsLatin1T = IsCharSet 'CLatin1
-instance P IsLatin1T x => P IsLatin1 x where
-  type PP IsLatin1 x = PP IsLatin1T x
-  eval _ = evalBool (Proxy @IsLatin1T)
+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
@@ -1496,8 +1712,8 @@ --
 data Inits
 
-instance Show a => P Inits [a] where
-  type PP Inits [a] = [[a]]
+instance ([a] ~ x, Show a) => P Inits x where
+  type PP Inits x = [x]
   eval _ opts as =
     let msg0 = "Inits"
         xs = inits as
@@ -1515,8 +1731,8 @@ --
 data Tails
 
-instance Show a => P Tails [a] where
-  type PP Tails [a] = [[a]]
+instance ([a] ~ x, Show a) => P Tails x where
+  type PP Tails x = [x]
   eval _ opts as =
     let msg0 = "Tails"
         xs = tails as
@@ -1885,6 +2101,25 @@         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]
@@ -2367,23 +2602,23 @@ -- | 'fromString' function where you need to provide the type \'t\' of the result
 --
 -- >>> :set -XFlexibleContexts
--- >>> pz @(FromStringP (Identity _) Id) "abc"
+-- >>> pz @(FromString (Identity _) Id) "abc"
 -- Present Identity "abc"
 -- PresentT (Identity "abc")
 --
--- >>> pz @(FromStringP (Seq.Seq Char) Id) "abc"
+-- >>> pz @(FromString (Seq.Seq Char) Id) "abc"
 -- Present fromList "abc"
 -- PresentT (fromList "abc")
-data FromStringP' t s
+data FromString' t s
 
 instance (P s a
         , PP s a ~ String
         , Show (PP t a)
         , IsString (PP t a)
-        ) => P (FromStringP' t s) a where
-  type PP (FromStringP' t s) a = PP t a
+        ) => P (FromString' t s) a where
+  type PP (FromString' t s) a = PP t a
   eval _ opts a = do
-    let msg0 = "FromStringP"
+    let msg0 = "FromString"
     ss <- eval (Proxy @s) opts a
     pure $ case getValueLR opts msg0 ss [] of
       Left e -> e
@@ -2391,11 +2626,11 @@         let b = fromString @(PP t a) s
         in mkNode opts (PresentT b) [msg0 <> show0 opts " " b] [hh ss]
 
-data FromStringP (t :: Type) p
-type FromStringPT (t :: Type) p = FromStringP' (Hole t) p
+data FromString (t :: Type) p
+type FromStringPT (t :: Type) p = FromString' (Hole t) p
 
-instance P (FromStringPT t p) x => P (FromStringP t p) x where
-  type PP (FromStringP t p) x = PP (FromStringPT t p) x
+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))
 
 
@@ -2804,7 +3039,7 @@     pure $ case lr of
       Left e -> e
       Right (ns,p,nn,pp) ->
-        let zs = foldr (\n k s -> let (a,b) = splitAt (fromIntegral n) s
+        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]
@@ -2827,6 +3062,10 @@ -- 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]
@@ -2843,10 +3082,13 @@       Left e -> e -- (Left e, tt')
       Right (fromIntegral -> n,p,pp,qq) ->
         let msg1 = msg0 <> show0 opts " " n <> show0 opts " " p
-            (x,y) = splitAt n p
-            ret = (x,y)
+            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)
 
@@ -3087,42 +3329,42 @@ infix 4 >
 
 instance P (Cmp 'CGt p q) x => P (p > q) x where
-  type PP (p > q) x = PP (Cmp 'CGt p q) x
+  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 = PP (Cmp 'CGe p q) x
+  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 = PP (Cmp 'CEq p q) x
+  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 = PP (Cmp 'CLe p q) x
+  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 = PP (Cmp 'CLt p q) x
+  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 = PP (Cmp 'CNe p q) x
+  type PP (p /= q) x = Bool
   eval _ = evalBool (Proxy @(Cmp 'CNe p q))
 
 --type p + q = Bin 'BAdd p q
@@ -3154,42 +3396,42 @@ infix 4 >~
 
 instance P (CmpI 'CGt p q) x => P (p >~ q) x where
-  type PP (p >~ q) x = PP (CmpI 'CGt p q) x
+  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 = PP (CmpI 'CGe p q) x
+  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 = PP (CmpI 'CEq p q) x
+  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 = PP (CmpI 'CLe p q) x
+  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 = PP (CmpI 'CLt p q) x
+  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 = PP (CmpI 'CNe p q) x
+  type PP (p /=~ q) x = Bool
   eval _ = evalBool (Proxy @(CmpI 'CNe p q))
 
 
@@ -5461,7 +5703,7 @@ data Null
 type NullT = Null' Id
 instance P NullT a => P Null a where
-  type PP Null a = PP NullT a
+  type PP Null a = Bool
   eval _ = evalBool (Proxy @NullT)
 
 -- | similar to 'enumFromTo'
@@ -5578,7 +5820,10 @@ -- 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]
@@ -6065,14 +6310,14 @@ type EvenT = Mod I 2 == 0
 
 instance P EvenT x => P Even x where
-  type PP Even x = PP EvenT x
+  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 = PP OddT x
+  type PP Odd x = Bool
   eval _ = evalBool (Proxy @OddT)
 
 
@@ -6280,8 +6525,8 @@ 
 data Guards (ps :: [(k,k1)])
 
-instance (GetLen ps, P (GuardsImpl (LenT ps) ps) [a]) => P (Guards ps) [a] where
-  type PP (Guards ps) [a] = PP (GuardsImpl (LenT ps) ps) [a]
+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
@@ -6293,9 +6538,9 @@ badLength :: (Foldable t, Show n, Num n) => t a -> n -> String
 badLength as n = ":invalid length(" <> show (length as) <> ") expected " ++ show (n+0)
 
-instance Show a
-         => P (GuardsImpl n ('[] :: [(k,k1)])) [a] where
-  type PP (GuardsImpl n ('[] :: [(k,k1)])) [a] = [a]
+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
@@ -6310,8 +6555,9 @@         , P (GuardsImpl n ps) [a]
         , PP (GuardsImpl n ps) [a] ~ [a]
         , Show a
-        ) => P (GuardsImpl n ('(prt,p) ': ps)) [a] where
-  type PP (GuardsImpl n ('(prt,p) ': ps)) [a] = [a]
+        , [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 <> ")"
@@ -6389,11 +6635,12 @@ --
 data Bools (ps :: [(k,k1)])
 
-instance (GetLen ps
-        , P (BoolsImpl (LenT ps) ps) [a]
-        , PP (BoolsImpl (LenT ps) ps) [a] ~ Bool
-        ) => P (Bools ps) [a] where
-  type PP (Bools ps) [a] = Bool
+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++")"
@@ -6410,8 +6657,9 @@ 
 instance (KnownNat n
         , Show a
-        ) => P (BoolsImpl n ('[] :: [(k,k1)])) [a] where
-  type PP (BoolsImpl n ('[] :: [(k,k1)])) [a] = Bool
+        , [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
@@ -6424,11 +6672,12 @@         , GetLen ps
         , P p a
         , PP p a ~ Bool
-        , P (BoolsImpl n ps) [a]
+        , P (BoolsImpl n ps) x
         , PP (BoolsImpl n ps) [a] ~ Bool
 --        , Show a
-        ) => P (BoolsImpl n ('(prt,p) ': ps)) [a] where
-  type PP (BoolsImpl n ('(prt,p) ': ps)) [a] = Bool
+        , [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 <> ")"
@@ -6458,7 +6707,7 @@ 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
+-- 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
@@ -6478,8 +6727,8 @@ data BoolsN prt (n :: Nat) (p :: k1)
 type BoolsNT prt (n :: Nat) (p :: k1) = Bools (ToGuardsT prt (RepeatT n p))
 
-instance P (BoolsNT prt n p) [a] => P (BoolsN prt n p) [a] where
-  type PP (BoolsN prt n p) [a] = PP (BoolsNT prt n p) [a]
+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
@@ -6498,10 +6747,11 @@ --
 data GuardsDetailImpl (ps :: [(k,k1)])
 
-instance (GetLen ps
-        , P (GuardsImplX (LenT ps) ps) [a]
-        ) => P (GuardsDetailImpl ps) [a] where
-  type PP (GuardsDetailImpl ps) [a] = PP (GuardsImplX (LenT ps) ps) [a]
+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
@@ -6512,9 +6762,9 @@ 
 data GuardsImplX (n :: Nat) (os :: [(k,k1)])
 
-instance Show a
-        => P (GuardsImplX n ('[] :: [(k,k1)])) [a] where
-  type PP (GuardsImplX n ('[] :: [(k,k1)])) [a] = [a]
+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
@@ -6530,8 +6780,9 @@         , P (GuardsImplX n ps) [a]
         , PP (GuardsImplX n ps) [a] ~ [a]
         , Show a
-        ) => P (GuardsImplX n ('(prt,p) ': ps)) [a] where
-  type PP (GuardsImplX n ('(prt,p) ': ps)) [a] = [a]
+        , [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 <> ")"
@@ -6580,8 +6831,8 @@ data GuardsN prt (n :: Nat) p
 type GuardsNT prt (n :: Nat) p = Guards (ToGuardsT prt (RepeatT n p))
 
-instance P (GuardsNT prt n p) [a] => P (GuardsN prt n p) [a] where
-  type PP (GuardsN prt n p) [a] = PP (GuardsNT prt n p) [a]
+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\'
@@ -6890,11 +7141,6 @@         let b = not p
         in mkNodeB opts b [msg0 <> " " <> topMessage pp] [hh pp]
 
-type OrdP p q = p ==! q
-
-data p ==! q
-infix 4 ==!
-
 -- | similar to 'compare'
 --
 -- >>> pz @(Fst Id ==! Snd Id) (10,9)
@@ -6917,14 +7163,11 @@ -- Present EQ
 -- PresentT EQ
 --
---type OrdA' p q = (Fst Id >> p) ==! (Snd Id >> q)
---type OrdA p = OrdA' p p
 
-data OrdA p
+data p ==! q
+infix 4 ==!
 
-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))
+type OrdP p q = p ==! q
 
 instance (Ord (PP p a)
         , PP p a ~ PP q a
@@ -6942,6 +7185,12 @@         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)
 
@@ -7170,8 +7419,9 @@ instance (a ~ GE.Item t
         , Show t
         , GE.IsList t
-        ) => P (FromList t) [a] where
-  type PP (FromList t) [a] = 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
@@ -7924,8 +8174,11 @@ data Para (ps :: [k])
 
 -- passthru but adds the length of ps (replaces LenT in the type synonym to avoid type synonyms being expanded out
-instance (GetLen ps, P (ParaImpl (LenT ps) ps) [a]) => P (Para ps) [a] where
-  type PP (Para ps) [a] = PP (ParaImpl (LenT ps) ps) [a]
+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
@@ -7934,10 +8187,10 @@        in pure $ mkNode opts (FailT msg1) [msg1] []
     else eval (Proxy @(ParaImpl (LenT ps) ps)) opts as
 
--- only allow non empty lists
+-- 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])) [a] where
-  type PP (ParaImpl n ('[] :: [k])) [a] = Void
+   => P (ParaImpl n ('[] :: [k])) x where
+  type PP (ParaImpl n ('[] :: [k])) x = Void
   eval _ _ _ = errorInProgram "ParaImpl empty list"
 
 instance (Show (PP p a)
@@ -8006,10 +8259,11 @@ --
 data ParaN (n :: Nat) p
 
-instance ( P (ParaImpl (LenT (RepeatT n p)) (RepeatT n p)) [a]
+instance ( P (ParaImpl (LenT (RepeatT n p)) (RepeatT n p)) x
          , GetLen (RepeatT n p)
-         ) => P (ParaN n p) [a] where
-  type PP (ParaN n p) [a] = PP (Para (RepeatT n p)) [a]
+         , 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
@@ -8551,11 +8805,11 @@ -- Present (Sum {getSum = 22},"def_XYZ")
 -- PresentT (Sum {getSum = 22},"def_XYZ")
 --
--- >>> pz @(Sapa' (SG.Max _)) (10,12)
+-- >>> pz @(SapA' (SG.Max _)) (10,12)
 -- Present Max {getMax = 12}
 -- PresentT (Max {getMax = 12})
 --
--- >>> pz @(Sapa' (SG.Sum _)) (10,12)
+-- >>> pz @(SapA' (SG.Sum _)) (10,12)
 -- Present Sum {getSum = 22}
 -- PresentT (Sum {getSum = 22})
 --
@@ -8578,19 +8832,19 @@         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)
+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))
+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
+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)
+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
 --
@@ -10067,10 +10321,22 @@ -- 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 ~ String
+        , PP p x ~ BL8.ByteString
         , Typeable (PP t x)
         , Show (PP t x)
         , A.FromJSON (PP t x)
@@ -10084,10 +10350,10 @@       Left e -> e
       Right s ->
         let hhs = [hh pp]
-            msg1 = msg0 <> "(" ++ litL 10 s ++ ")"
-        in case A.eitherDecodeStrict' (BS8.pack s) of
+            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 <> " | " <> litL 100 s] 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
@@ -10096,25 +10362,6 @@   type PP (ParseJson t p) x = PP (ParseJsonT t p) x
   eval _ = eval (Proxy @(ParseJsonT t p))
 
--- | encode json
---
--- >>> pl @(EncodeJson Id) (10,"def")
--- Present "[10,\"def\"]" (EncodeJson [10,"def"])
--- PresentT "[10,\"def\"]"
---
-data EncodeJson p
-
-instance (A.ToJSON (PP p x), P p x) => P (EncodeJson p) x where
-  type PP (EncodeJson p) x = String
-  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 = BL8.unpack (A.encode p)
-        in mkNode opts (PresentT d) [msg0 <> showLit0 opts " " d] [hh pp]
-
 -- | parse a json file
 data ParseJsonFile' t p
 
@@ -10141,10 +10388,11 @@         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 bs) ->
-            case A.eitherDecodeStrict' bs of
-               Right b -> mkNode opts (PresentT b) [msg1 <> " " ++ show b] hhs
-               Left e -> mkNode opts (FailT (msg1 <> " " <> takeWhile (/=':') e)) [msg1 <> " failed " <> litL 100 e] 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
@@ -10153,6 +10401,55 @@   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"
@@ -10196,18 +10493,6 @@ -- False ((>>) False | {False (&*) True | (4 > 4)})
 -- FalseT
 --
--- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "Cabc"
--- True ((>>) True | {True (&*) True})
--- TrueT
---
--- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "CabD"
--- False ((>>) False | {True (&*) False | (IsLower | "abD")})
--- FalseT
---
--- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "2abd"
--- False ((>>) False | {IsUpper | "2"})})
--- FalseT
---
 data AndA p q r
 instance (PP r x ~ (a,b)
         , PP p a ~ Bool
@@ -10307,3 +10592,74 @@   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))

@@ -76,6 +76,7 @@ import Data.Semigroup ((<>))
 import Data.String
 import Data.Maybe
+import Data.Hashable (Hashable(..))
 
 -- $setup
 -- >>> :set -XDataKinds
@@ -236,6 +237,12 @@             Nothing -> fail $ "Refined:" ++ show bp ++ "\n" ++ e
             Just r -> return r
   put (Refined r) = B.put @a r
+
+-- | 'Hashable' instance for 'Refined'
+instance ( RefinedC p a
+         , Hashable a
+         ) => Hashable (Refined p a) where
+  hashWithSalt s (Refined a) = s + hash a
 
 -- | 'arbitrary' value for 'Refined'
 arbRefined :: forall p a.

@@ -39,7 +39,6 @@   , prt2
   , prt2Impl
   , Msg2 (..)
-  , Results2 (..)
   , RResults2 (..)
 
   -- ** evaluation methods
@@ -90,6 +89,7 @@ import Data.Char (isSpace)
 import Data.Semigroup ((<>))
 import Data.String
+import Data.Hashable (Hashable(..))
 
 -- $setup
 -- >>> :set -XDataKinds
@@ -318,6 +318,12 @@             Just r -> return r
   put (Refined2 _ r) = B.put @i r
 
+-- | 'Hashable' instance for 'Refined2'
+instance (Refined2C ip op i
+        , Hashable i
+        ) => Hashable (Refined2 ip op i) where
+  hashWithSalt s (Refined2 _ b) = s + hash b
+
 withRefined2TIO :: forall ip op i m b
   . (MonadIO m, Refined2C ip op i, Show (PP ip i))
   => POpts
@@ -366,7 +372,7 @@ withRefined2T opts = (>>=) . newRefined2TP (Proxy @'(ip,op,i)) opts
 
 withRefined2TP :: forall m ip op i b proxy
-  . (Monad m, Refined2C ip op i, Show (PP ip i), Show i)
+  . (Monad m, Refined2C ip op i, Show (PP ip i))
   => proxy '(ip,op,i)
   -> POpts
   -> i
@@ -431,13 +437,6 @@     Nothing -> throwError $ m2Desc m2 <> " | " <> m2Short m2
     Just r -> return r
 
-data Results2 a =
-       XF String        -- Left e
-     | XTF a String     -- Right a + Left e
-     | XTFalse a String -- Right a + Right False
-     | XTTrue a
-     deriving (Show,Eq)
-
 -- | An ADT that summarises the results of evaluating Refined2 representing all possible states
 data RResults2 a =
        RF String (Tree PE)        -- fails initial conversion
@@ -513,7 +512,11 @@ prt2 :: Show a => POpts -> (RResults2 a, Maybe r) -> Either Msg2 r
 prt2 opts (ret,mr) = maybe (Left $ prt2Impl opts ret) Right mr
 
-data Msg2 = Msg2 { m2Desc :: String, m2Short :: String, m2Long :: String } deriving Eq
+data Msg2 = Msg2 { m2Desc :: !String
+                 , m2Short :: !String
+                 , m2Long :: !String
+                 } deriving Eq
+
 instance Show Msg2 where
   show (Msg2 a b c) = a <> " | " <> b <> (if null c then "" else "\n" <> c)
 

@@ -46,7 +46,6 @@   , prt3
   , prt3Impl
   , Msg3 (..)
-  , Results3 (..)
   , RResults3 (..)
 
   -- ** evaluation methods
@@ -114,6 +113,7 @@ import Data.Char (isSpace)
 import Data.Semigroup ((<>))
 import Data.String
+import Data.Hashable (Hashable(..))
 
 -- $setup
 -- >>> :set -XDataKinds
@@ -388,6 +388,12 @@             Just r -> return r
   put (Refined3 _ r) = B.put @i r
 
+-- | 'Hashable' instance for 'Refined3'
+instance (Refined3C ip op fmt i
+        , Hashable (PP ip i)
+        ) => Hashable (Refined3 ip op fmt i) where
+  hashWithSalt s (Refined3 a _) = s + hash a
+
 -- | creates a 4-tuple proxy (see 'withRefined3TP' 'newRefined3TP' 'eval3P' 'prtEval3P')
 --
 -- use type application to set the 4-tuple or set the individual parameters directly
@@ -602,14 +608,6 @@   Refined3 a b <- newRefined3TPSkipIPImpl (return . runIdentity) p opts (f x y)
   return (Refined3 a b)
 
-data Results3 a b =
-       XF String        -- Left e
-     | XTF a String     -- Right a + Left e
-     | XTFalse a String -- Right a + Right False
-     | XTTrueF a String -- Right a + Right True + Left e
-     | XTTrueT a b      -- Right a + Right True + Right b
-     deriving (Show,Eq)
-
 -- | An ADT that summarises the results of evaluating Refined3 representing all possible states
 data RResults3 a b =
        RF String (Tree PE)        -- Left e
@@ -736,7 +734,11 @@ prt3 :: (Show a, Show b) => POpts -> (RResults3 a b, Maybe r) -> Either Msg3 r
 prt3 opts (ret,mr) = maybe (Left $ prt3Impl opts ret) Right mr
 
-data Msg3 = Msg3 { m3Desc :: String, m3Short :: String, m3Long :: String } deriving Eq
+data Msg3 = Msg3 { m3Desc :: !String
+                 , m3Short :: !String
+                 , m3Long :: !String
+                 } deriving Eq
+
 instance Show Msg3 where
   show (Msg3 a b c) = a <> " | " <> b <> (if null c then "" else "\n" <> c)
 
@@ -832,14 +834,33 @@ type RefinedEmulate p a = Refined3 Id p Id a
 
 -- | used by 'Refined3' to extract \'ip\' from a promoted 4-tuple
+--
+-- >>> pl @(T4_1 Predicate.Examples.Refined3.Ip4) "1.2.3.4"
+-- Present [1,2,3,4] (Map [1,2,3,4] | ["1","2","3","4"])
+-- PresentT [1,2,3,4]
+--
 type family T4_1 x where
   T4_1 '(a,b,c,d) = a
 
 -- | used by 'Refined3' for extracting the boolean predicate \'op\' from a promoted 4-tuple
+--
+-- >>> pl @(T4_2 Predicate.Examples.Refined3.Ip4) [141,213,308,4]
+-- Error octet 2 out of range 0-255 found 308
+-- FailT "octet 2 out of range 0-255 found 308"
+--
+-- >>> pl @(T4_2 Predicate.Examples.Refined3.Ip4) [141,213,308,4,8]
+-- Error Guards:invalid length(5) expected 4
+-- FailT "Guards:invalid length(5) expected 4"
+--
 type family T4_2 x where
   T4_2 '(a,b,c,d) = b
 
 -- | used by 'Refined3' for extracting \'fmt\' from a promoted 4-tuple
+--
+-- >>> pl @(T4_3 Predicate.Examples.Refined3.Ip4) [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"
+--
 type family T4_3 x where
   T4_3 '(a,b,c,d) = c
 

@@ -114,6 +114,8 @@   , show1
   , showL
   , litL
+  , litBL
+  , litBS
 
   -- ** regular expressions
   , ROpt(..)
@@ -148,7 +150,6 @@   , GetNats(..)
   , GetSymbs(..)
   , GetLen(..)
-  , showThese
   , GetThese(..)
   , GetOrdering(..)
   , GetBool(..)
@@ -174,6 +175,7 @@   , MonadEval(..)
   , errorInProgram
   , readField
+  , showThese
     ) where
 import qualified GHC.TypeNats as GN
 import Data.Ratio
@@ -211,6 +213,8 @@ import qualified Text.Read.Lex as L
 import Text.ParserCombinators.ReadPrec
 import qualified GHC.Read as GR
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import qualified Data.ByteString.Char8 as BS8
 
 -- $setup
 -- >>> :set -XDataKinds
@@ -218,18 +222,18 @@ -- >>> :set -XTypeOperators
 
 -- | represents the evaluation tree for predicates
-data TT a = TT { _tBool :: BoolT a  -- ^ the value at this root node
-               , _tStrings :: [String]  -- ^ detailed information eg input and output and text
-               , _tForest :: Forest PE } -- ^ the child nodes
-                deriving Show
+data TT a = TT { _tBool :: !(BoolT a)  -- ^ the value at this root node
+               , _tStrings :: ![String]  -- ^ detailed information eg input and output and text
+               , _tForest :: !(Forest PE) -- ^ the child nodes
+               } deriving Show
 
 -- | contains the typed result from evaluating the expression tree
 --
 data BoolT a where
-  FailT :: String -> BoolT a  -- failure with string
+  FailT :: !String -> BoolT a  -- failure with string
   FalseT :: BoolT Bool        -- false predicate
   TrueT :: BoolT Bool         -- true predicate
-  PresentT :: a -> BoolT a    -- non predicate value
+  PresentT :: !a -> BoolT a    -- non predicate value
 
 deriving instance Show a => Show (BoolT a)
 deriving instance Eq a => Eq (BoolT a)
@@ -342,9 +346,9 @@ newtype PColor = PColor (BoolP -> String -> String)
 
 -- | customizable options
-data POpts = POpts { oWidth :: Int -- ^ length of data to display for 'showLitImpl'
+data POpts = POpts { oWidth :: !Int -- ^ length of data to display for 'showLitImpl'
                    , oDebug :: !ODebug -- ^ debug level
-                   , oDisp :: Disp -- ^ display the tree using the normal tree or unicode
+                   , oDisp :: !Disp -- ^ display the tree using the normal tree or unicode
                    , oColor :: !(String, PColor) -- ^ color palette used
                    }
 
@@ -402,7 +406,7 @@ 
 -- | same as 'o2' for a wider display and verbose debug mode setting
 o3 :: POpts
-o3 = defOpts { oDebug = OVerbose, oWidth = 400 }
+o3 = o2 { oDebug = OVerbose, oWidth = 400 }
 
 -- | displays the detailed evaluation tree using unicode and colors. ('o2' works better on Windows)
 ou :: POpts
@@ -534,6 +538,12 @@ litL :: Int -> String -> String
 litL i s = take i s <> if length s > i then "..." else ""
 
+litBL :: Int -> BL8.ByteString -> String
+litBL i s = litL i (BL8.unpack (BL8.take (fromIntegral i+1) s))
+
+litBS :: Int -> BS8.ByteString -> String
+litBS i s = litL i (BS8.unpack (BS8.take (i+1) s))
+
 -- | Regex options for Rescan Resplit Re etc
 data ROpt =
     Anchored -- ^ Force pattern anchoring
@@ -604,7 +614,7 @@ -- | used by 'Predicate.ReplaceImpl' and 'RH.sub' and 'RH.gsub' to allow more flexible replacement
 --   These parallel the RegexReplacement (not exported) class in "Text.Regex.PCRE.Heavy" but have overlappable instances which is problematic for this code so I use 'RReplace'
 data RReplace =
-     RReplace String
+     RReplace !String
    | RReplace1 (String -> [String] -> String)
    | RReplace2 (String -> String)
    | RReplace3 ([String] -> String)
@@ -1001,7 +1011,7 @@   RepeatT n p = p ': RepeatT (n GN.- 1) p
 
 type s <%> t = GL.AppendSymbol s t
-infixr 6 <%>
+infixr 7 <%>
 
 type family IntersperseT (s :: Symbol) (xs :: [Symbol]) :: Symbol where
   IntersperseT s '[] = ""

@@ -29,7 +29,8 @@   [ testCase "testperson ok" $ expectIO testPerson (() <$)
   , testCase "testperson1 ok" $ expectIO (testPerson1 2) (() <$)
   , testCase "testperson1 bad ipaddress" $ expectIO (testPerson1 3) (expectLeftWith ["octet 3 out of range 0-255 found 260"])
-  , testCase "testperson1 bad lastname lowercase first letter" $ expectIO (testPerson1 4) (expectLeftWith ["invalid name","diaz"])
+  , testCase "testperson1 bad lastname lowercase first letter" $ expectIO (testPerson1 4) (expectLeftWith ["lastName1", "invalid name", "diaz"])
+  , testCase "testperson1 bad first name lowercase first letter" $ expectIO (testPerson1 6) (expectLeftWith ["firstName1", "not upper first(d)"])
   , testCase "testperson1 age 99 out of range" $ expectIO (testPerson1 5) (expectLeftWith ["Error in $[0].age1"])
   , testCase "parse fail person1" $ expectPE (FailT "ParseJsonFile [Person1](test3.json) Error in $[0].ipaddress1") $ pl @(ParseJsonFile [Person1] "test3.json") ()
   , testCase "parse ok person1" $ expectPE (PresentT 5) $ pl @(ParseJsonFile [Person1] "test2.json" >> Len) ()
@@ -55,7 +56,7 @@ instance FromJSON Person
 
 data Person1 = Person1 {
-       firstName1 :: NameR1
+       firstName1 :: NameR2
      , lastName1 :: NameR1
      , age1 :: AgeR
      , likesPizza1 :: Bool
@@ -74,8 +75,8 @@ type Name2 =
           Uncons
        >> 'Just Id
-       >> Guard (PrintF "not upper first(%c)" Id) ('[Id] >> IsUpper)
-      *** Guard (PrintF "not lower rest(%s)" Id) IsLower
+       >> Guard (PrintF "not upper first(%c)" Id) IsUpper
+      *** Guard (PrintF "not lower rest(%s)" Id) IsLowerAll
 
 type AgeR = R.Refined (Between 10 60 Id) Int
 

@@ -306,9 +306,9 @@   , expectPE (PresentT ([141,214,125,1,2,3333],(False,False))) $ pl @(Map (ReadP Int Id) (Resplit "\\." Id) >> '(Id, '(Len == 4, All (Between 0 255 Id) Id))) "141.214.125.1.2.3333"
   , expectPE (PresentT ([141,214,125,1,2,6],(False,True))) $ pl @(Map (ReadP Int Id) (Resplit "\\." Id) >> Id &&& ((Len == 4) &&& All (Between 0 255 Id) Id)) "141.214.125.1.2.6"
   , expectPE (FailT "ReadP Int ()") $ pl @(Resplit "\\." Id >> Map (ReadP Int Id) Id >> Id &&& ((Len == 4) &&& All (Between 0 255 Id) Id)) "141.214.125."
-  , expectPE (PresentT 9) $ pl @((Wrap _ Id *** Wrap (SG.Sum _) Id) >> Sapa >> Unwrap Id) (4,5)
-  , expectPE (PresentT (SG.Sum 9)) $ pl @((Wrap _ Id *** Wrap _ Id) >> Sapa) (4,5)
-  , expectPE (PresentT 9) $ pl @(Sapa' (SG.Sum _) >> Unwrap Id) (4,5)
+  , expectPE (PresentT 9) $ pl @((Wrap _ Id *** Wrap (SG.Sum _) Id) >> SapA >> Unwrap Id) (4,5)
+  , expectPE (PresentT (SG.Sum 9)) $ pl @((Wrap _ Id *** Wrap _ Id) >> SapA) (4,5)
+  , expectPE (PresentT 9) $ pl @(SapA' (SG.Sum _) >> Unwrap Id) (4,5)
   , expectPE (PresentT "abcde") $ pl @(ScanNA (Succ Id)) (4,'a')
   , expectPE (PresentT ["abcd","bcd","cd","d",""]) $ pl @(ScanNA (Tail Id)) (4,"abcd" :: String)
   , expectPE (PresentT ["abcd","bcd","cd","d",""]) $ pl @(Len &&& Id >> ScanNA (Tail Id)) "abcd"
@@ -428,16 +428,16 @@   , expectPE (PresentT (12, False)) $ pl @('These Id (Not Id)) (These 12 True)
   , expectPE (PresentT (SG.Any True)) $ pl @(Coerce SG.Any) True
   , expectPE (PresentT True) $ pl @(Coerce Bool) (SG.Any True)
-  , expectPE (PresentT (3, SG.Any True)) $ pl @(Id !! FromStringP _ "d" &&& (Map (Snd Id >> Gt 3 >> Coerce SG.Any) (IToList _ Id) >> MConcat Id) ) (M.fromList $ zip (map T.singleton "abcdefgh") [0 ..])
-  , expectPE (PresentT (3, True)) $ pl @(Id !! FromStringP _ "d" &&& (Map (Snd Id >> Gt 3 >> Wrap SG.Any Id) (IToList _ Id) >> MConcat Id >> Unwrap Id) ) (M.fromList $ zip (map T.singleton "abcdefgh") [0 ..])
+  , expectPE (PresentT (3, SG.Any True)) $ pl @(Id !! FromString _ "d" &&& (Map (Snd Id >> Gt 3 >> Coerce SG.Any) (IToList _ Id) >> MConcat Id) ) (M.fromList $ zip (map T.singleton "abcdefgh") [0 ..])
+  , expectPE (PresentT (3, True)) $ pl @(Id !! FromString _ "d" &&& (Map (Snd Id >> Gt 3 >> Wrap SG.Any Id) (IToList _ Id) >> MConcat Id >> Unwrap Id) ) (M.fromList $ zip (map T.singleton "abcdefgh") [0 ..])
     --- have to wrap with W cos different kinds
 --  , expectPE TrueT $ pl @(Do '[ W ('PresentT I), W 'FalseT, Not Id]) False
 --  , expectPE FalseT $ pl @(Do '[ W ('PresentT Id), W 'FalseT ]) True -- have to wrap them cos BoolT a vs BoolT Bool ie different types
 --  , expectPE TrueT $ pl @('PresentT I >> Not 'FalseT) False
   -- IxL "d" doesnt work cos is Text not String
-  , expectPE (PresentT 3) $ pl @(Id !! FromStringP _ "d") (M.fromList $ zip (map T.singleton "abcd") [0 ..])
+  , expectPE (PresentT 3) $ pl @(Id !! FromString _ "d") (M.fromList $ zip (map T.singleton "abcd") [0 ..])
   -- use Fromstring
-  , expectPE (PresentT 3) $ pl @(Id !! FromStringP _ "d") (M.fromList $ zip (map T.singleton "abcd") [0 ..])
+  , expectPE (PresentT 3) $ pl @(Id !! FromString _ "d") (M.fromList $ zip (map T.singleton "abcd") [0 ..])
   , expectPE (PresentT [7,9,9,2,7,3,9,8,7,1,3]) $ pl @(Map (ReadP Int Id) (Ones Id) >> Guard "checkdigit fail" (Luhn Id)) "79927398713"
   , expectPE (FailT "checkdigit fail") $ pl @(Map (ReadP Int Id) (Ones Id) >> Guard "checkdigit fail" (Luhn Id)) "79927398714"
   , expectPE (PresentT [10,14,15,9]) $ pl @(MM1 16 >> MM2 16) "aef9"
@@ -472,9 +472,9 @@   , (@?=) (Just 'x') ((_PresentT # 'x') ^? _PresentT)
   , expectPE (PresentT (111,'b')) $ pl @('(123,Char1 "c") >> (Id - 12 *** Pred Id)) ()
   , expectPE (PresentT (SG.Min 19)) $ pl @((FromInteger _ 12 &&& Id) >> Fst Id + Snd Id) (SG.Min 7)
-  , expectPE (PresentT (SG.Product 84)) $ pl @((FromInteger _ 12 &&& Id) >> Sapa) (SG.Product 7)
+  , expectPE (PresentT (SG.Product 84)) $ pl @((FromInteger _ 12 &&& Id) >> SapA) (SG.Product 7)
   , expectPE (PresentT "xyxyxyxy") $ pl @(STimes (Fst Id) (Snd Id)) (4,['x','y'])
-  , expectPE (PresentT (concat (replicate 16 "abc"))) $ pl @(FoldN 4 Id ((Id &&& Id) >> Sapa)) "abc"
+  , expectPE (PresentT (concat (replicate 16 "abc"))) $ pl @(FoldN 4 Id ((Id &&& Id) >> SapA)) "abc"
   , expectPE (PresentT (concat (replicate 4 "abc"))) $ pl @(STimes (Fst Id) (Snd Id)) (4,"abc")
   , expectPE (PresentT (concat (replicate 4 "abc"))) $ pl @(STimes 4 Id) "abc"
   , expectPE (PresentT "abcd") $ pl @(Map (FromEnum Id) Id >> Map (ToEnum Char Id) Id) ("abcd" :: String)
@@ -482,7 +482,7 @@   , expectPE (PresentT ([2,3,5,7,11,13], [1,4,6,8,9,10,12,14,15])) $ pl @(Partition (Prime Id) Id) [1..15]
   , expectPE (FailT "'Nothing found Just") $ pl @'Nothing (Just 12)
   , expectPE (PresentT (Just 10,((),()))) $ pl @(Id &&& '() &&& ()) (Just 10)
-  , expectPE (PresentT [(-999) % 1,10 % 1,20 % 1,(-999) % 1,30 % 1]) $ pl @(Map (Wrap (MM.First _) Id &&& (Pure Maybe (999 -% 1 ) >> Wrap (MM.First _) Id)) Id >> Map Sapa Id >> Map (Just (Unwrap Id)) Id) [Nothing,Just 10,Just 20,Nothing,Just 30]
+  , expectPE (PresentT [(-999) % 1,10 % 1,20 % 1,(-999) % 1,30 % 1]) $ pl @(Map (Wrap (MM.First _) Id &&& (Pure Maybe (999 -% 1 ) >> Wrap (MM.First _) Id)) Id >> Map SapA Id >> Map (Just (Unwrap Id)) Id) [Nothing,Just 10,Just 20,Nothing,Just 30]
   , expectPE (PresentT 12) $ pl @(MaybeIn 99 Id) (Just 12)
   , expectPE (PresentT 12) $ pl @(JustDef 99 Id) (Just 12)
   , expectPE (PresentT 99) $ pl @(MaybeIn 99 Id) Nothing

@@ -301,6 +301,13 @@    RTFalse _ t1 t2 -> [t1,t2]
    RTTrue _ t1 t2 -> [t1,t2]
 
+data Results2 a =
+       XF String        -- Left e
+     | XTF a String     -- Right a + Left e
+     | XTFalse a String -- Right a + Right False
+     | XTTrue a
+     deriving (Show,Eq)
+
 toRResults2 :: RResults2 a -> Results2 a
 toRResults2 = \case
    RF e _ -> XF e

@@ -175,7 +175,7 @@   , expect3 (Left (XTFalse [1,2,300,4] "Bool(2) [octet 2 out of range 0-255 found 300] (300 <= 255)")) $ eval3P ip4' ol "1.2.300.4"
   , expect3 (Right $ unsafeRefined3 [1,2,3,4,5,6,7,8,9,0,3] "1234-5678-903") $ eval3P cc11 ol "12345678903"
   , expect3 (Left $ XTFalse [1,2,3,4,5,6,7,8,9,0,1] "") $ eval3P cc11 oz "12345678901"
---  , expect3 (Right $ unsafeRefined3 True ["T","r","ue","Tr","ue"]) $ eval3P (Proxy @'(Id, Id, Do '[ShowP Id, Dup, Sapa, SplitAts '[1,1,2,2]], Bool)) True
+
   , expect3 (Right $ unsafeRefined3 ([12,13,14],TimeOfDay 12 13 14) "12:13:14") $ eval3P hms2E ol "12:13:14"
   , expect3 (Left (XTF ([12,13,99], TimeOfDay 12 13 99) "seconds invalid: found 99")) $ eval3P hms2E ol "12:13:99"
 
@@ -347,6 +347,14 @@    RTFalse _ t1 t2 -> [t1,t2]
    RTTrueF _ t1 t2 _ t3 -> [t1,t2,t3]
    RTTrueT _ t1 t2 _ t3 -> [t1,t2,t3]
+
+data Results3 a b =
+       XF String        -- Left e
+     | XTF a String     -- Right a + Left e
+     | XTFalse a String -- Right a + Right False
+     | XTTrueF a String -- Right a + Right True + Left e
+     | XTTrueT a b      -- Right a + Right True + Right b
+     deriving (Show,Eq)
 
 toRResults3 :: RResults3 a b -> Results3 a b
 toRResults3 = \case