diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+BSD 3-Clause License
+
+Copyright (c) 2018, Grant Weyburne
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation
+   and/or other materials provided with the distribution.
+
+3. Neither the name of the copyright holder nor the names of its
+   contributors may be used to endorse or promote products derived from
+   this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/primus.cabal b/primus.cabal
new file mode 100644
--- /dev/null
+++ b/primus.cabal
@@ -0,0 +1,93 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+
+name:           primus
+version:        0.1.0.0
+synopsis:       NonEmpty and positive functions
+description:    A library containing positive-valued and nonempty functions . Please see the README on GitHub at <https://github.com/gbwey/primus#readme>
+category:       Data, General
+homepage:       https://github.com/gbwey/primus#readme
+bug-reports:    https://github.com/gbwey/primus.git/issues
+author:         Grant Weyburne <gbwey9@gmail.com>
+maintainer:     Grant Weyburne <gbwey9@gmail.com>
+copyright:      2022 Grant Weyburne
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+
+source-repository head
+  type: git
+  location: https://github.com/gbwey/primus.git
+
+library
+  exposed-modules:
+      Primus
+      Primus.AsMaybe
+      Primus.Bool
+      Primus.Enum
+      Primus.Error
+      Primus.Extra
+      Primus.Fold
+      Primus.Lens
+      Primus.List
+      Primus.LRHist
+      Primus.NonEmpty
+      Primus.Num1
+      Primus.One
+      Primus.Rep
+      Primus.TypeLevel
+      Primus.ZipNonEmpty
+  other-modules:
+      Paths_primus
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wunused-type-patterns -Wredundant-constraints -Wmonomorphism-restriction -Wmissing-deriving-strategies -Wmissing-local-signatures -Wmissing-export-lists -Widentities
+  build-depends:
+      adjunctions
+    , base >=4.7 && <5
+    , deepseq
+    , distributive
+    , pos
+    , profunctors
+    , semigroupoids
+    , these
+  default-language: Haskell2010
+
+test-suite primus-test
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  other-modules:
+      TestAsMaybe
+      TestBool
+      TestEnum
+      TestExtra
+      TestFold
+      TestList
+      TestLRHist
+      TestNonEmpty
+      TestNum1
+      TestZipNonEmpty
+      Paths_primus
+  hs-source-dirs:
+      test
+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wunused-type-patterns -Wredundant-constraints -Wmissing-deriving-strategies -Widentities -Wno-missing-export-lists -Wno-missing-local-signatures
+  build-depends:
+      QuickCheck
+    , adjunctions
+    , base
+    , checkers
+    , deepseq
+    , distributive
+    , lens
+    , pos
+    , primus
+    , profunctors
+    , semigroupoids
+    , tasty
+    , tasty-hunit
+    , tasty-quickcheck
+    , these
+  default-language: Haskell2010
diff --git a/src/Primus.hs b/src/Primus.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus.hs
@@ -0,0 +1,33 @@
+{- |
+Module      : Primus
+Description : common modules
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus (
+  module Data.Pos,
+  module Primus.AsMaybe,
+  module Primus.Bool,
+  module Primus.Enum,
+  module Primus.Extra,
+  module Primus.Error,
+  module Primus.Fold,
+  module Primus.List,
+  module Primus.NonEmpty,
+  module Primus.Num1,
+  module Primus.One,
+  module Primus.Rep,
+) where
+
+import Data.Pos
+import Primus.AsMaybe
+import Primus.Bool
+import Primus.Enum
+import Primus.Error
+import Primus.Extra
+import Primus.Fold
+import Primus.List
+import Primus.NonEmpty
+import Primus.Num1
+import Primus.One
+import Primus.Rep
diff --git a/src/Primus/AsMaybe.hs b/src/Primus/AsMaybe.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/AsMaybe.hs
@@ -0,0 +1,286 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{- |
+Module      : Primus.AsMaybe
+Description : methods with termination
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.AsMaybe (
+  -- * AsMaybe
+  AsMaybe (..),
+  iterateT1,
+  unfoldrT,
+  pairsT,
+
+  -- * ApThese
+  ApThese (..),
+  toTheseT,
+  toTheseTS,
+  partitionEithersT,
+  partitionTheseT,
+  filterT,
+  spanT,
+  spanTAlt,
+  spanTS,
+  takeWhileT,
+  takeWhileTS,
+
+  -- * ApTheseF for use with 'Primus.LRHist.LRHist'
+  ApTheseF (..),
+) where
+
+import Control.Arrow
+import Data.Bool
+import Data.Functor.Identity
+import qualified Data.List as L
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.Semigroup as SG
+import Data.These
+import Data.These.Combinators
+import Primus.Extra
+
+-- | converts to a 'Maybe' for failure types
+class AsMaybe x b | x -> b where
+  toMaybe :: x -> Maybe b
+
+instance (b ~ b1) => AsMaybe (These e b) b1 where
+  toMaybe = these (const Nothing) Just (const Just)
+instance (b ~ b1) => AsMaybe (Either e b) b1 where
+  toMaybe = either (const Nothing) Just
+instance (b ~ b1) => AsMaybe (Maybe b) b1 where
+  toMaybe = id
+instance (b1 ~ [b]) => AsMaybe [b] b1 where
+  toMaybe = \case
+    [] -> Nothing
+    as@(_ : _) -> Just as
+instance (z ~ SG.Arg b1 y, AsMaybe x b1) => AsMaybe (SG.Arg x y) z where
+  toMaybe (SG.Arg x y) = (`SG.Arg` y) <$> toMaybe x
+instance (b ~ (b1, b2), AsMaybe x b1, AsMaybe y b2) => AsMaybe (x, y) b where
+  toMaybe (x, y) = (,) <$> toMaybe x <*> toMaybe y
+instance (b ~ (b1, b2, b3), AsMaybe x b1, AsMaybe y b2, AsMaybe z b3) => AsMaybe (x, y, z) b where
+  toMaybe (x, y, z) = (,,) <$> toMaybe x <*> toMaybe y <*> toMaybe z
+
+instance AsMaybe x z => AsMaybe (Identity x) z where
+  toMaybe (Identity x) = toMaybe x
+
+-- supports Bool instance so partition can work the same as base [not a requirement but..]
+
+-- | flexible "e" to use with eg 'partitionTheseT': Bool is also valid
+class ApThese e a x b | x e a -> b where
+  apThese :: a -> x -> These e b
+
+instance (e ~ e1, b ~ b1) => ApThese e1 a (These e b) b1 where
+  apThese _ = id
+instance (e ~ e1, b ~ b1) => ApThese e1 a (Either e b) b1 where
+  apThese _ = either This That
+instance (e ~ a, b ~ b1) => ApThese e a (Maybe b) b1 where
+  apThese a = maybe (This a) That
+instance (e ~ a, b ~ a) => ApThese e a Bool b where
+  apThese a = bool (This a) (That a)
+instance (e ~ a, b1 ~ [b]) => ApThese e a [b] b1 where
+  apThese a = \case
+    [] -> This a
+    as@(_ : _) -> That as
+
+instance (z ~ SG.Arg b1 y, ApThese e a x b1) => ApThese e a (SG.Arg x y) z where
+  apThese a (SG.Arg x y) = (`SG.Arg` y) <$> apThese a x
+instance (Semigroup e, b ~ (b1, b2), ApThese e a x b1, ApThese e a y b2) => ApThese e a (x, y) b where
+  apThese a (x, y) = (,) <$> apThese a x <*> apThese a y
+instance (Semigroup e, b ~ (b1, b2, b3), ApThese e a x b1, ApThese e a y b2, ApThese e a z b3) => ApThese e a (x, y, z) b where
+  apThese a (x, y, z) = (,,) <$> apThese a x <*> apThese a y <*> apThese a z
+
+instance ApThese e a x z => ApThese e a (Identity x) z where
+  apThese a (Identity x) = apThese a x
+
+-- for LRHist "e" is fixed
+-- supports Bool instance for use with LRHist [this is a requirement]
+
+-- | for use with 'Primus.LRHist.LRHist' using a fixed "e"
+class ApTheseF e a x b | x e a -> b where
+  apTheseF :: a -> x -> These e b
+
+instance (e ~ e1, b ~ b1) => ApTheseF e1 a (These e b) b1 where
+  apTheseF _ = id
+instance (e ~ e1, b ~ b1) => ApTheseF e1 a (Either e b) b1 where
+  apTheseF _ = either This That
+instance (Monoid e, b ~ b1) => ApTheseF e a (Maybe b) b1 where
+  apTheseF _ = maybe (This mempty) That
+instance (Monoid e, b ~ a) => ApTheseF e a Bool b where
+  apTheseF a = bool (This mempty) (That a)
+instance (Monoid e, b1 ~ [b]) => ApTheseF e a [b] b1 where
+  apTheseF _ = \case
+    [] -> This mempty
+    as@(_ : _) -> That as
+
+instance (z ~ SG.Arg b1 y, ApTheseF e a x b1) => ApTheseF e a (SG.Arg x y) z where
+  apTheseF a (SG.Arg x y) = (`SG.Arg` y) <$> apTheseF a x
+instance (Semigroup e, b ~ (b1, b2), ApTheseF e a x b1, ApTheseF e a y b2) => ApTheseF e a (x, y) b where
+  apTheseF a (x, y) = (,) <$> apTheseF a x <*> apTheseF a y
+instance (Semigroup e, b ~ (b1, b2, b3), ApTheseF e a x b1, ApTheseF e a y b2, ApTheseF e a z b3) => ApTheseF e a (x, y, z) b where
+  apTheseF a (x, y, z) = (,,) <$> apTheseF a x <*> apTheseF a y <*> apTheseF a z
+
+instance ApTheseF e a x z => ApTheseF e a (Identity x) z where
+  apTheseF a (Identity x) = apTheseF a x
+
+-- | similar to 'Data.List.NonEmpty.iterate' but terminate using 'AsMaybe'
+iterateT1 ::
+  AsMaybe x a =>
+  (a -> x) ->
+  a ->
+  NonEmpty a
+iterateT1 f a0 = a0 :| go a0
+ where
+  go a = case toMaybe (f a) of
+    Nothing -> []
+    Just x -> x : go x
+
+
+{- | like 'Data.List.unfoldr' but terminate using 'AsMaybe'
+
+@
+>>> unfoldrT (splitAt 2) [1..8]
+[[1,2],[3,4],[5,6],[7,8]]
+
+vs
+
+>>> unfoldr (\s -> if null s then Nothing else Just (splitAt 2 s)) [1..8]
+[[1,2],[3,4],[5,6],[7,8]]
+@
+-}
+unfoldrT ::
+  AsMaybe t t =>
+  (t -> (a, t)) ->
+  t ->
+  [a]
+unfoldrT f s0 =
+  case toMaybe s0 of
+    Nothing -> []
+    Just s1 ->
+      let (a, s2) = f s1
+       in a : unfoldrT f s2
+
+-- | run a functions against each side of a tuple and stitch them together for use with 'unfoldrT' where "s" is a tuple and you want to stop as soon as the either terminates
+pairsT :: (x -> (a, x)) -> (y -> (b, y)) -> (x, y) -> ((a, b), (x, y))
+pairsT f g (x0, y0) =
+  let (a, x) = f x0
+      (b, y) = g y0
+   in ((a, b), (x, y))
+
+-- | apply a function to a list and convert to a list of 'These'
+toTheseT ::
+  forall e a x b.
+  (ApThese e a x b) =>
+  (a -> x) ->
+  [a] ->
+  [These e b]
+toTheseT f = map (\a -> apThese a (f a))
+
+-- | like 'toTheseT' with state
+toTheseTS ::
+  forall e a x b z.
+  (ApThese e a x b) =>
+  (z -> a -> (z, x)) ->
+  z ->
+  [a] ->
+  (z, [These e b])
+toTheseTS f = L.mapAccumL (\z a -> second (apThese a) (f z a))
+
+-- | like 'partitionEithersT' ignoring the second element of the result
+filterT ::
+  forall e a b x.
+  ApThese e a x b =>
+  (a -> x) ->
+  [a] ->
+  [b]
+filterT = catThat .@ toTheseT @e -- minimal type applications required as "e" isnt used here
+
+-- | like 'toTheseT' but use 'partitionHereThere' on the results (swapped version of 'Data.List.partition')
+partitionEithersT ::
+  forall e a b x.
+  ApThese e a x b =>
+  (a -> x) ->
+  [a] ->
+  ([e], [b])
+partitionEithersT = partitionHereThere .@ toTheseT
+
+-- | like 'toTheseT' but use 'partitionThese' on the results
+partitionTheseT ::
+  forall e a b x.
+  ApThese e a x b =>
+  (a -> x) ->
+  [a] ->
+  ([e], [b], [(e, b)])
+partitionTheseT = partitionThese .@ toTheseT
+
+-- | similar to 'Data.List.span' using 'ApThese' for failure (support Bool and These)
+spanT ::
+  forall e a x b.
+  ApThese e a x b =>
+  (a -> x) ->
+  [a] ->
+  ([b], [a])
+spanT f = \case
+  [] -> ([], [])
+  a : as -> case apThese @e a (f a) of
+    This _ -> ([], a : as)
+    That b -> first (b :) (spanT @e f as)
+    These _ b -> ((b :) *** (a :)) (spanT @e f as) -- put in both buckets and keep going
+
+-- | like 'spanT' but doesn't continue in the 'These' case
+spanTAlt ::
+  forall e a x b.
+  ApThese e a x b =>
+  (a -> x) ->
+  [a] ->
+  ([b], [a])
+spanTAlt f = \case
+  [] -> ([], [])
+  a : as -> case apThese @e a (f a) of
+    This _ -> ([], a : as)
+    That b -> first (b :) (spanT @e f as)
+    These _ b -> ([b], a : as) -- put in both buckets and stop
+
+-- | like 'spanT' with state
+spanTS ::
+  forall e a x b z.
+  ApThese e a x b =>
+  (z -> a -> (z, x)) ->
+  z ->
+  [a] ->
+  (z, ([b], [a]))
+spanTS f z0 = \case
+  [] -> (z0, ([], []))
+  a : as ->
+    let (z, x) = f z0 a
+     in case apThese @e a x of
+          This _ -> (z, ([], a : as))
+          That b -> second (first (b :)) (spanTS @e f z as)
+          These _ b -> second ((b :) *** (a :)) (spanTS @e f z as) -- if these then put in both buckets
+
+-- | like 'takeWhileT' with state
+takeWhileTS ::
+  forall e a x b z.
+  ApThese e a x b =>
+  (z -> a -> (z, x)) ->
+  z ->
+  [a] ->
+  (z, [b])
+takeWhileTS f = second fst .@ spanTS @e f
+
+-- | like 'spanT' but ignore the second element of the result
+takeWhileT ::
+  forall e a x b.
+  ApThese e a x b =>
+  (a -> x) ->
+  [a] ->
+  [b]
+takeWhileT = fst .@ spanT @e
diff --git a/src/Primus/Bool.hs b/src/Primus/Bool.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/Bool.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{- |
+Module      : Primus.Bool
+Description : boolean methods
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.Bool (
+  -- * builders
+  boolMaybe,
+  boolEither,
+  boolThese,
+  boolThese',
+
+  -- * monadic functions
+  boolM,
+  unlessMB,
+  whenMB,
+) where
+
+import Data.Bool
+import Data.These
+
+{- | monadic version of 'Data.Bool.bool'
+ predicate appears first unlike 'Data.Bool.bool'
+-}
+boolM :: Monad m => m Bool -> m a -> m a -> m a
+boolM mb mf mt = mb >>= bool mf mt
+
+{- | create a 'Maybe' using a predicate and a function for the success case
+ predicate appears first unlike 'Data.Bool.bool'
+-}
+boolMaybe ::
+  (a -> Bool) ->
+  (a -> b) ->
+  a ->
+  Maybe b
+boolMaybe p r a
+  | p a = Just (r a)
+  | otherwise = Nothing
+
+{- | create a 'Either' using a predicate and functions for the failure and success case
+ predicates appear first unlike 'Data.Bool.bool'
+-}
+boolEither ::
+  (a -> Bool) ->
+  (a -> e) ->
+  (a -> b) ->
+  a ->
+  Either e b
+boolEither p l r a
+  | p a = Right (r a)
+  | otherwise = Left (l a)
+
+{- | create a 'These' using two predicates and functions for the This case and That case
+   False + *     == This (a -> e)
+   True  + False == That (a -> b)
+   True  + True  == These (a -> e) (a -> b) -- "a" effectively appears twice
+
+  predicates appear first unlike 'Data.Bool.bool'
+-}
+boolThese ::
+  (a -> Bool) ->
+  (a -> Bool) ->
+  (a -> e) ->
+  (a -> b) ->
+  a ->
+  These e b
+boolThese p q l r = boolThese' p q l r const
+
+{- | similar to 'boolThese' but allows you to override the 'These' case
+
+ predicates appear first unlike 'Data.Bool.bool'
+-}
+boolThese' ::
+  (a -> Bool) ->
+  (a -> Bool) ->
+  (a -> e) ->
+  (a -> b) ->
+  ((e, b) -> a -> (e, b)) ->
+  a ->
+  These e b
+boolThese' p q l r b a =
+  case (p a, q a) of
+    (False, _) -> This (l a)
+    (True, False) -> That (r a)
+    (True, True) -> uncurry These (b (l a, r a) a)
+
+-- | 'Control.Monad.unless' but makes the "a" parameter available to the callback
+unlessMB ::
+  Applicative m =>
+  (a -> Bool) ->
+  a ->
+  (a -> m ()) ->
+  m ()
+unlessMB p a m = bool (m a) (pure ()) (p a)
+
+-- | 'Control.Monad.when' but makes the "a" parameter available to the callback
+whenMB ::
+  Applicative m =>
+  (a -> Bool) ->
+  a ->
+  (a -> m ()) ->
+  m ()
+whenMB p a m = bool (pure ()) (m a) (p a)
diff --git a/src/Primus/Enum.hs b/src/Primus/Enum.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/Enum.hs
@@ -0,0 +1,300 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
+{- |
+Module      : Primus.Enum
+Description : methods for safe enumeration and enumeration on containers
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.Enum (
+  -- * enumerations
+  universe1,
+  universe1R,
+  enumFrom1,
+  enumFrom1R,
+  enumTo1,
+  enumFromThen1,
+  enumFromTo1,
+  enumFromThenTo1,
+
+  -- * converters
+  predSafe,
+  succSafe,
+  integerToEnumSafe,
+  integerToIntSafe,
+
+  -- * container enums
+
+  -- ** enumerations
+  toEnumList,
+  toEnumList1,
+  universeTraversable,
+  toEnumTraversable,
+  -- calcNextEnum,
+  -- minMax,
+  -- zerolr
+
+  -- ** converters
+  succTraversable,
+  predTraversable,
+  fromEnumFoldable,
+  fromEnumFoldable1,
+
+  -- ** capacity
+  capacity,
+) where
+
+import Control.Arrow
+import Data.Foldable
+import Data.Function
+import Data.Functor
+import qualified Data.List as L
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.Ord
+import Data.Semigroup.Foldable
+import Primus.Error
+import Primus.Fold
+
+-- | create a nonempty list of all the values for an 'Enum'
+universe1 :: forall a. (Bounded a, Enum a) => NonEmpty a
+universe1 = enumFrom1 minBound
+
+-- | create a nonempty list of all the values for an 'Enum' in reverse order
+universe1R :: forall a. (Bounded a, Enum a) => NonEmpty a
+universe1R = enumFrom1R maxBound
+
+-- | create a nonempty list of values starting at "a"
+enumFrom1 :: (Bounded a, Enum a) => a -> NonEmpty a
+enumFrom1 a = a :| drop 1 [a .. maxBound]
+
+-- | create a nonempty list of values starting at "a"
+enumTo1 :: (Bounded a, Enum a) => a -> NonEmpty a
+enumTo1 a = minBound :| drop 1 [minBound .. a]
+
+-- | create a nonempty list of values starting at "a" and skipping "b"
+enumFromThen1 :: (Bounded a, Enum a) => a -> a -> NonEmpty a
+enumFromThen1 a b =
+  case comparing fromEnum a b of
+    LT -> a :| drop 1 [a, b .. maxBound]
+    EQ -> a :| [] -- diverges from enumFromThen by returning one value instead of cycling
+    GT -> a :| drop 1 [a, b .. minBound]
+
+-- | 'enumFromThenTo' for nonempty lists
+enumFromThenTo1 :: Enum a => a -> a -> a -> NonEmpty a
+enumFromThenTo1 a b c =
+  if comparing fromEnum a b == EQ
+    then a :| [] -- diverges from enumFromThenTo by returning one value instead of cycling
+    else a :| drop 1 [a, b .. c]
+
+-- | create a nonempty list of values starting at "a" and skipping "b"
+enumFromTo1 :: Enum a => a -> a -> NonEmpty a
+enumFromTo1 a b =
+  case comparing fromEnum a b of
+    LT -> a :| drop 1 [a .. b]
+    EQ -> a :| [] -- diverges from enumFromTo by returning one value instead of cycling
+    GT -> a :| drop 1 [a, pred a .. b] -- diverges from enumFromTo by going backwards instead of returning nothing
+    -- pred has to exist: a > b => pred a >= b unless float ...
+
+-- | create a nonempty list of "a" in reverse order
+enumFrom1R :: forall a. (Bounded a, Enum a) => a -> NonEmpty a
+enumFrom1R a
+  | Just prv <- predSafe a = a :| drop 1 [a, prv .. minBound]
+  | otherwise = a :| []
+
+-- | safe 'pred' for a bounded 'Enum'
+predSafe :: (Bounded a, Enum a) => a -> Maybe a
+predSafe a
+  | on (==) fromEnum a minBound = Nothing
+  | otherwise = Just (pred a)
+
+-- | safe 'succ' for a bounded 'Enum'
+succSafe :: (Bounded a, Enum a) => a -> Maybe a
+succSafe a
+  | on (==) fromEnum a maxBound = Nothing
+  | otherwise = Just (succ a)
+
+-- | load a given container with "a"s using the relative position "i"
+toEnumTraversable ::
+  forall a f z.
+  (Traversable f, Enum a, Bounded a) =>
+  f z ->
+  Integer ->
+  Either String (f a)
+toEnumTraversable tz i = do
+  lst <- toEnumList @a i
+  z <- zerolr
+  c <- capacity @a tz
+  lmsg ("cap=" ++ show c) $ padL (z <$ tz) lst
+
+zerolr :: forall a. (Bounded a, Enum a) => Either String a
+zerolr = left (const "zerolr: not defined at zero") $ integerToEnumSafe @a 0
+
+-- | calculates the minimum and maximum range of enumerations that can be stored in a container of the given size
+capacity :: forall a t z. (Bounded a, Enum a, Foldable t) => t z -> Either String (Integer, Integer)
+capacity (length -> len) = do
+      let z@(mn, mx) = minMax @a
+      lhs <- case compare mn 0 of
+            LT -> Right (-(-mn + 1) ^ len + 1)
+            EQ -> Right 0
+            GT -> Left $ "capacity: unsupported mn > 0: " ++ show z
+      rhs <- case compare 0 mx of
+            LT -> Right ((mx + 1) ^ len - 1)
+            EQ -> Right 0
+            GT -> Left $ "capacity: unsupported mx < 0: " ++ show z
+      pure (lhs,rhs)
+
+{- | convert toEnum of "a" into a list containing "a"s
+   zero is the empty list: see 'toEnumList'
+-}
+toEnumList :: forall a. (Enum a, Bounded a) => Integer -> Either String [a]
+toEnumList i
+  | i == 0 = [] <$ zerolr @a
+  | otherwise =
+      let f :: Integer -> Either String (Maybe (a, Integer))
+          f s
+            | s == 0 = pure Nothing
+            | otherwise =
+                calcNextEnum s <&> \(s', a) ->
+                  if abs s' < abs s
+                    then Just (a, s')
+                    else
+                      if s' == 0
+                        then Nothing
+                        else programmError "toEnumList"
+       in unfoldlM f i
+
+-- | calculate the next enum
+calcNextEnum :: forall a. (Enum a, Bounded a) => Integer -> Either String (Integer, a)
+calcNextEnum i = lmsg "calcNextEnum" $
+  case compare i 0 of
+    GT
+      | mx > 0 ->
+          let (a, b) = divMod i (mx + 1)
+           in case integerToEnumSafe b of
+                Left e -> Left $ "out of range(GT): " ++ show i ++ " mod " ++ show (mx + 1) ++ " == " ++ show b ++ "(undefined) e=" ++ e
+                Right c -> Right (a, c)
+      | otherwise -> Left "not defined for positive numbers"
+    EQ -> (0,) <$> zerolr
+    LT
+      | mn < 0 ->
+          let (a, b) = quotRem i (mn - 1)
+           in case integerToEnumSafe b of
+                Left e -> Left $ "out of range(LT): " ++ show i ++ " mod " ++ show (mn - 1) ++ " == " ++ show b ++ "(undefined) e=" ++ e
+                Right c -> Right (-a, c)
+      | otherwise -> Left "not defined for negative numbers"
+ where
+  (mn, mx) = minMax @a
+
+-- | return the min and max of a bounded enum
+minMax :: forall a. (Enum a, Bounded a) => (Integer, Integer)
+minMax = on (,) (toInteger . fromEnum @a) minBound maxBound
+
+-- | concrete safe conversion of Integer to Int
+integerToIntSafe :: Integer -> Either String Int
+integerToIntSafe = integerToEnumSafe
+
+-- | safe 'toEnum'
+integerToEnumSafe :: forall a. (Enum a, Bounded a) => Integer -> Either String a
+integerToEnumSafe i
+  | i < mn = Left $ msg "underflow"
+  | i > mx = Left $ msg "overflow"
+  | otherwise = pure $ toEnum @a $ fromInteger @Int i -- i <= maxBound  && maxBound :: Int so cant fail on fromInteger
+ where
+  (mn, mx) = minMax @a
+  msg s = "integerToEnumSafe:" ++ s ++ " where " ++ show i ++ " not in range [" ++ show mn ++ ".." ++ show mx ++ "]"
+
+-- | convert toEnum of "a" into a nonempty list containing "a"s
+toEnumList1 :: forall a. (Enum a, Bounded a) => Integer -> Either String (NonEmpty a)
+toEnumList1 i =
+  toEnumList i <&> \case
+    [] -> minBound :| []
+    a : as -> a :| as
+
+-- | reverse of 'toEnumList' [can fail if xs is null and toEnum 0 is not defined]
+fromEnumFoldable ::
+  forall a t.
+  (Foldable t, Enum a, Bounded a) =>
+  t a ->
+  Either String Integer
+fromEnumFoldable xs =
+  case toList xs of
+    [] -> 0 <$ zerolr @a
+    a : as -> pure $ fromEnumFoldable1 (a :| as)
+
+-- | reverse of 'toEnumList1' [cant fail]
+fromEnumFoldable1 ::
+  forall a t.
+  (Foldable1 t, Enum a, Bounded a) =>
+  t a ->
+  Integer
+fromEnumFoldable1 xs =
+  let (mn, mx) = minMax @a
+      nn, pp :: Maybe Integer
+      nn = if mn < 0 then Just (-1) else Nothing
+      pp = if mx > 0 then Just 1 else Nothing
+      f ::
+        a ->
+        (Integer, (Maybe Integer, Maybe Integer)) ->
+        (Integer, (Maybe Integer, Maybe Integer))
+      f a (b, (n, p)) =
+        let v = toInteger (fromEnum a)
+            w = case (compare v 0, n, p) of
+              (LT, Just x, _) -> b - v * x
+              (EQ, _, _) -> b
+              (GT, _, Just y) -> b + v * y
+              o -> programmError $ "fromEnumFoldable1 " ++ show o
+         in (w, ((\x -> -(mn - 1) * x) <$> n, (\x -> (mx + 1) * x) <$> p))
+   in fst $ foldr f (0, (nn, pp)) xs
+
+-- | 'succ' for a traversable container
+succTraversable ::
+  forall a t.
+  (Traversable t, Enum a, Bounded a) =>
+  t a ->
+  Either String (t a)
+succTraversable xs =
+  let f :: Bool -> a -> (Bool, a)
+      f b a =
+        case (b, succSafe a) of
+          (True, Just a') -> (False, a')
+          (True, Nothing) -> (True, minBound)
+          _o -> (b, a)
+      (lft, ret) = L.mapAccumR f True xs
+   in if lft
+        then Left "succTraversable: over maxbound"
+        else Right ret
+
+-- | 'pred' for a traversable container
+predTraversable ::
+  forall a t.
+  (Traversable t, Enum a, Bounded a) =>
+  t a ->
+  Either String (t a)
+predTraversable xs =
+  let f :: Bool -> a -> (Bool, a)
+      f b a =
+        case (b, predSafe a) of
+          (True, Just a') -> (False, a')
+          (True, Nothing) -> (True, maxBound)
+          _o -> (b, a)
+      (lft, ret) = L.mapAccumR f True xs
+   in if lft
+        then Left "predTraversable: below minbound"
+        else Right ret
+
+{- | generate all the possible enum combinations for the given container in ascending order
+
+ useful for creating all the valid indices for matrices
+-}
+universeTraversable ::
+  forall f a.
+  (Traversable f, Enum a, Bounded a) =>
+  f a ->
+  Either String (NonEmpty (f a))
+universeTraversable ta = do
+  (mn, mx) <- capacity @a ta
+  traverse (toEnumTraversable ta) (mn :| drop 1 [mn .. mx])
diff --git a/src/Primus/Error.hs b/src/Primus/Error.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/Error.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{- |
+Module      : Primus.Error
+Description : error methods
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.Error (
+  -- * force conversion from an Either
+  forceRight,
+  forceRightP,
+  fr,
+  frp,
+
+  -- * force conversion from a nonempty list
+  fromList1,
+  fromList1P,
+  ne,
+  nep,
+
+  -- * error types
+  programmError,
+  normalError,
+  compileError,
+
+  -- * decorate an error
+  lmsg,
+) where
+
+import Control.Arrow
+import Data.List.NonEmpty (NonEmpty (..))
+import GHC.Stack
+
+-- | indicates a programmer error
+programmError :: HasCallStack => String -> a
+programmError s = withFrozenCallStack $ error $ "programm error:" ++ s
+
+-- | indicates a user error
+normalError :: HasCallStack => String -> a
+normalError s = withFrozenCallStack $ error s
+
+-- | indicates a compiler error
+compileError :: HasCallStack => String -> a
+compileError s = withFrozenCallStack $ error $ "should be a compile error (check the constraints):" ++ s
+
+-- | unsafe force an error if 'Left'
+forceRight :: HasCallStack => String -> Either String a -> a
+forceRight s = \case
+  Left e -> withFrozenCallStack $ error $ "forceRight:" ++ s ++ " e=" ++ e
+  Right a -> a
+
+-- | unsafe force an error if 'Left'
+forceRightP :: HasCallStack => String -> Either String a -> a
+forceRightP s = \case
+  Left e -> withFrozenCallStack $ error $ "programmer error:" ++ s ++ " e=" ++ e
+  Right a -> a
+
+-- | unsafe force an error if 'Left'
+fr :: HasCallStack => Either String a -> a
+fr = forceRight ""
+
+-- | unsafe force an error if 'Left'
+frp :: HasCallStack => Either String a -> a
+frp = forceRightP ""
+
+-- | prepend an error message
+lmsg :: String -> Either String a -> Either String a
+lmsg s =
+  left
+    ( \e -> case s of
+        [] -> e
+        _ : _ -> s <> ":" <> e
+    )
+
+-- | unsafe conversion from list to a nonempty list
+ne :: HasCallStack => [a] -> NonEmpty a
+ne =
+  \case
+    [] -> normalError "ne:list is empty"
+    x : xs -> x :| xs
+
+-- | unsafe conversion from list to a nonempty list
+nep :: HasCallStack => [a] -> NonEmpty a
+nep =
+  \case
+    [] -> programmError "nep:list is empty"
+    x : xs -> x :| xs
+
+-- | unsafe conversion from list to a nonempty list
+fromList1 :: HasCallStack => String -> [a] -> NonEmpty a
+fromList1 msg =
+  \case
+    [] -> normalError $ "fromList1:" ++ msg
+    x : xs -> x :| xs
+
+-- | unsafe conversion from list to a nonempty list
+fromList1P :: HasCallStack => String -> [a] -> NonEmpty a
+fromList1P msg =
+  \case
+    [] -> programmError $ "fromList1P:" ++ msg
+    x : xs -> x :| xs
diff --git a/src/Primus/Extra.hs b/src/Primus/Extra.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/Extra.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{- |
+Module      : Primus.Extra
+Description : miscellaneous functions
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.Extra (
+  on1,
+  on2,
+  comparing1,
+  (.@),
+) where
+
+-- | more flexible version of 'Data.Function.on' that allows differing types for the same container
+on1 ::
+  forall f a a' b c.
+  (b -> b -> c) ->
+  (forall x. f x -> b) ->
+  f a ->
+  f a' ->
+  c
+on1 f g fa fa' = f (g fa) (g fa')
+
+-- | more flexible version of 'Data.Function.on' that allows differing types for the same container but using two parameters
+on2 ::
+  forall f a a' a2 a2' b c.
+  (b -> b -> c) ->
+  (forall x y. f x y -> b) ->
+  f a a2 ->
+  f a' a2' ->
+  c
+on2 f g fa fa' = f (g fa) (g fa')
+
+-- | more flexible version of 'compare' that allows differing types for the same container
+comparing1 ::
+  forall f a a' b.
+  Ord b =>
+  (forall x. f x -> b) ->
+  f a ->
+  f a' ->
+  Ordering
+comparing1 g fa fa' = compare (g fa) (g fa')
+
+-- | compose a two arg function followed by a one arg function
+(.@) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
+(.@) = (.) . (.)
+
+infixr 8 .@
diff --git a/src/Primus/Fold.hs b/src/Primus/Fold.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/Fold.hs
@@ -0,0 +1,472 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{- |
+Module      : Primus.Fold
+Description : fold and unfolds
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.Fold (
+  -- * fill a container
+  fillTraversable,
+  fillTraversableExact,
+  traverseLR,
+
+  -- * extended traversals with access to past and future input
+  histMapL,
+  histMapR,
+  histMapL',
+  histMapR',
+
+  -- * change inside of a container
+  wrapL,
+  wrap1,
+
+  -- * fold and unfolds
+  pFoldR,
+  pFoldL,
+  unfoldl,
+  unfoldrM,
+  unfoldlM,
+
+  -- * zip
+  zipExtrasT,
+  zipExtrasRight,
+  zipWithExact,
+  zipExact,
+  zipWithT,
+
+  -- * compare container lengths
+  CLCount (..),
+  compareLength,
+  compareLengthBy,
+  compareLengths,
+  clOrdering,
+
+  -- * pad containers
+  padR,
+  padL,
+
+  -- * chunking
+  chunkN,
+  chunkN',
+
+  -- * scan
+  postscanl,
+  postscanr,
+
+  -- * miscellaneous
+  initsT,
+  tailsT,
+  reverseT,
+  sortByT,
+  unzipF,
+  reverseF,
+) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Monad
+import Data.Bool
+import Data.Foldable
+import Data.Kind
+import qualified Data.List as L
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as N
+import Data.Semigroup.Foldable
+import Data.These
+import Data.These.Combinators
+import Primus.Error
+import Primus.Extra
+
+data Hist a b = Hist ![a] ![a] !b
+
+getHistZ :: Hist a b -> b
+getHistZ (Hist _ _ z) = z
+
+{- | left fold over a list giving the caller access to past and future input and state "z"
+ if you want previous "b" values then put it in "z"
+-}
+histMapImpl ::
+  Traversable t =>
+  Bool ->
+  ([a] -> [a] -> z -> a -> (z, b)) ->
+  z ->
+  t a ->
+  (z, t b)
+histMapImpl isright f z0 lst =
+  first getHistZ $
+    bool
+      L.mapAccumL
+      L.mapAccumR
+      isright
+      g
+      (Hist [] (bool toList reverseF isright lst) z0)
+      lst
+ where
+  g (Hist ps ft z) a =
+    case ft of
+      [] -> programmError "histMapImpl: ran out of data!"
+      _ : ft0 ->
+        let (z', b) = f ps ft0 z a
+         in (Hist (a : ps) ft0 z', b)
+
+-- | left/right fold over a list giving the caller access state "z" (for finite containers only)
+histMapL
+  , histMapR ::
+    Traversable t =>
+    ([a] -> [a] -> z -> a -> (z, b)) ->
+    z ->
+    t a ->
+    (z, t b)
+histMapL = histMapImpl False
+histMapR = histMapImpl True
+
+-- | left/right fold that gives access to past input (reverse order) and future input
+pFoldL, pFoldR :: forall a b. ([a] -> [a] -> b -> a -> b) -> b -> [a] -> b
+pFoldR f n = go []
+ where
+  go :: [a] -> [a] -> b
+  go pres = \case
+    [] -> n
+    a : as -> f pres as (go (a : pres) as) a
+pFoldL f = go []
+ where
+  go :: [a] -> b -> [a] -> b
+  go pres !z = \case
+    [] -> z
+    a : as -> go (a : pres) (f pres as z a) as
+
+histMapImpl' ::
+  forall a b t.
+  Traversable t =>
+  Bool ->
+  ([a] -> [a] -> a -> b) ->
+  t a ->
+  t b
+histMapImpl' isright f = snd . bool histMapL histMapR isright g ()
+ where
+  g :: [a] -> [a] -> () -> a -> ((), b)
+  g ps ft () a = ((), f ps ft a)
+
+-- | same as 'histMapL' or 'histMapR' but skips state
+histMapL'
+  , histMapR' ::
+    forall a b t.
+    Traversable t =>
+    ([a] -> [a] -> a -> b) ->
+    t a ->
+    t b
+histMapL' = histMapImpl' False
+histMapR' = histMapImpl' True
+
+-- | like 'Data.List.unfoldr' but reverses the order of the list
+unfoldl :: forall s a. (s -> Maybe (a, s)) -> s -> [a]
+unfoldl f = go []
+ where
+  go :: [a] -> s -> [a]
+  go as !s = case f s of
+    Nothing -> as
+    Just (a, s1) -> go (a : as) s1
+
+-- | monadic unfoldr
+unfoldrM :: forall m s a. Monad m => (s -> m (Maybe (a, s))) -> s -> m [a]
+unfoldrM f s = do
+  mas <- f s
+  case mas of
+    Nothing -> return []
+    Just (a, s') -> (a :) <$> unfoldrM f s'
+
+-- | monadic unfoldl
+unfoldlM :: forall m s a. Monad m => (s -> m (Maybe (a, s))) -> s -> m [a]
+unfoldlM f = go []
+ where
+  go :: [a] -> s -> m [a]
+  go as s = do
+    mas <- f s
+    case mas of
+      Nothing -> return as
+      Just (a, s') -> go (a : as) s'
+
+-- | traverse a container using 'StateLR'
+traverseLR ::
+  forall t a b c.
+  Traversable t =>
+  (c -> a -> Either String (c, b)) ->
+  c ->
+  t a ->
+  Either String (c, t b)
+traverseLR f c0 ta =
+  let g :: a -> StateLR String c b
+      g a = StateLR $ \c -> f c a
+   in unStateLR (traverse g ta) c0
+
+-- | fill a traversable with a list and fail if not enough data
+fillTraversable ::
+  forall t a z.
+  Traversable t =>
+  t z ->
+  [a] ->
+  Either String ([a], t a)
+fillTraversable tz as0 =
+  let g :: z -> StateLR String [a] a
+      g _ = StateLR $ \case
+        [] -> Left "fillTraversable: not enough data"
+        d : ds' -> Right (ds', d)
+   in unStateLR (traverse g tz) as0
+
+-- | fill a traversable with a list and fail if there are leftovers: see 'fillTraversable'
+fillTraversableExact ::
+  forall f a z.
+  Traversable f =>
+  f z ->
+  [a] ->
+  Either String (f a)
+fillTraversableExact = g .@ fillTraversable
+ where
+  g :: Either String ([a], b) -> Either String b
+  g = \case
+    Right ([], ret) -> Right ret
+    Right (_ : _, _) -> Left "fillTraversableExact: too many elements found"
+    Left e -> Left e
+
+-- | run a function against the contents of the 'Foldable1' container as a nonempty list
+wrap1 ::
+  forall (g :: Type -> Type) a b.
+  (Traversable g, Foldable1 g) =>
+  (NonEmpty a -> NonEmpty b) ->
+  g a ->
+  Either String (g b)
+wrap1 f gx = fillTraversableExact gx (toList (f (toNonEmpty gx)))
+
+-- | run a function against the contents of the 'Foldable' container as a list
+wrapL ::
+  forall (g :: Type -> Type) a b.
+  (Traversable g) =>
+  ([a] -> [b]) ->
+  g a ->
+  Either String (g b)
+wrapL f gx = fillTraversableExact gx (f (toList gx))
+
+-- | pad fill "as" to the right or left with values from "zs"
+padR, padL :: forall t a. Traversable t => t a -> [a] -> Either String (t a)
+padR = padImpl True
+padL = padImpl False
+
+-- | pad fill "as" to the left/right with values from "zs"
+padImpl :: forall t a. Traversable t => Bool -> t a -> [a] -> Either String (t a)
+padImpl isright as zs =
+  let (rs, zz) = bool (L.mapAccumR f (reverseF zs)) (L.mapAccumL f zs) isright as
+   in case rs of
+        [] -> Right zz
+        _ : _ -> Left $ "pad" ++ bool "L" "R" isright ++ ": negative fill: would need to truncate the data"
+ where
+  f :: [a] -> a -> ([a], a)
+  f xs a =
+    case xs of
+      [] -> ([], a)
+      b : bs -> (bs, b)
+
+-- | have to call a second time if the left container is bigger than the right one
+zipExtrasT :: forall a b t. Traversable t => t a -> t b -> t (These a b)
+zipExtrasT xs ys =
+  let (rs, ret) = zipExtrasRight (toList xs) ys
+   in case rs of
+        [] -> ret
+        _ : _ -> swapThese <$> zipExtrasT ys xs
+
+-- | zip a foldable into a traversable container and return any leftovers
+zipExtrasRight ::
+  forall a b t.
+  Traversable t =>
+  [a] ->
+  t b ->
+  ([a], t (These a b))
+zipExtrasRight = L.mapAccumL f
+ where
+  f :: [a] -> b -> ([a], These a b)
+  f zs b = case zs of
+    [] -> ([], That b)
+    a : as -> (as, These a b)
+
+-- | predicate for 'CEQ'
+clOrdering :: CLCount b -> Maybe Ordering
+clOrdering = \case
+  CError{} -> Nothing
+  CLT{} -> Just LT
+  CEQ -> Just EQ
+  CGT -> Just GT
+
+-- | difference between two foldables but quick exit if lhs is larger than rhs
+data CLCount b
+  = -- | error
+    CError !String
+  | -- | leftovers from rhs: ie lhs is smaller than rhs
+    CLT !(NonEmpty b)
+  | -- | same size
+    CEQ
+  | -- | lhs is larger than rhs
+    CGT
+  deriving stock (Ord, Show, Eq, Functor, Traversable, Foldable)
+
+-- | compare lengths of foldables
+compareLengths :: Foldable t => NonEmpty (t a) -> [CLCount a]
+compareLengths (xs :| xss) = map (compareLengthBy mempty xs) xss
+
+-- | compare length where lhs or rhs can be infinite but not both
+compareLength ::
+  forall t u a b.
+  (Foldable t, Foldable u) =>
+  t a ->
+  u b ->
+  CLCount b
+compareLength = compareLengthBy mempty
+
+-- | compare length where lhs or rhs can be infinite but not both
+compareLengthBy ::
+  forall t u a b.
+  (Foldable t, Foldable u) =>
+  (Int -> a -> b -> Maybe String) ->
+  t a ->
+  u b ->
+  CLCount b
+compareLengthBy p xs ys =
+  foldr f g xs (0, toList ys)
+ where
+  g :: (Int, [b]) -> CLCount b
+  g (_, zs) = case zs of
+    [] -> CEQ
+    w : ws -> CLT (w :| ws)
+  f :: a -> ((Int, [b]) -> CLCount b) -> (Int, [b]) -> CLCount b
+  f a k (i, zs) = case zs of
+    [] -> CGT -- quickexit
+    b : bs -> case p i a b of
+      Nothing -> k (i + 1, bs)
+      Just e -> CError e
+
+-- | 'zipWith' with an Applicative result
+zipWithT ::
+  (Applicative f, Traversable t, Applicative t) =>
+  (a -> b -> f c) ->
+  t a ->
+  t b ->
+  f (t c)
+zipWithT f = sequenceA .@ liftA2 f
+
+-- | fills a container with chunks using a user supplied unfold function
+chunkN ::
+  forall t s b z.
+  Traversable t =>
+  (s -> Either String (s, b)) ->
+  t z ->
+  s ->
+  Either String (s, t b)
+chunkN f tz = unStateLR (traverse (const (StateLR f)) tz)
+
+-- | similar to 'chunkN' but "s" is restricted to a foldable: if there is data left then will fail
+chunkN' ::
+  forall t a u b z.
+  (Traversable t, Foldable u) =>
+  (u a -> Either String (u a, b)) ->
+  t z ->
+  u a ->
+  Either String (t b)
+chunkN' f tz s = do
+  (s', ret) <- chunkN g tz s
+  if null s'
+    then Right ret
+    else Left "chunkN': there is still data remaining at eof"
+ where
+  g s' =
+    if null s'
+      then Left "chunkN': not enough data"
+      else f s'
+
+-- | splits a container "u" into parts of length "len" and fills container "t"
+zipWithExact ::
+  forall t u a b c.
+  (Traversable t, Foldable u) =>
+  (a -> b -> c) ->
+  t a ->
+  u b ->
+  Either String (t c)
+zipWithExact f ta ub = do
+  let g a = StateLR $ \case
+        [] -> Left "zipWithExact: lhs has more data"
+        b : bs -> Right (bs, f a b)
+  (vx, ret) <- unStateLR (traverse g ta) (toList ub)
+  if null vx
+    then Right ret
+    else Left "zipWithExact: lhs has less data"
+
+-- | see 'zipWithExact'
+zipExact ::
+  forall t u a b.
+  (Traversable t, Foldable u) =>
+  t a ->
+  u b ->
+  Either String (t (a, b))
+zipExact = zipWithExact (,)
+
+-- | combines state and failure as a monad
+newtype StateLR e s a = StateLR {unStateLR :: s -> Either e (s, a)}
+  deriving stock (Functor)
+
+instance Applicative (StateLR e s) where
+  pure a = StateLR $ \s -> Right (s, a)
+  (<*>) = ap
+
+instance Monad (StateLR e s) where
+  return = pure
+  StateLR sa >>= amb =
+    StateLR $ \s -> case sa s of
+      Left e -> Left e
+      Right (s1, a) -> unStateLR (amb a) s1
+
+-- | 'Data.List.inits' for a traversable container
+initsT :: forall a t. Traversable t => t a -> t (NonEmpty a)
+initsT ta = case toList ta of
+  [] -> fmap pure ta
+  i : is -> frp $ fillTraversableExact ta (map (i :|) (L.inits is))
+
+-- | 'Data.List.tails' for a traversable container
+tailsT :: forall a t. Traversable t => t a -> t (NonEmpty a)
+tailsT ta = forceRight "tailsT" $ do
+  (xs, ret) <- traverseLR g (toList ta) ta
+  case xs of
+    [] -> pure ret
+    _ : _ -> Left "extra data at eof"
+ where
+  g :: [a] -> p -> Either String ([a], NonEmpty a)
+  g s _ = case s of
+    [] -> Left "ran out of data"
+    a : as -> Right (as, a :| as)
+
+-- | 'Data.List.reverse' for a traversable container
+reverseT :: forall a t. Traversable t => t a -> t a
+reverseT = frp . wrapL reverse
+
+-- | 'Data.List.sortBy' for a traversable container
+sortByT :: forall a t. Traversable t => (a -> a -> Ordering) -> t a -> t a
+sortByT f = frp . wrapL (L.sortBy f)
+
+-- | 'N.scanr' for a traversable that drops the last value
+postscanr :: Traversable f => (a -> b -> b) -> b -> f a -> f b
+postscanr f c = frp . wrapL (N.init . N.scanr f c)
+
+-- | 'N.scanl' for a traversable that drops the first value
+postscanl :: Traversable f => (b -> a -> b) -> b -> f a -> f b
+postscanl f c = frp . wrapL (N.tail . N.scanl f c)
+
+-- | unzip for a functor of pairs
+unzipF :: Functor f => f (a, b) -> (f a, f b)
+unzipF = fmap fst &&& fmap snd
+
+-- | reverse a foldable
+reverseF :: Foldable t => t a -> [a]
+reverseF = foldl' (flip (:)) []
diff --git a/src/Primus/LRHist.hs b/src/Primus/LRHist.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/LRHist.hs
@@ -0,0 +1,520 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+-- need PolyKinds else could fail for callers using TP type families
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{- |
+Module      : Primus.LRHist
+Description : like 'Either' but keeps history of all successes
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+
+tracks one or more successes and optionally a failure
+
+prefer the smart constructors to enforce correctness or use the apply methods
+-}
+module Primus.LRHist (
+  -- * datatype
+  LRHist (..),
+
+  -- * smart constructors
+  rhi,
+  rh,
+  lh,
+  lhskip,
+
+  -- * constructors with better type application order
+  rhi',
+  rh',
+  lh',
+  lhskip',
+
+  -- * converters
+  lhToEitherI,
+  lhToEither,
+  lhToEitherTuples,
+
+  -- * function application
+  lhBool,
+  lhMaybe,
+  lhMaybe',
+  lhEither,
+  lhEither',
+  appLR,
+  appLRS,
+  appLRB,
+
+  -- * traversals
+  traverseLRHistB,
+  traverseLRHist,
+
+  -- * miscellaneous
+  eitherToLH,
+  maybeToLH,
+  validateLRHist,
+) where
+
+import Data.Bifoldable
+import Data.Bifunctor
+import Data.Bitraversable
+import Data.Bool
+import Data.Kind
+import qualified Data.List as L
+import Data.Proxy
+import Data.These
+import qualified GHC.Read as GR
+import Primus.AsMaybe
+import Primus.Bool
+import Primus.Error (programmError)
+import qualified Primus.TypeLevel as TP
+import qualified Text.ParserCombinators.ReadPrec as PC
+import qualified Text.Read.Lex as TRL
+
+{- | like 'Either' but keeps track of history of all successes
+  if there is a failure it wraps the previous successes and stops adding data to 'LRHist'
+ "e" the error type
+ "as" is the typelevel list in reverse order that tracks all previous "a"s
+ "a" is the latest success type
+-}
+type LRHist :: [Type] -> Type -> Type -> Type
+data LRHist as e a where
+  -- | wraps an existing error
+  LhSkip ::
+    LRHist as e a' ->
+    LRHist (a' ': as) e a
+  -- | wraps previous nested successes with an error
+  Lh ::
+    e ->
+    LRHist as e a' ->
+    LRHist (a' ': as) e a
+  -- | initial success value
+  Rhi ::
+    a ->
+    LRHist '[] e a
+  -- | subsequent success
+  Rh ::
+    a ->
+    LRHist as e a' ->
+    LRHist (a' ': as) e a
+
+deriving stock instance Functor (LRHist as e)
+deriving stock instance Foldable (LRHist as e)
+deriving stock instance Traversable (LRHist as e)
+deriving stock instance (Show a, Show e, TP.ApplyConstraints '[Show] as) => Show (LRHist as e a)
+deriving stock instance (TP.ApplyConstraints '[Eq, Ord] as, Eq e, Ord e, Ord a) => Ord (LRHist as e a)
+deriving stock instance (TP.ApplyConstraints '[Eq] as, Eq e, Eq a) => Eq (LRHist as e a)
+instance
+  (Semigroup e, Monoid a) =>
+  Monoid (LRHist '[] e a)
+  where
+  mempty = Rhi mempty
+instance
+  ( Monoid a
+  , Monoid e
+  , Monoid a'
+  , TP.ApplyConstraints '[Semigroup, Monoid] as
+  , Monoid (LRHist as e a')
+  ) =>
+  Monoid (LRHist (a' ': as) e a)
+  where
+  mempty = Rh mempty mempty
+
+instance
+  ( Semigroup a
+  , Semigroup e
+  , TP.ApplyConstraints '[Semigroup] as
+  ) =>
+  Semigroup (LRHist as e a)
+  where
+  x <> y = case (x, y) of
+    (Rhi a, Rhi a') -> Rhi (a <> a')
+    (Rh a ls, Rh a' ls') -> Rh (a <> a') (ls <> ls')
+    (Lh e ls, Lh e' ls') -> Lh (e <> e') (ls <> ls')
+    (LhSkip ls, LhSkip ls') -> LhSkip (ls <> ls')
+    (z@LhSkip{}, _) -> z
+    (_, z@LhSkip{}) -> z
+    (z@Lh{}, _) -> z
+    (_, z@Lh{}) -> z
+
+-- | constructor for 'Rhi' with more convenient type application order
+rhi' :: forall e a. a -> LRHist '[] e a
+rhi' = Rhi
+
+-- | constructor for 'Rh' with more convenient type application order
+rh' :: forall e a a' as. a -> LRHist as e a' -> LRHist (a' : as) e a
+rh' = Rh
+
+-- | constructor for 'Lh' with more convenient type application order
+lh' :: forall a e a' as. e -> LRHist as e a' -> LRHist (a' : as) e a
+lh' = Lh
+
+-- | constructor for 'LhSkip' with more convenient type application order
+lhskip' :: forall a e a' as. LRHist as e a' -> LRHist (a' : as) e a
+lhskip' = LhSkip
+
+-- | smart constructor for 'Rhi'
+rhi :: forall e a. a -> (Proxy 'True, LRHist '[] e a)
+rhi a = (Proxy, Rhi a)
+
+-- | smart constructor for 'Rh'
+rh ::
+  forall e a a' as proxy.
+  a ->
+  (proxy 'True, LRHist as e a') ->
+  (proxy 'True, LRHist (a' : as) e a)
+rh a = second (Rh a)
+
+-- | smart constructor for 'Lh'
+lh ::
+  forall a e a' as proxy.
+  e ->
+  (proxy 'True, LRHist as e a') ->
+  (Proxy 'False, LRHist (a' : as) e a)
+lh e (_p, z) = (Proxy, Lh e z)
+
+-- | smart constructor for 'LhSkip'
+lhskip ::
+  forall a e a' as proxy.
+  (proxy 'False, LRHist as e a') ->
+  (proxy 'False, LRHist (a' : as) e a)
+lhskip = second LhSkip
+
+-- | initialise 'LRHist' with an 'Either' by wrapping a unit
+eitherToLH :: Either e a -> LRHist '[()] e a
+eitherToLH lr = either Lh Rh lr (Rhi ())
+
+-- | initialise 'LRHist' with an 'Maybe' by wrapping a unit
+maybeToLH :: Monoid e => Maybe a -> LRHist '[()] e a
+maybeToLH = eitherToLH . maybe (Left mempty) Right
+
+-- | returns an inductive tuple on success and Either for failure
+lhToEitherI ::
+  forall e a as.
+  RHistC as =>
+  LRHist as e a ->
+  Either e (RHistT a as)
+lhToEitherI = rhist
+
+-- | convert 'LRHist' to an 'Either'
+lhToEither :: forall e a as. LRHist as e a -> Either e a
+lhToEither = \case
+  Rhi a -> Right a
+  Rh a _ -> Right a
+  Lh e _ -> Left e
+  z@LhSkip{} -> Left $ go z
+ where
+  go :: forall as' a'. LRHist as' e a' -> e
+  go = \case
+    Rhi{} -> programmError "malformed LRHist: LhSkip expects inner LhSkip or Lh but found Rhi"
+    Rh{} -> programmError "malformed LRHist: LhSkip expects LhSkip or Lh but found Rh"
+    Lh e _ -> e
+    LhSkip ls -> go ls
+
+-- | extract the initial type for 'LRHist'
+type OrgAT :: [Type] -> Type -> Type
+type family OrgAT as a where
+  OrgAT '[] a' = a'
+  OrgAT (a ': as) _ = OrgAT as a
+
+-- | extracts the initial value from 'LRHist'
+type OrgAC :: [Type] -> Type -> Constraint
+class OrgAC as a where
+  orgA :: LRHist as e a -> OrgAT as a
+
+instance OrgAC '[] a' where
+  orgA = \case
+    Rhi a -> a
+instance OrgAC as a => OrgAC (a ': as) a' where
+  orgA = \case
+    Rh _ ls -> orgA ls
+    Lh _ ls -> orgA ls
+    LhSkip ls -> orgA ls
+
+-- | returns flattened n-tuple with all the history of successes on success and Either for failure
+lhToEitherTuples ::
+  forall e a as tp.
+  ( TP.ITupleC tp
+  , RHistC as
+  , TP.ToITupleT tp ~ RHistT a as
+  ) =>
+  LRHist as e a ->
+  Either e tp
+lhToEitherTuples = fmap TP.fromITupleC . rhist
+
+-- | type family for creating an inductive tuple
+type RHistT :: Type -> [Type] -> Type
+type family RHistT a as where
+  RHistT a '[] = (a, ())
+  RHistT a (a' ': as) = (a, RHistT a' as)
+
+-- | return an inductive tuple on success
+type RHistC :: [Type] -> Constraint
+class RHistC as where
+  rhist :: LRHist as e a -> Either e (RHistT a as)
+
+instance RHistC '[] where
+  rhist = \case
+    Rhi a -> Right (a, ())
+instance RHistC as => RHistC (a ': as) where
+  rhist = \case
+    Rh a ls -> (a,) <$> rhist ls
+    Lh e _ -> Left e
+    LhSkip ls -> case rhist ls of
+      Left e -> Left e
+      Right _a -> programmError "malformed LRHist: LhSkip wrapping Rh or Rhi"
+
+-- | validate that the composition of constructors for 'LRHist' is valid
+validateLRHist :: forall e a as. LRHist as e a -> Either String ()
+validateLRHist =
+  \case
+    Rhi{} -> Right ()
+    Rh _ ls -> case ls of
+      Lh{} -> Left "Rh cannot wrap Lh"
+      LhSkip{} -> Left "Rh cannot wrap LhSkip"
+      Rhi{} -> validateLRHist ls
+      Rh{} -> validateLRHist ls
+    Lh _ ls -> case ls of
+      Lh{} -> Left "Lh cannot wrap Lh"
+      LhSkip{} -> Left "Lh cannot wrap LhSkip"
+      Rhi{} -> validateLRHist ls
+      Rh{} -> validateLRHist ls
+    LhSkip ls -> case ls of
+      Lh{} -> validateLRHist ls
+      LhSkip{} -> validateLRHist ls
+      Rhi{} -> Left "LhSkip cannot wrap Rhi"
+      Rh{} -> Left "LhSkip cannot wrap Rh"
+
+-- | base case for 'LRHist' Read instance for '[] so only supports 'Rhi' constructor
+instance
+  (Read a, Read e) =>
+  Read (LRHist '[] e a)
+  where
+  readPrec =
+    GR.parens
+      ( PC.prec
+          10
+          ( do
+              GR.expectP (TRL.Ident "Rhi")
+              a <- PC.step GR.readPrec
+              return (Rhi a)
+          )
+      )
+
+-- | successor case for 'LRHist' Read instance (a' ': as) so supports 'Rh', 'Lh', 'LhSkip' constructors
+instance
+  ( Read a
+  , Read e
+  , Read a'
+  , Read (LRHist as e a')
+  , TP.ApplyConstraints '[Read] as
+  ) =>
+  Read (LRHist (a' ': as) e a)
+  where
+  readPrec =
+    GR.parens
+      ( PC.prec
+          10
+          ( do
+              GR.expectP (TRL.Ident "LhSkip")
+              rst <- PC.step GR.readPrec
+              return (LhSkip rst)
+          )
+          PC.+++ PC.prec
+            10
+            ( do
+                GR.expectP (TRL.Ident "Lh")
+                e <- PC.step GR.readPrec
+                rst <- PC.step GR.readPrec
+                return (Lh e rst)
+            )
+          PC.+++ PC.prec
+            10
+            ( do
+                GR.expectP (TRL.Ident "Rh")
+                a <- PC.step GR.readPrec
+                rst <- PC.step GR.readPrec
+                return (Rh a rst)
+            )
+      )
+
+instance Bifunctor (LRHist as) where
+  bimap f g = \case
+    Rhi a -> Rhi (g a)
+    Rh a ls -> Rh (g a) (first f ls)
+    Lh e ls -> Lh (f e) (first f ls)
+    LhSkip ls -> LhSkip (first f ls)
+
+instance Bifoldable (LRHist as) where
+  bifoldMap f g = \case
+    Rhi a -> g a
+    Rh a ls -> g a <> bifoldMap f (const mempty) ls
+    Lh e ls -> f e <> bifoldMap f (const mempty) ls
+    LhSkip ls -> bifoldMap f (const mempty) ls
+
+instance Bitraversable (LRHist as) where
+  bitraverse f g = \case
+    Rhi a -> Rhi <$> g a
+    Rh a ls -> Rh <$> g a <*> bitraverse f pure ls
+    Lh e ls -> Lh <$> f e <*> bitraverse f pure ls
+    LhSkip ls -> LhSkip <$> bitraverse f pure ls
+
+-- | uses a boolean predicate to determine success or failure
+lhBool ::
+  forall e a a' as.
+  (a ~ a', Monoid e) =>
+  (a' -> Bool) ->
+  LRHist as e a' ->
+  LRHist (a' ': as) e a
+lhBool f w =
+  case w of
+    Rhi a -> k a
+    Rh a _ls -> k a
+    Lh{} -> LhSkip w
+    LhSkip{} -> LhSkip w
+ where
+  k a = bool (Lh mempty) (Rh a) (f a) w
+
+-- | uses a maybe function to determine success or failure and also allow change of type "a"
+lhMaybe ::
+  forall e a a' as.
+  Monoid e =>
+  (a' -> Maybe a) ->
+  LRHist as e a' ->
+  LRHist (a' ': as) e a
+lhMaybe f w =
+  case w of
+    Rhi a -> k a
+    Rh a _ls -> k a
+    Lh{} -> LhSkip w
+    LhSkip{} -> LhSkip w
+ where
+  k a = maybe (Lh mempty) Rh (f a) w
+
+-- | similar to 'lhMaybe' leveraging 'boolMaybe'
+lhMaybe' ::
+  forall e a a' as.
+  Monoid e =>
+  (a' -> Bool) ->
+  (a' -> a) ->
+  LRHist as e a' ->
+  LRHist (a' ': as) e a
+lhMaybe' p f w =
+  case w of
+    Rhi a -> k a
+    Rh a _ls -> k a
+    Lh{} -> LhSkip w
+    LhSkip{} -> LhSkip w
+ where
+  k a = maybe (Lh mempty) Rh (boolMaybe p f a) w
+
+-- | uses an either function to determine success or failure and also allow change of type "a"
+lhEither ::
+  forall e a a' as.
+  (a' -> Either e a) ->
+  LRHist as e a' ->
+  LRHist (a' ': as) e a
+lhEither f w =
+  case w of
+    Rhi a -> either Lh Rh (f a) w
+    Rh a _ls -> either Lh Rh (f a) w
+    Lh{} -> LhSkip w
+    LhSkip{} -> LhSkip w
+
+-- | similar to 'lhEither' leveraging 'boolEither'
+lhEither' ::
+  forall e a a' as.
+  (a' -> Bool) ->
+  (a' -> e) ->
+  (a' -> a) ->
+  LRHist as e a' ->
+  LRHist (a' ': as) e a
+lhEither' p l r w =
+  case w of
+    Rhi a -> k a
+    Rh a _ls -> k a
+    Lh{} -> LhSkip w
+    LhSkip{} -> LhSkip w
+ where
+  k a = either Lh Rh (boolEither p l r a) w
+
+-- | apply a function to 'LRHist' using 'ApTheseF'
+appLR ::
+  forall e a a' as x.
+  (ApTheseF e a' x a) =>
+  (a' -> x) ->
+  LRHist as e a' ->
+  LRHist (a' ': as) e a
+appLR f w =
+  case w of
+    Rhi a -> k a
+    Rh a _ls -> k a
+    Lh{} -> LhSkip w
+    LhSkip{} -> LhSkip w
+ where
+  k a =
+    let th = apTheseF a (f a)
+     in these Lh Rh (const Rh) th w
+
+-- | similar to 'appLR' with state
+appLRS ::
+  forall e a' x a as z.
+  (ApTheseF e a' x a) =>
+  (z -> a' -> (z, x)) ->
+  z ->
+  LRHist as e a' ->
+  (z, LRHist (a' ': as) e a)
+appLRS f z w =
+  case w of
+    Rhi a -> k a
+    Rh a _ls -> k a
+    Lh{} -> (z, LhSkip w)
+    LhSkip{} -> (z, LhSkip w)
+ where
+  k a =
+    let (z1, th) = second (apTheseF a) (f z a)
+     in (z1, these Lh Rh (const Rh) th w)
+
+-- | apply a function to a 'LRHist' via 'boolEither'
+appLRB ::
+  forall e a a' as.
+  (a' -> Bool) ->
+  (a' -> e) ->
+  (a' -> a) ->
+  LRHist as e a' ->
+  LRHist (a' ': as) e a
+appLRB p l r = appLR (boolEither p l r)
+
+-- | convenience method to apply 'appLR' to a container of 'LRHist' with state
+traverseLRHist ::
+  forall e a t a' as z.
+  Traversable t =>
+  (z -> a' -> (z, Either e a)) ->
+  z ->
+  t (LRHist as e a') ->
+  (z, t (LRHist (a' ': as) e a))
+traverseLRHist f = L.mapAccumL (appLRS f)
+
+-- | convenience method to apply 'appLRB' to a container of 'LRHist'
+traverseLRHistB ::
+  forall e a t a' as.
+  Functor t =>
+  (a' -> Bool) ->
+  (a' -> e) ->
+  (a' -> a) ->
+  t (LRHist as e a') ->
+  t (LRHist (a' ': as) e a)
+traverseLRHistB p l r = fmap (appLRB p l r)
diff --git a/src/Primus/Lens.hs b/src/Primus/Lens.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/Lens.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{- |
+Module      : Primus.Lens
+Description : minimal lens interfaces
+
+-}
+module Primus.Lens (
+  Lens,
+  Lens',
+  lens,
+  Iso,
+  iso,
+  Traversal,
+  _Fst,
+  _Snd,
+) where
+
+import Data.Profunctor
+
+-- | lens type synonym
+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
+
+-- | restricted lens type synonym
+type Lens' s a = Lens s s a a
+
+-- | create a lens
+lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
+lens sa sbt afb s = sbt s <$> afb (sa s)
+{-# INLINE lens #-}
+
+-- | isomorphism type synonym
+type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)
+
+-- | create an isomoprhism
+iso :: (s -> a) -> (b -> t) -> Iso s t a b
+iso sa bt = dimap sa (fmap bt)
+{-# INLINE iso #-}
+
+-- | traversal type synonym
+type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
+
+-- | simple lens for accessing the first value in a tuple
+_Fst :: forall a x a'. Lens (a, x) (a', x) a a'
+_Fst = lens fst (\(_, x) a' -> (a', x))
+{-# INLINE _Fst #-}
+
+-- | simple lens for accessing the second value in a tuple
+_Snd :: forall x b b'. Lens (x, b) (x, b') b b'
+_Snd = lens snd (\(x, _) b' -> (x, b'))
+{-# INLINE _Snd #-}
diff --git a/src/Primus/List.hs b/src/Primus/List.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/List.hs
@@ -0,0 +1,254 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+
+{- |
+Module      : Primus.List
+Description : list functions
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.List (
+  -- * partition methods
+  partitionEithersL,
+  partitionEithersL',
+  partitionTheseL,
+  partitionTheseL',
+  partitionM,
+
+  -- * span methods
+  spanMaybe,
+  spanMaybe',
+  lengthExact,
+  zipWithLongest,
+  zipLongest,
+
+  -- * chunking
+  pairsOf1,
+  pairsOf2,
+  pairsOf',
+  chunksOf,
+
+  -- * split methods
+  splitAtLGE,
+  splits,
+  SplitL (..),
+  splitAtL,
+  atL,
+  atNoteL,
+  updateAtL,
+  setAtL,
+
+  -- * miscellaneous
+  allEqual,
+  allEqualBy,
+  snocL,
+  unsnocL,
+) where
+
+import Control.Arrow
+import Data.Bool
+import Data.Either
+import qualified Data.List as L
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as N
+import Data.Pos
+import Data.These
+import GHC.Stack
+import Primus.Bool
+import Primus.Error
+import Primus.Extra
+
+-- | split a list into overlapping pairs plus overflow
+pairsOf1 :: [a] -> ([(a, a)], Maybe a)
+pairsOf1 = pairsOf' _1P
+
+-- | split a list into non-overlapping pairs plus overflow
+pairsOf2 :: [a] -> ([(a, a)], Maybe a)
+pairsOf2 = pairsOf' _2P
+
+-- | split into pairs skipping given number of values
+pairsOf' :: forall a. Pos -> [a] -> ([(a, a)], Maybe a)
+pairsOf' (Pos i) = go
+ where
+  go :: [a] -> ([(a, a)], Maybe a)
+  go =
+    \case
+      [] -> ([], Nothing)
+      [a] -> ([], Just a)
+      [a, a'] -> ([(a, a')], Nothing)
+      (a : a' : a'' : as) ->
+        let (x, y) = go (drop (i - 1) (a' : a'' : as))
+         in ((a, a') : x, y)
+
+-- | simple utility for chunking data but guarantees we make progress
+chunksOf :: forall a. Pos -> [a] -> [[a]]
+chunksOf (Pos n) = L.unfoldr f
+ where
+  f :: [a] -> Maybe ([a], [a])
+  f = \case
+    [] -> Nothing
+    xs@(_ : _) -> Just (splitAt n xs)
+
+-- | checks that the list has all the same values
+allEqual :: Eq a => [a] -> Either (a, a) ()
+allEqual = allEqualBy (==)
+
+-- | checks that the list has all the same values with a predicate
+allEqualBy :: (a -> a -> Bool) -> [a] -> Either (a, a) ()
+allEqualBy f =
+  \case
+    [] -> pure ()
+    [_] -> pure ()
+    x : x' : xs
+      | f x x' -> allEqualBy f (x' : xs)
+      | otherwise -> Left (x, x')
+
+-- | represents the status of a split on a list
+data SplitL a
+  = SplitLNeg !Pos
+  | SplitLLT !Int
+  | SplitLEQ
+  | SplitLGT !(NonEmpty a)
+  deriving stock (Ord, Show, Eq)
+
+-- | split a list preserving information about the split
+splitAtL :: forall a. Int -> [a] -> ([a], SplitL a)
+splitAtL n xs
+  | n < 0 = (xs, SplitLNeg (unsafePos "x" (-n)))
+  | otherwise = go 0 xs
+ where
+  go :: Int -> [a] -> ([a], SplitL a)
+  go i []
+    | i == n = ([], SplitLEQ)
+    | otherwise = ([], SplitLLT i)
+  go i (a : as)
+    | i == n = ([], SplitLGT (a :| as))
+    | otherwise = first (a :) (go (i + 1) as)
+
+-- | split a list but has to have enough elements else fails
+splitAtLGE :: Int -> [a] -> Either String ([a], [a])
+splitAtLGE n as =
+  let (ns, z) = splitAtL n as
+   in (ns,) <$> case z of
+        SplitLNeg (Pos j) -> Left $ "negative index " ++ show j
+        SplitLLT len -> Left $ "not enough elements: expected " ++ show n ++ " found " ++ show len
+        SplitLEQ -> pure mempty
+        SplitLGT ex -> pure (N.toList ex)
+
+-- | set a value at a given index in a list
+setAtL :: Int -> a -> [a] -> Maybe [a]
+setAtL i0 = updateAtL i0 . const
+
+-- | update a value at a given index in a list
+updateAtL :: Int -> (a -> a) -> [a] -> Maybe [a]
+updateAtL i f as0 =
+  case atLImpl i as0 of
+    Right (a, (xs, ys)) -> Just (xs <> (f a : ys))
+    Left _ -> Nothing
+
+-- | update a value at a given index in a list
+atLImpl :: Int -> [a] -> Either String (a, ([a], [a]))
+atLImpl i as0 =
+  let (xs, ys) = splitAtL i as0
+   in case ys of
+        SplitLNeg (Pos j) -> Left $ "negative index " ++ show j
+        SplitLLT _ -> Left $ "LT: i=" <> show i <> " out of bounds"
+        SplitLEQ -> Left $ "EQ: i=" <> show i <> " out of bounds"
+        SplitLGT (a :| as) -> Right (a, (xs, as))
+
+-- | index into a list
+atL :: Int -> [a] -> Maybe a
+atL = either (const Nothing) (Just . fst) .@ atLImpl
+
+-- | unsafe index into a list
+atNoteL :: HasCallStack => String -> [a] -> Int -> a
+atNoteL msg = fst . forceRight msg .@ flip atLImpl
+
+-- | compares the length of a potentially infinite list with "n" and succeeds if they are the same
+lengthExact :: Int -> [a] -> Either String [a]
+lengthExact n xs =
+  let (as, z) = splitAtL n xs
+   in case z of
+        SplitLNeg (Pos j) -> Left $ "negative index " ++ show j
+        SplitLLT len -> Left $ "LT: expected " ++ show n ++ " found " ++ show len
+        SplitLEQ -> Right as
+        SplitLGT _ -> Left $ "GT: too many elements: expected " ++ show n
+
+-- | creates the longest of the two lists: fills with 'This' or 'That'
+zipWithLongest :: forall a b c. (These a b -> c) -> [a] -> [b] -> [c]
+zipWithLongest f = go .@ (,)
+ where
+  go = \case
+    ([], []) -> []
+    (xs@(_ : _), []) -> map (f . This) xs
+    ([], ys@(_ : _)) -> map (f . That) ys
+    (x : xs, y : ys) -> f (These x y) : go (xs, ys)
+
+-- | 'zipWithLongest' for 'id'
+zipLongest :: [a] -> [b] -> [These a b]
+zipLongest = zipWithLongest id
+
+-- | break up a list into all possible pairs of nonempty lists: see 'Primus.NonEmpty.splits1'
+splits :: forall a. [a] -> [([a], [a])]
+splits = \case
+  [] -> []
+  x : xs -> go ([x], xs)
+ where
+  go :: ([a], [a]) -> [([a], [a])]
+  go = \case
+    ([], _) -> []
+    (_, []) -> []
+    (a : as, b : bs) -> (a : as, b : bs) : go (a : as ++ [b], bs)
+
+-- | like 'Data.List.partition' but allow the user to change the types of "e" and "b" using 'Either'
+partitionEithersL' :: Foldable t => (a -> Either e b) -> t a -> ([e], [b])
+partitionEithersL' f = partitionEithers . foldr ((:) . f) []
+
+-- | like 'partitionEithersL'' using 'Primus.Bool.boolEither'
+partitionEithersL :: Foldable t => (a -> Bool) -> (a -> e) -> (a -> b) -> t a -> ([e], [b])
+partitionEithersL p l r = partitionEithers . foldr ((:) . boolEither p l r) []
+
+-- | like 'Data.List.partition' but allow the user to change the types of "e" and "b" using 'These'
+partitionTheseL' :: Foldable t => (a -> These e b) -> t a -> ([e], [b], [(e, b)])
+partitionTheseL' f = partitionThese . foldr ((:) . f) []
+
+-- | like 'partitionTheseL' using 'Primus.Bool.boolThese'
+partitionTheseL :: Foldable t => (a -> Bool) -> (a -> Bool) -> (a -> e) -> (a -> b) -> t a -> ([e], [b], [(e, b)])
+partitionTheseL p q l r = partitionThese . foldr ((:) . boolThese p q l r) []
+
+-- | like 'Data.List.span' but allow the user to change the success type using 'Maybe'
+spanMaybe' :: (a -> Maybe b) -> [a] -> ([b], [a])
+spanMaybe' f = go
+ where
+  go = \case
+    [] -> ([], [])
+    a : as -> case f a of
+      Nothing -> ([], a : as)
+      Just b -> first (b :) (go as)
+
+-- | like 'spanMaybe'' using 'Primus.Bool.boolMaybe'
+spanMaybe :: (a -> Bool) -> (a -> b) -> [a] -> ([b], [a])
+spanMaybe p r = spanMaybe' (boolMaybe p r)
+
+-- | partition for an applicative
+partitionM :: Applicative m => (a -> m Bool) -> [a] -> m ([a], [a])
+partitionM f = go
+ where
+  go = \case
+    [] -> pure mempty
+    a : as -> (\b -> bool first second b (a :)) <$> f a <*> go as
+
+-- | snoc for a list
+snocL :: [a] -> a -> [a]
+snocL as a = as ++ [a]
+
+-- | unsnoc for a value and a list
+unsnocL :: a -> [a] -> ([a], a)
+unsnocL a =
+  \case
+    [] -> ([], a)
+    x : xs -> first (a :) (unsnocL x xs)
diff --git a/src/Primus/NonEmpty.hs b/src/Primus/NonEmpty.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/NonEmpty.hs
@@ -0,0 +1,532 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ViewPatterns #-}
+
+{- |
+Module      : Primus.NonEmpty
+Description : utilities for nonempty lists
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.NonEmpty (
+  MLR (..),
+
+  -- * zip
+  zipWithExtras1,
+  zipWithExtras,
+  mlrOrdering,
+  fromList1LR,
+
+  -- * chunking
+  chunksOf1,
+  chunksRange1,
+  chunkNLen,
+  chunkNLen1,
+
+  -- * split
+  Split1 (..),
+  split1Ordering,
+  splitAt1,
+  splitAt1',
+  splitAt1GE,
+  splitAts1,
+  splits1,
+  splits3,
+
+  -- * partition
+  partition1,
+  --  toThese1,
+
+  -- * span
+  spanAdjacent1,
+  breakAdjacent1,
+  span1,
+  break1,
+
+  -- * ascending order methods
+  Seq1 (..),
+  isSequence1,
+  isEnumAscending,
+  seq1Ordering,
+
+  -- * isomorphisms
+  uncons1,
+  unsnoc1,
+  consNonEmpty,
+  snocNonEmpty,
+
+  -- * positive specific functions
+  sumP,
+  lengthP,
+
+  -- * fold unfold
+  foldMapM1,
+  unfoldr1NE,
+  unfoldrM1,
+
+  -- * iterators
+  iterateMaybe1,
+  iterateMaybe1',
+  iterateN1,
+  replicateP,
+
+  -- * miscellaneous
+  appendL1,
+  appendR1,
+  snoc1,
+  updateAt1,
+  at1,
+  setAt1,
+  units1,
+  unitsF,
+  lengthExact1,
+  take1,
+  sum1,
+  groupByAdjacent1,
+  findDupsBy,
+  replicate1,
+  replicate1M,
+) where
+
+import Control.Arrow
+import Control.Monad
+import Data.Either
+import Data.Foldable
+import Data.Function
+import qualified Data.List as L
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as N
+import Data.Pos
+import Data.Semigroup
+import Data.Semigroup.Foldable
+import Data.These
+import Data.Tuple
+import qualified GHC.Exts as GE (IsList (..))
+import Primus.Bool
+import Primus.Error
+import Primus.Extra
+import Primus.Fold
+import Primus.Lens
+
+-- | zips two nonempty lists together and puts any leftovers into 'MLR'
+zipWithExtras1 :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> (NonEmpty c, MLR a b)
+zipWithExtras1 f (a :| as) (b :| bs) = first (f a b :|) $ zipWithExtras f as bs
+
+-- | represents an optional 'Either' ie Maybe (Either (NonEmpty a) (NonEmpty b))
+data MLR a b
+  = -- | extra values on the left hand side
+    MLRLeft !(NonEmpty a)
+  | -- | both values have the same length
+    MLREqual
+  | -- | extra values on the right hand side
+    MLRRight !(NonEmpty b)
+  deriving stock (Show, Eq, Ord)
+
+-- | 'MLRLeft' predicate
+mlrOrdering :: MLR a b -> Ordering
+mlrOrdering = \case
+  MLRLeft{} -> LT
+  MLREqual -> EQ
+  MLRRight{} -> GT
+
+-- | zips two lists together and puts any leftovers into 'MLR'
+zipWithExtras :: forall a b c. (a -> b -> c) -> [a] -> [b] -> ([c], MLR a b)
+zipWithExtras f = go
+ where
+  go [] [] = ([], MLREqual)
+  go (a : as) (b : bs) = let (x, y) = go as bs in (f a b : x, y)
+  go (a : as) [] = ([], MLRLeft (a :| as))
+  go [] (b : bs) = ([], MLRRight (b :| bs))
+
+-- | conversion from list to a nonempty list
+fromList1LR :: [a] -> Either String (NonEmpty a)
+fromList1LR =
+  \case
+    [] -> Left "fromList1LR: empty list"
+    n : ns -> Right $ n :| ns
+
+-- | split a nonempty list into a nonempty list of nonempty chunks
+chunksOf1 :: Pos -> NonEmpty a -> NonEmpty (NonEmpty a)
+chunksOf1 = join chunksRange1
+
+{- | split a nonempty list into a nonempty list of nonempty chunks given a chunk size and how many to skip each iteration
+ can decide the size of the chunks and how many elements to skip
+-}
+chunksRange1 :: Pos -> Pos -> NonEmpty a -> NonEmpty (NonEmpty a)
+chunksRange1 n (Pos skip) = unfoldr1NE (take1 n &&& N.drop skip)
+
+{- | creates a nonempty container of length "sz" with chunks of a given size: @see 'chunkNLen'
+ must fill the container exactly
+-}
+chunkNLen1 ::
+  forall a u.
+  Foldable u =>
+  Pos ->
+  Pos ->
+  u a ->
+  Either String (NonEmpty (NonEmpty a))
+chunkNLen1 sz = chunkNLen (units1 sz)
+
+{- | fills a container "tz" with chunks of size "len"
+ must fill the container exactly
+-}
+chunkNLen ::
+  forall t a u z.
+  (Traversable t, Foldable u) =>
+  t z ->
+  Pos ->
+  u a ->
+  Either String (t (NonEmpty a))
+chunkNLen tz len ua = do
+  chunkN' f tz (toList ua)
+ where
+  f :: [a] -> Either String ([a], NonEmpty a)
+  f = \case
+    [] -> Left "chunkNLen: not enough data"
+    x : xs -> swap <$> splitAt1GE len (x :| xs)
+
+{- | unfoldr for a nonempty list
+
+will not terminate if the user keeps returning a larger [s] than received
+-}
+unfoldr1NE ::
+  forall s a.
+  (NonEmpty s -> (a, [s])) ->
+  NonEmpty s ->
+  NonEmpty a
+unfoldr1NE f = go
+ where
+  go :: NonEmpty s -> NonEmpty a
+  go ns =
+    let (a, ys) = f ns
+     in (a :|) $ case ys of
+          [] -> []
+          x : xs -> N.toList (go (x :| xs))
+
+-- | 'replicate' for a nonempty list
+replicate1 :: Pos -> a -> NonEmpty a
+replicate1 (Pos n) a = a :| replicate (n - 1) a
+
+-- | 'replicateM' for a nonempty list
+replicate1M :: Applicative m => Pos -> m a -> m (NonEmpty a)
+replicate1M (Pos n) ma = (:|) <$> ma <*> replicateM (n - 1) ma
+
+-- | 'partitionThese' for a nonempty list
+partition1 ::
+  Foldable1 t =>
+  (a -> Bool) ->
+  t a ->
+  These (NonEmpty a) (NonEmpty a)
+partition1 p =
+  sconcat
+    . N.map (boolM p (This . pure) (That . pure))
+    . toNonEmpty
+
+-- | internal function used by 'span1'
+toThese1 ::
+  These (NonEmpty a) (NonEmpty b) ->
+  ([a], [b]) ->
+  These (NonEmpty a) (NonEmpty b)
+toThese1 th ns =
+  th & case ns of
+    ([], []) -> id
+    (a : as, []) -> (<> This (a :| as))
+    ([], b : bs) -> (<> That (b :| bs))
+    (a : as, b : bs) -> (<> These (a :| as) (b :| bs))
+
+-- | 'span' for a nonempty list
+span1 ::
+  Foldable1 t =>
+  (a -> Bool) ->
+  t a ->
+  These (NonEmpty a) (NonEmpty a)
+span1 p (toNonEmpty -> (a :| as)) =
+  toThese1
+    ( boolM
+        p
+        (That . pure)
+        (This . pure)
+        a
+    )
+    (L.span p as)
+
+-- | 'break' for a nonempty list
+break1 ::
+  Foldable1 t =>
+  (a -> Bool) ->
+  t a ->
+  These (NonEmpty a) (NonEmpty a)
+break1 p = span1 (not . p)
+
+-- | 'sum' for a nonempty list
+sum1 :: (Foldable1 t, Num a) => t a -> a
+sum1 = L.foldl' (+) 0
+
+-- | predicate for an ascending nonempty list
+isSequence1 :: (Foldable1 t, Eq a, Enum a) => t a -> Bool
+isSequence1 = (EQ ==) . seq1Ordering . isEnumAscending
+
+-- | possible results for determining if a nonempty list is in ascending order
+data Seq1 a
+  = -- | generated enumerable sequence is shorter than the original list
+    S1Short !(NonEmpty a)
+  | -- | first mismatch
+    S1Fail !(a, a)
+  | -- | both sequences match
+    S1Ok
+  deriving stock (Show, Eq, Ord, Functor)
+
+-- | predicate for 'S1Short'
+seq1Ordering :: Seq1 a -> Ordering
+seq1Ordering = \case
+  S1Short{} -> LT
+  S1Ok{} -> EQ
+  S1Fail{} -> GT
+
+-- | shows the first failure or if the length of the enum is too short
+isEnumAscending :: forall t a. (Foldable1 t, Eq a, Enum a) => t a -> Seq1 a
+isEnumAscending (toNonEmpty -> as@(a :| _)) =
+  let (cs, me) = zipWithExtras1 f (a :| drop 1 [a ..]) as
+   in case me of
+        MLRLeft _ -> either S1Fail (const S1Ok) $ sequenceA cs
+        MLREqual -> either S1Fail (const S1Ok) $ sequenceA cs
+        MLRRight zs -> S1Short zs
+ where
+  f :: a -> a -> Either (a, a) ()
+  f x y = if x == y then Right () else Left (x, y)
+
+-- | snoc for a nonempty list
+snoc1 :: Foldable t => t a -> a -> NonEmpty a
+snoc1 as a = foldr (N.<|) (pure a) as
+
+-- | unsnoc for a nonempty list
+unsnoc1 :: forall a. NonEmpty a -> ([a], a)
+unsnoc1 = uncurry go . uncons1
+ where
+  go :: a -> [a] -> ([a], a)
+  go n [] = ([], n)
+  go n (x : xs) = first (n :) (go x xs)
+
+-- | uncons for a nonempty list
+uncons1 :: forall a. NonEmpty a -> (a, [a])
+uncons1 (z :| zs) = (z, zs)
+
+-- | cons iso from 'NonEmpty'
+consNonEmpty :: Iso (NonEmpty a) (NonEmpty b) (a, [a]) (b, [b])
+consNonEmpty = iso uncons1 (uncurry (:|))
+
+-- | snoc iso from 'NonEmpty'
+snocNonEmpty :: Iso (NonEmpty a) (NonEmpty b) ([a], a) ([b], b)
+snocNonEmpty = iso unsnoc1 (uncurry snoc1)
+
+-- | 'N.groupBy1' but applies the predicate to adjacent elements
+groupByAdjacent1 :: forall a. (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a)
+groupByAdjacent1 p (a0 :| as0) =
+  let (as, ass) = go a0 as0
+   in (a0 :| as) :| ass
+ where
+  go :: a -> [a] -> ([a], [NonEmpty a])
+  go a' = \case
+    [] -> ([], [])
+    a : as ->
+      let (ys, zs) = go a as
+       in if p a' a
+            then (a : ys, zs)
+            else ([], (a :| ys) : zs)
+
+-- | partition duplicates elements together with their positiion
+findDupsBy :: forall a c. Ord c => (a -> c) -> [a] -> ([NonEmpty (Int, a)], [(Int, a)])
+findDupsBy f =
+  partitionEithers
+    . map g
+    . N.groupAllWith (f . snd)
+    . zip [0 ..]
+ where
+  g :: NonEmpty (Int, a) -> Either (NonEmpty (Int, a)) (Int, a)
+  g = \case
+    x :| [] -> Right x
+    x :| y : ys -> Left (x :| y : ys)
+
+-- | "foldMapM" for nonempty containers: uses Semigroup instead of Monoid
+foldMapM1 ::
+  forall b m f a.
+  (Semigroup b, Monad m, Foldable1 f) =>
+  (a -> m b) ->
+  f a ->
+  m b
+foldMapM1 f (toNonEmpty -> n :| ns) = foldr step return ns =<< f n
+ where
+  step :: a -> (b -> m b) -> b -> m b
+  step x r z = f x >>= \y -> r $! z <> y
+
+-- | 'Primus.Fold.unfoldM' for nonempty results
+unfoldrM1 :: Monad m => (s -> m (a, Maybe s)) -> s -> m (NonEmpty a)
+unfoldrM1 f s = do
+  (a, ms) <- f s
+  case ms of
+    Nothing -> return (a :| [])
+    Just s' -> (a N.<|) <$> unfoldrM1 f s'
+
+-- | 'take' for a nonempty list
+take1 :: Pos -> NonEmpty a -> NonEmpty a
+take1 (Pos i) (a :| as) = a :| take (i - 1) as
+
+-- | 'splitAt' for a nonempty list but doesnt guarantee the number of elements
+splitAt1 :: Pos -> NonEmpty a -> (NonEmpty a, [a])
+splitAt1 (Pos i) (a :| as) = first (a :|) (splitAt (i - 1) as)
+
+-- | comparator for 'Split1'
+split1Ordering :: Split1 a -> Ordering
+split1Ordering = \case
+  SplitLT{} -> LT
+  SplitEQ{} -> EQ
+  SplitGT{} -> GT
+
+-- | represents the status of a split a nonempty list
+data Split1 a
+  = SplitLT !Pos
+  | SplitEQ
+  | SplitGT !(NonEmpty a)
+  deriving stock (Ord, Show, Eq)
+
+-- | split a nonempty list preserving information about the split
+splitAt1' :: forall a. Pos -> NonEmpty a -> (NonEmpty a, Split1 a)
+splitAt1' = go _1P
+ where
+  go :: Pos -> Pos -> NonEmpty a -> (NonEmpty a, Split1 a)
+  go !i !n (a :| [])
+    | i == n = (a :| [], SplitEQ)
+    | otherwise = (a :| [], SplitLT i)
+  go !i !n (a :| a1 : as)
+    | i == n = (a :| [], SplitGT (a1 :| as))
+    | otherwise =
+        let (ys, y) = go (succP i) n (a1 :| as)
+         in (a N.<| ys, y)
+
+-- | split a nonempty list but has to have enough elements else fails
+splitAt1GE :: Pos -> NonEmpty a -> Either String (NonEmpty a, [a])
+splitAt1GE n as =
+  let (ns, z) = splitAt1' n as
+   in (ns,) <$> case z of
+        SplitLT (Pos len) -> Left $ "not enough elements: expected " ++ show (unP n) ++ " found " ++ show len
+        SplitEQ -> pure mempty
+        SplitGT ex -> pure (N.toList ex)
+
+-- | repeatedly split a nonempty list
+splitAts1 :: Pos -> NonEmpty a -> NonEmpty (NonEmpty a)
+splitAts1 i = unfoldr1NE (splitAt1 i) . toNonEmpty
+
+-- | compares the length of a potentially infinite nonempty list with "n" and succeeds if they are the same
+lengthExact1 :: Pos -> NonEmpty a -> Either String (NonEmpty a)
+lengthExact1 n xs =
+  let (as, z) = splitAt1' n xs
+   in case z of
+        SplitLT (Pos len) -> Left $ "LT: not enough elements: expected " ++ show (unP n) ++ " found " ++ show len
+        SplitEQ -> Right as
+        SplitGT _ -> Left $ "GT: too many elements: expected " ++ show (unP n)
+
+-- | break up a nonempty list into all possible pairs of nonempty lists
+splits1 :: forall a. NonEmpty a -> [(NonEmpty a, NonEmpty a)]
+splits1 (n :| ns) = go ([n], ns)
+ where
+  go :: ([a], [a]) -> [(NonEmpty a, NonEmpty a)]
+  go = \case
+    ([], _) -> []
+    (_, []) -> []
+    (a : as, b : bs) -> (a :| as, b :| bs) : go (a : as ++ [b], bs)
+
+-- | like 'Data.List.iterate' but allows termination using Maybe
+iterateMaybe1' :: (a -> Maybe a) -> a -> NonEmpty a
+iterateMaybe1' f a0 = a0 :| go a0
+ where
+  go a = case f a of
+    Nothing -> []
+    Just x -> x : go x
+
+-- | like 'iterateMaybe1'' with 'boolMaybe'
+iterateMaybe1 :: (a -> Bool) -> (a -> a) -> a -> NonEmpty a
+iterateMaybe1 f g = iterateMaybe1' (boolMaybe f g)
+
+-- | iterate "n" times
+iterateN1 :: Pos -> (a -> a) -> a -> NonEmpty a
+iterateN1 n = take1 n .@ N.iterate
+
+-- | break up a nonempty list into a nonempty list of three parts
+splits3 :: forall a. NonEmpty a -> NonEmpty ([a], a, [a])
+splits3 (n :| ns) = N.scanl f ([], n, ns) ns
+ where
+  f :: forall z. ([a], a, [a]) -> z -> ([a], a, [a])
+  f (xs, y, zs') _ = case zs' of
+    [] -> programmError "splits3"
+    z : zs -> (xs ++ [y], z, zs)
+
+-- | like 'Data.List.span' but applies the predicate to adjacent elements
+spanAdjacent1 :: (a -> a -> Bool) -> NonEmpty a -> (NonEmpty a, [a])
+spanAdjacent1 p (a0 :| as0) = first (a0 :|) (go a0 as0)
+ where
+  go a' = \case
+    [] -> ([], [])
+    a : as
+      | p a' a -> first (a :) (go a as)
+      | otherwise -> ([], a : as)
+
+-- | like 'Data.List.break' but applies the predicate to adjacent elements
+breakAdjacent1 :: (a -> a -> Bool) -> NonEmpty a -> (NonEmpty a, [a])
+breakAdjacent1 p = spanAdjacent1 (not .@ p)
+
+-- | append a list with a nonempty list
+appendL1 :: [a] -> NonEmpty a -> NonEmpty a
+appendL1 as bs = foldr N.cons bs as
+
+-- | append a nonempty list with a list
+appendR1 :: NonEmpty a -> [a] -> NonEmpty a
+appendR1 (a :| as) bs = a :| (as <> bs)
+
+-- | set a value at an index starting at one
+setAt1 :: Pos -> a -> NonEmpty a -> Maybe (NonEmpty a)
+setAt1 i = updateAt1 i . const
+
+-- | update a value at an index starting at one
+updateAt1 :: Pos -> (a -> a) -> NonEmpty a -> Maybe (NonEmpty a)
+updateAt1 (Pos i) f ns =
+  case N.splitAt (i - 1) ns of
+    ([], b : bs) -> Just (f b :| bs)
+    (a : as, b : bs) -> Just (a :| as ++ (f b : bs))
+    (_, []) -> Nothing
+
+-- | get a value at an index starting at one
+at1 :: Pos -> NonEmpty a -> Maybe a
+at1 (Pos i) ns =
+  case N.splitAt (i - 1) ns of
+    (_, b : _) -> Just b
+    (_, []) -> Nothing
+
+-- | generate a repeated nonempty list of values for a fixed size
+replicateP :: Pos -> a -> NonEmpty a
+replicateP (Pos i) a = a :| replicate (i - 1) a
+
+-- | length of nonempty list
+lengthP :: Foldable1 t => t a -> Pos
+lengthP = unsafePos "lengthP" . N.length . toNonEmpty
+{-# INLINE lengthP #-}
+
+-- | generate a nonempty list of units for a fixed size
+units1 :: Pos -> NonEmpty ()
+units1 = unitsF
+
+-- | generate a nonempty list of units for a given container of the given size
+unitsF :: forall l a. (GE.IsList (l a), GE.Item (l a) ~ ()) => Pos -> l a
+unitsF = GE.fromList . flip replicate () . unP
+
+-- | sum of nonempty list of 'Pos' values
+sumP :: Foldable1 t => t Pos -> Pos
+sumP = L.foldr1 (+!)
+{-# INLINE sumP #-}
+
diff --git a/src/Primus/Num1.hs b/src/Primus/Num1.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/Num1.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+
+{- |
+Module      : Primus.Num1
+Description : similar to 'Num' class but with failure handling
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.Num1 (
+  Num1 (..),
+  withOp,
+  withOp2,
+  withOp3,
+  withOp4,
+) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Int
+import Data.Kind
+import Data.Pos
+import Data.Word
+import GHC.Natural
+import Primus.Enum
+import Primus.Error
+import Primus.Extra
+
+-- | run a function of one integer against the underlying 'Num1' type
+withOp :: Num1 a => (Integer -> Integer) -> a -> Either String a
+withOp f a = fromInteger1 a (f (toInteger1 a))
+
+-- | run a function of two integers against the underlying 'Num1' types
+withOp2 :: Num1 a => (Integer -> Integer -> Integer) -> a -> a -> Either String a
+withOp2 f a b = fromInteger1 a (f (toInteger1 a) (toInteger1 b))
+
+-- | run a function of three integers against the underlying 'Num1' types
+withOp3 :: Num1 a => (Integer -> Integer -> Integer -> Integer) -> a -> a -> a -> Either String a
+withOp3 f a b c =
+  fromInteger1 a (f (toInteger1 a) (toInteger1 b) (toInteger1 c))
+
+-- | run a function of four integers against the underlying 'Num1' types
+withOp4 :: Num1 a => (Integer -> Integer -> Integer -> Integer -> Integer) -> a -> a -> a -> a -> Either String a
+withOp4 f a b c d =
+  fromInteger1 a (f (toInteger1 a) (toInteger1 b) (toInteger1 c) (toInteger1 d))
+
+{- | lifted version of Num class for handling failure
+ minimal definition requires 'toInteger1' and 'fromInteger1' unless leveraging default signatures
+-}
+type Num1 :: Type -> Constraint
+class Num1 a where
+  -- | required method for converting from "a" to an 'Integer'
+  toInteger1 :: a -> Integer
+  default toInteger1 :: Enum a => a -> Integer
+  toInteger1 = toInteger . fromEnum @a
+
+  -- | required method for trying to convert from an 'Integer' to "a"
+  fromInteger1 :: a -> Integer -> Either String a
+  default fromInteger1 :: (Bounded a, Enum a) => a -> Integer -> Either String a
+  fromInteger1 = const integerToEnumSafe
+
+  (.+)
+    , (.-)
+    , (.*) ::
+      Either String a ->
+      Either String a ->
+      Either String a
+  (.+) = join .@ liftA2 (lmsg "(.+)" .@ withOp2 (+))
+  (.-) = join .@ liftA2 (lmsg "(.-)" .@ withOp2 (-))
+  (.*) = join .@ liftA2 (lmsg "(.*)" .@ withOp2 (*))
+  negate1
+    , abs1
+    , signum1
+    , succ1
+    , pred1 ::
+      Either String a ->
+      Either String a
+  negate1 = (=<<) (lmsg "negate1" . withOp negate)
+  signum1 = (=<<) (lmsg "signum1" . withOp signum)
+  abs1 = (=<<) (lmsg "abs1" . withOp abs)
+  succ1 = (=<<) (lmsg "succ1" . withOp succ)
+  pred1 = (=<<) (lmsg "pred1" . withOp pred)
+
+infixl 7 .*
+infixl 6 .+
+infixl 6 .-
+
+instance Num1 Natural where
+  fromInteger1 _ i
+    | i < 0 = Left $ "Natural: undefined for negative numbers " ++ show i
+    | otherwise = Right $ naturalFromInteger i
+
+instance Num1 Pos
+
+instance Num1 Word8
+instance Num1 Word16
+instance Num1 Word32
+instance Num1 Word64
+
+instance Num1 Int
+
+instance Num1 Int8
+instance Num1 Int16
+instance Num1 Int32
+instance Num1 Int64
diff --git a/src/Primus/One.hs b/src/Primus/One.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/One.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+{- |
+Module      : Primus.One
+Description : holds a singleton value
+Copyright   : (c) Grant Weyburne, 2016
+License     : BSD-3
+
+handles a tuple of size one. this is a special type that distinguishes a singleton value from a ntuple
+will be replaced by Solo when ghc 9.2 is standard and generics-sop is updated to support Solo
+-}
+module Primus.One (
+  One (..),
+  unOne,
+) where
+
+import Control.DeepSeq
+import Data.Coerce
+import Data.Data
+import qualified Data.Functor.Apply as Apply
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import GHC.Generics (Generic, Generic1)
+
+-- | unwrap 'One'
+unOne :: One a -> a
+unOne = coerce
+
+-- | One holds a single value. To use wprint we need a SOP Generics instance
+newtype One a = One a
+  deriving stock (Data, Generic, Generic1, Show, Eq, Ord, Traversable, Read, Functor, Foldable)
+  deriving newtype (Semigroup, Monoid, NFData)
+  deriving anyclass (NFData1, Foldable1)
+
+instance Applicative One where
+  pure = coerce
+  (<*>) = coerce
+instance Apply.Apply One where
+  (<.>) = coerce
+instance Monad One where
+  return = pure
+  One a >>= amb = amb a
+instance Traversable1 One where
+  traverse1 afb = fmap One . afb . unOne
diff --git a/src/Primus/Rep.hs b/src/Primus/Rep.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/Rep.hs
@@ -0,0 +1,118 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{- |
+Module      : Primus.Rep
+Description : representable methods for use with fixed containers
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.Rep (
+  buildRepL,
+  buildRepR,
+  fillRep,
+  toEnumRep,
+  izipWithR,
+  izipWithRF,
+  ipostscanr,
+  ipostscanl,
+  unfoldlRep,
+  unfoldrRep,
+) where
+
+import Data.Bool
+import Data.Distributive
+import Data.Foldable
+import Data.Functor.Rep
+import qualified Data.List as L
+import qualified Data.List.NonEmpty as N
+import Primus.Enum
+import Primus.Error
+import Primus.Extra
+import Primus.Fold
+
+-- | builds a representable from the left using past and future inputs
+buildRepL ::
+  forall f a b.
+  (Traversable f, Representable f) =>
+  ([Rep f] -> [Rep f] -> b -> Rep f -> (b, a)) ->
+  b ->
+  (b, f a)
+buildRepL f b0 = histMapL f b0 (tabulate id)
+
+-- | same as 'buildRepL' but associates to the right
+buildRepR ::
+  forall f a b.
+  (Traversable f, Representable f) =>
+  ([Rep f] -> [Rep f] -> b -> Rep f -> (b, a)) ->
+  b ->
+  (b, f a)
+buildRepR f b0 = histMapR f b0 (tabulate id)
+
+-- | fill a representable container with a foldable
+fillRep ::
+  forall f a.
+  (Representable f, Traversable f) =>
+  [a] ->
+  Either String ([a], f a)
+fillRep = fillTraversable (tabulate id)
+
+-- | load a fixed container with "a"s using the relative position "i"
+toEnumRep ::
+  forall f a.
+  (Traversable f, Representable f, Enum a, Bounded a) =>
+  Integer ->
+  Either String (f a)
+toEnumRep = toEnumTraversable (tabulate id)
+
+-- | 'Data.List.zipWith' with rep index
+izipWithR ::
+  Representable f =>
+  (Rep f -> a -> b -> c) ->
+  f a ->
+  f b ->
+  f c
+izipWithR f as bs = tabulate $ \k -> f k (index as k) (index bs k)
+
+-- | 'Control.Monad.zipWithM' with rep index
+izipWithRF ::
+  (Representable f, Distributive g) =>
+  (Rep f -> a -> b -> g c) ->
+  f a ->
+  f b ->
+  g (f c)
+izipWithRF f = collect id .@ izipWithR f
+
+{- | like 'Data.List.scanr'
+ passes in the 'Rep' index and removes the first element
+-}
+ipostscanr :: (Representable f, Traversable f) => (Rep f -> a -> b -> b) -> b -> f a -> f b
+ipostscanr f c ta =
+  frp $ fillTraversableExact ta $ N.init $ N.scanr (uncurry f) c xs
+ where
+  xs = toList $ imapRep (,) ta
+
+{- | like 'Data.List.scanl'
+ passes in the 'Rep' index and removes the last element
+-}
+ipostscanl :: (Representable f, Traversable f) => (Rep f -> b -> a -> b) -> b -> f a -> f b
+ipostscanl f c ta =
+  frp $ fillTraversableExact ta $ N.tail $ N.scanl g c xs
+ where
+  xs = imapRep (,) ta
+  g b (i, a) = f i b a
+
+-- | left/right unfold from the right into a Representable
+unfoldlRep
+  , unfoldrRep ::
+    (Representable f, Traversable f) =>
+    (Rep f -> s -> (s, a)) ->
+    s ->
+    (s, f a)
+unfoldlRep = unfoldRepImpl False
+unfoldrRep = unfoldRepImpl True
+
+unfoldRepImpl :: (Representable f, Traversable f) => Bool -> (Rep f -> s -> (s, a)) -> s -> (s, f a)
+unfoldRepImpl isright f s = bool L.mapAccumL L.mapAccumR isright (flip f) s (tabulate id)
diff --git a/src/Primus/TypeLevel.hs b/src/Primus/TypeLevel.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/TypeLevel.hs
@@ -0,0 +1,279 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{- |
+Module      : Primus.TypeLevel
+Description : commonly used type families
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.TypeLevel (
+  pnat,
+  FailUnless,
+  Fst,
+  Snd,
+  Fsts,
+  Snds,
+  Length,
+  Len1T,
+  NotEqTC,
+  Cons1T,
+  Snoc1T,
+  Snoc1LT,
+  SnocT,
+  InitT,
+  Init1T,
+  Last1T,
+  Head1T,
+  App1T,
+  ApplyConstraints1,
+  ApplyConstraint,
+  ApplyConstraints,
+  UnconsT,
+  UnsnocT,
+  FirstConsT,
+  ToITupleT,
+  FromITupleT,
+  ITupleC (..),
+  type (++),
+  type (:=>),
+) where
+
+import Data.Kind
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.Proxy
+import GHC.TypeLits
+import qualified GHC.TypeLits as GL
+import qualified GHC.TypeNats as GN
+import Primus.One
+
+-- | fail with error message if "b" is 'False
+type FailUnless :: Bool -> ErrorMessage -> Constraint
+type family FailUnless b err where
+  FailUnless 'False err = TypeError ( 'Text "FailUnless: " ':<>: err)
+  FailUnless 'True _ = ()
+
+-- | extract an int from a 'Nat'
+pnat :: forall n. KnownNat n => Int
+pnat = fromEnum (GN.natVal (Proxy @n))
+
+-- | type level boolean implication
+type (:=>) :: Bool -> Bool -> Bool
+type family x :=> y where
+  'False :=> _ = 'True
+  'True :=> x = x
+  _ :=> 'False = 'True
+  _ :=> 'True = 'True
+  x :=> x = 'True
+
+-- | "fst" at the typelevel
+type Fst :: forall a b. (a, b) -> a
+type family Fst tp where
+  Fst '(a, _) = a
+
+-- | "snd" at the typelevel
+type Snd :: forall a b. (a, b) -> b
+type family Snd tp where
+  Snd '(_, b) = b
+
+-- | "map fst" at the typelevel
+type Fsts :: forall a b. [(a, b)] -> [a]
+type family Fsts rs where
+  Fsts '[] = '[]
+  Fsts ('(a, _) ': rs) = a ': Fsts rs
+
+-- | "map snd" at the typelevel
+type Snds :: forall a b. [(a, b)] -> [b]
+type family Snds rs where
+  Snds '[] = '[]
+  Snds ('(_, b) ': rs) = b ': Snds rs
+
+-- | 'length' at the typelevel
+type Length :: forall k. [k] -> Nat
+type family Length rs where
+  Length '[] = 0
+  Length (_ ': '[]) = 1
+  Length (_ ': _ ': '[]) = 2
+  Length (_ ': _ ': _ ': '[]) = 3
+  Length (_ ': _ ': _ ': _ ': '[]) = 4
+  Length (_ ': _ ': _ ': _ ': _ ': rs) = 5 + Length rs
+
+-- | get the length of a type level nonempty list
+type Len1T :: forall k. NonEmpty k -> k
+type family Len1T ns where
+  Len1T (_ ':| ns) = 1 GN.+ Length ns
+
+-- | ensure that two types are not equal
+type NotEqTC :: forall k k1. k -> k1 -> Constraint
+type family NotEqTC a b where
+  NotEqTC a a = TypeError ( 'Text "NotEqTC: found equal")
+  NotEqTC _ _ = ()
+
+-- sometimes you can avoid using Cons1T: check first (expand/inline at the callsite)
+
+-- | cons a type to a nonempty list at the type level
+type Cons1T :: forall k. k -> NonEmpty k -> NonEmpty k
+type family Cons1T a ys = result | result -> a ys where
+  Cons1T a (b ':| bs) = a ':| b ': bs
+
+-- | snoc a nonempty list type to a type
+type Snoc1T :: forall k. NonEmpty k -> k -> NonEmpty k
+type family Snoc1T as b where
+  Snoc1T (a ':| as) b = a ':| SnocT as b
+
+-- | snoc a type list to a type
+type SnocT :: forall k. [k] -> k -> [k]
+type family SnocT as b where
+  SnocT '[] b = '[b]
+  SnocT (a ': as) b = a ': SnocT as b
+
+-- | snoc a type list to a type
+type Snoc1LT :: forall k. [k] -> k -> NonEmpty k
+type family Snoc1LT as b where
+  Snoc1LT '[] b = b ':| '[]
+  Snoc1LT (a ': as) b = Cons1T a (Snoc1LT as b)
+
+-- | append two nonempty lists at the type level
+type App1T :: forall k. NonEmpty k -> NonEmpty k -> NonEmpty k
+type family App1T x y where
+  App1T (a ':| '[]) y = Cons1T a y
+  App1T (a ':| a1 ': as) y = Cons1T a (App1T (a1 ':| as) y)
+
+-- | create a constraint from a type and list of constraints taking a type
+type ApplyConstraints1 :: forall k. [k -> Constraint] -> k -> Constraint
+type family ApplyConstraints1 xs x where
+  ApplyConstraints1 '[] _ = ()
+  ApplyConstraints1 (c ': cs) x = (c x, ApplyConstraints1 cs x)
+
+-- | create a constraint from a list of types and a constraint that take a type
+type ApplyConstraint :: (k -> Constraint) -> [k] -> Constraint
+type family ApplyConstraint c xs where
+  ApplyConstraint _ '[] = ()
+  ApplyConstraint c (x ': xs) = (c x, ApplyConstraint c xs)
+
+-- | create a constraint from a list of types and list of constraints that take a type
+type ApplyConstraints :: [k -> Constraint] -> [k] -> Constraint
+type family ApplyConstraints cs xs where
+  ApplyConstraints '[] _ = ()
+  ApplyConstraints (c ': cs) xs = (ApplyConstraint c xs, ApplyConstraints cs xs)
+
+-- | uncons a type level nonempty list
+type UnconsT :: forall k. NonEmpty k -> (k, [k])
+type family UnconsT ns = result | result -> ns where
+  UnconsT (a ':| as) = '(a, as)
+
+-- | unsnoc a type level nonempty list
+type UnsnocT :: forall k. NonEmpty k -> ([k], k)
+type family UnsnocT ns where
+  UnsnocT (a ':| '[]) = '( '[], a)
+  UnsnocT (a ':| a1 ': as) = FirstConsT a (UnsnocT (a1 ':| as))
+
+-- | cons a type to the first element in a tuple
+type FirstConsT :: forall k k1. k -> ([k], k1) -> ([k], k1)
+type family FirstConsT a b = result | result -> a b where
+  FirstConsT a '(as, c) = '(a ': as, c)
+
+-- putStrLn $ genITupleAll _10P
+
+-- | convert a flat tuple type to an inductive tuple
+type ToITupleT :: Type -> Type
+type family ToITupleT x = result | result -> x where
+  ToITupleT (One a1) = (a1, ())
+  ToITupleT (a1, a2) = (a1, (a2, ()))
+  ToITupleT (a1, a2, a3) = (a1, (a2, (a3, ())))
+  ToITupleT (a1, a2, a3, a4) = (a1, (a2, (a3, (a4, ()))))
+  ToITupleT (a1, a2, a3, a4, a5) = (a1, (a2, (a3, (a4, (a5, ())))))
+  ToITupleT (a1, a2, a3, a4, a5, a6) = (a1, (a2, (a3, (a4, (a5, (a6, ()))))))
+  ToITupleT (a1, a2, a3, a4, a5, a6, a7) = (a1, (a2, (a3, (a4, (a5, (a6, (a7, ())))))))
+  ToITupleT (a1, a2, a3, a4, a5, a6, a7, a8) = (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, ()))))))))
+  ToITupleT (a1, a2, a3, a4, a5, a6, a7, a8, a9) = (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, ())))))))))
+  ToITupleT (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, (a10, ()))))))))))
+
+-- | convert an inductive tuple to a flat tuple type
+type FromITupleT :: Type -> Type
+type family FromITupleT x = result | result -> x where
+  FromITupleT (a1, ()) = One a1
+  FromITupleT (a1, (a2, ())) = (a1, a2)
+  FromITupleT (a1, (a2, (a3, ()))) = (a1, a2, a3)
+  FromITupleT (a1, (a2, (a3, (a4, ())))) = (a1, a2, a3, a4)
+  FromITupleT (a1, (a2, (a3, (a4, (a5, ()))))) = (a1, a2, a3, a4, a5)
+  FromITupleT (a1, (a2, (a3, (a4, (a5, (a6, ())))))) = (a1, a2, a3, a4, a5, a6)
+  FromITupleT (a1, (a2, (a3, (a4, (a5, (a6, (a7, ()))))))) = (a1, a2, a3, a4, a5, a6, a7)
+  FromITupleT (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, ())))))))) = (a1, a2, a3, a4, a5, a6, a7, a8)
+  FromITupleT (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, ()))))))))) = (a1, a2, a3, a4, a5, a6, a7, a8, a9)
+  FromITupleT (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, (a10, ())))))))))) = (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)
+
+-- | conversions to and from an inductive tuple and a flat tuple
+type ITupleC :: Type -> Constraint
+class ITupleC x where
+  toITupleC :: x -> ToITupleT x
+  fromITupleC :: ToITupleT x -> x
+
+instance ITupleC (One a1) where
+  toITupleC (One a1) = (a1, ())
+  fromITupleC (a1, ()) = One a1
+instance ITupleC (a1, a2) where
+  toITupleC (a1, a2) = (a1, (a2, ()))
+  fromITupleC (a1, (a2, ())) = (a1, a2)
+instance ITupleC (a1, a2, a3) where
+  toITupleC (a1, a2, a3) = (a1, (a2, (a3, ())))
+  fromITupleC (a1, (a2, (a3, ()))) = (a1, a2, a3)
+instance ITupleC (a1, a2, a3, a4) where
+  toITupleC (a1, a2, a3, a4) = (a1, (a2, (a3, (a4, ()))))
+  fromITupleC (a1, (a2, (a3, (a4, ())))) = (a1, a2, a3, a4)
+instance ITupleC (a1, a2, a3, a4, a5) where
+  toITupleC (a1, a2, a3, a4, a5) = (a1, (a2, (a3, (a4, (a5, ())))))
+  fromITupleC (a1, (a2, (a3, (a4, (a5, ()))))) = (a1, a2, a3, a4, a5)
+instance ITupleC (a1, a2, a3, a4, a5, a6) where
+  toITupleC (a1, a2, a3, a4, a5, a6) = (a1, (a2, (a3, (a4, (a5, (a6, ()))))))
+  fromITupleC (a1, (a2, (a3, (a4, (a5, (a6, ())))))) = (a1, a2, a3, a4, a5, a6)
+instance ITupleC (a1, a2, a3, a4, a5, a6, a7) where
+  toITupleC (a1, a2, a3, a4, a5, a6, a7) = (a1, (a2, (a3, (a4, (a5, (a6, (a7, ())))))))
+  fromITupleC (a1, (a2, (a3, (a4, (a5, (a6, (a7, ()))))))) = (a1, a2, a3, a4, a5, a6, a7)
+instance ITupleC (a1, a2, a3, a4, a5, a6, a7, a8) where
+  toITupleC (a1, a2, a3, a4, a5, a6, a7, a8) = (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, ()))))))))
+  fromITupleC (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, ())))))))) = (a1, a2, a3, a4, a5, a6, a7, a8)
+instance ITupleC (a1, a2, a3, a4, a5, a6, a7, a8, a9) where
+  toITupleC (a1, a2, a3, a4, a5, a6, a7, a8, a9) = (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, ())))))))))
+  fromITupleC (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, ()))))))))) = (a1, a2, a3, a4, a5, a6, a7, a8, a9)
+instance ITupleC (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) where
+  toITupleC (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, (a10, ()))))))))))
+  fromITupleC (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, (a10, ())))))))))) = (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)
+
+-- | append two type level lists
+type (++) :: forall a. [a] -> [a] -> [a]
+type family (++) xs ys where
+  '[] ++ ys = ys
+  (x ': xs) ++ ys = x ': xs ++ ys
+
+infixr 5 ++
+
+-- | get the init of a list
+type InitT :: forall a. [a] -> [a]
+type family InitT xs where
+  InitT '[] = GL.TypeError ( 'GL.Text "InitT: undefined for 1d")
+  InitT (_ ': '[]) = '[]
+  InitT (n ': m ': ns) = n ': InitT (m ': ns)
+
+-- | get the init of a nonempty list
+type Init1T :: forall a. NonEmpty a -> NonEmpty a
+type family Init1T ns where
+  Init1T (n ':| ns) = n ':| InitT ns
+
+-- | peel off the bottom-most index in the matrix
+type Last1T :: forall k. NonEmpty k -> k
+type family Last1T ns where
+  Last1T (a ':| '[]) = a
+  Last1T (_ ':| (a1 : as)) = Last1T (a1 ':| as)
+
+-- | get the head of a nonempty list
+type Head1T :: forall k. NonEmpty k -> k
+type family Head1T ns where
+  Head1T (a ':| _) = a
diff --git a/src/Primus/ZipNonEmpty.hs b/src/Primus/ZipNonEmpty.hs
new file mode 100644
--- /dev/null
+++ b/src/Primus/ZipNonEmpty.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{- |
+Module      : Primus.ZipNonEmpty
+Description : 'Control.Applicative.ZipList' version for 'NonEmpty'
+Copyright   : (c) Grant Weyburne, 2022
+License     : BSD-3
+-}
+module Primus.ZipNonEmpty (
+  ZipNonEmpty (..),
+  _Zip1,
+  unZipNonEmpty,
+) where
+
+import Control.Applicative
+import Control.DeepSeq
+import Data.Coerce
+import Data.Data
+import qualified Data.Functor.Apply as Apply
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as N
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import qualified GHC.Exts as GE (IsList (..))
+import GHC.Generics (Generic, Generic1)
+import Primus.Error (normalError)
+import Primus.Lens
+
+-- | unwrap 'ZipNonEmpty'
+unZipNonEmpty :: ZipNonEmpty a -> NonEmpty a
+unZipNonEmpty = coerce
+
+-- | zippable version of 'NonEmpty'
+newtype ZipNonEmpty a = ZipNonEmpty (NonEmpty a)
+  deriving stock (Data, Generic, Generic1, Show, Eq, Ord, Traversable, Read)
+  deriving (NFData) via (NonEmpty a)
+  deriving (NFData1, Foldable, Foldable1, Functor) via NonEmpty
+
+-- checkers hangs
+instance Monoid a => Monoid (ZipNonEmpty a) where
+  mempty = pure mempty
+
+instance Semigroup a => Semigroup (ZipNonEmpty a) where
+  (<>) = liftA2 (<>)
+
+instance Applicative ZipNonEmpty where
+  pure = ZipNonEmpty . N.repeat
+  liftA2 f (ZipNonEmpty xs) (ZipNonEmpty ys) = ZipNonEmpty (N.zipWith f xs ys)
+
+instance Apply.Apply ZipNonEmpty where
+  (<.>) = (<*>)
+
+instance Traversable1 ZipNonEmpty where
+  traverse1 afb = fmap ZipNonEmpty . traverse1 afb . unZipNonEmpty
+
+instance GE.IsList (ZipNonEmpty a) where
+  type Item (ZipNonEmpty a) = a
+  fromList =
+    \case
+      [] -> normalError "IsList: fromList: need at least one element"
+      x : xs -> ZipNonEmpty (x :| xs)
+  toList = N.toList . coerce
+
+-- | iso for the zipnonempty constructor
+_Zip1 :: Iso (ZipNonEmpty a) (ZipNonEmpty b) (NonEmpty a) (NonEmpty b)
+_Zip1 = iso coerce coerce
+
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,41 @@
+module Main where
+
+import System.Environment
+import Test.Tasty
+import qualified TestAsMaybe
+import qualified TestBool
+import qualified TestEnum
+import qualified TestExtra
+import qualified TestFold
+import qualified TestLRHist
+import qualified TestList
+import qualified TestNonEmpty
+import qualified TestNum1
+import qualified TestZipNonEmpty
+
+main :: IO ()
+main = do
+  xs <- getArgs
+  let x1 = [TestLRHist.suiteCheckers, TestZipNonEmpty.suiteCheckers]
+  (os, zs) <- case xs of
+    "0" : os -> putStrLn "NORMAL (Explicit)" >> return (os, mempty)
+    "1" : os -> putStrLn "VERBOSE" >> return (os, x1)
+    "2" : os -> putStrLn "EXTRA VERBOSE" >> return (os, x1)
+    os -> putStrLn "NORMAL" >> return (os, [])
+  withArgs os $
+    defaultMain $
+      testGroup
+        "alltests"
+        ( [ TestAsMaybe.suite
+          , TestBool.suite
+          , TestEnum.suite
+          , TestExtra.suite
+          , TestFold.suite
+          , TestList.suite
+          , TestLRHist.suite
+          , TestNonEmpty.suite
+          , TestNum1.suite
+--          , TestZipNonEmpty.suite
+          ]
+            ++ zs
+        )
diff --git a/test/TestAsMaybe.hs b/test/TestAsMaybe.hs
new file mode 100644
--- /dev/null
+++ b/test/TestAsMaybe.hs
@@ -0,0 +1,392 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module TestAsMaybe where
+
+import Control.Arrow
+import Data.Char
+import qualified Data.List as L
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.Semigroup as SG
+import Data.These
+import Primus.AsMaybe
+import Primus.Bool
+import Primus.Enum
+import Test.Tasty
+import Test.Tasty.HUnit
+
+suite :: TestTree
+suite =
+  testGroup
+    "TestAsMaybe"
+    [ testCase "iterateT1" $
+        iterateT1 (\i -> if i > 0 then Just (i - 1) else Nothing) (5 :: Int)
+          @?= (5 :| [4, 3, 2, 1, 0])
+    , testCase "iterateT1 simpler" $
+        iterateT1 (boolMaybe (> 0) pred) (5 :: Int)
+          @?= (5 :| [4, 3, 2, 1, 0])
+    , testCase "iterateT1" $
+        iterateT1 succSafe LT
+          @?= (LT :| [EQ, GT])
+    , testCase "iterateT1" $
+        iterateT1 succSafe GT
+          @?= (GT :| [])
+    , testCase "iterateT1" $
+        iterateT1 predSafe GT
+          @?= (GT :| [EQ, LT])
+    , testCase "iterateT1" $
+        iterateT1 (\x -> if length x > 5 then Left @String "asdf" else Right (length x : x)) [0 :: Int]
+          @?= ([0] :| [[1, 0], [2, 1, 0], [3, 2, 1, 0], [4, 3, 2, 1, 0], [5, 4, 3, 2, 1, 0]])
+    , testCase "iterateT1 simpler" $
+        iterateT1 (boolEither ((<= 5) . length) (const @String "asdf") (\x -> length x : x)) [0 :: Int]
+          @?= ([0] :| [[1, 0], [2, 1, 0], [3, 2, 1, 0], [4, 3, 2, 1, 0], [5, 4, 3, 2, 1, 0]])
+    , testCase "iterateT1" $
+        iterateT1 (\x -> if length x > 5 then Nothing else Just (length x : x)) [0 :: Int]
+          @?= ([0] :| [[1, 0], [2, 1, 0], [3, 2, 1, 0], [4, 3, 2, 1, 0], [5, 4, 3, 2, 1, 0]])
+    , testCase "iterateT1" $
+        iterateT1 (\x -> if length x > 5 then [] else length x : x) [0 :: Int]
+          @?= ([0] :| [[1, 0], [2, 1, 0], [3, 2, 1, 0], [4, 3, 2, 1, 0], [5, 4, 3, 2, 1, 0]])
+    , testCase "iterateT1" $
+        iterateT1 (\(x, y) -> (if length x > 5 then [] else length x : x, Just y)) ([0 :: Int], 1 :: Int)
+          @?= (([0], 1) :| [([1, 0], 1), ([2, 1, 0], 1), ([3, 2, 1, 0], 1), ([4, 3, 2, 1, 0], 1), ([5, 4, 3, 2, 1, 0], 1)])
+    , testCase "takeWhileTS" $
+        takeWhileTS (\b a -> (b + 1, Just (b, a))) (100 :: Int) "abcdef"
+          @?= (106, [(100, 'a'), (101, 'b'), (102, 'c'), (103, 'd'), (104, 'e'), (105, 'f')])
+    , testCase "takeWhileT" $
+        takeWhileT (\a -> if a > 'f' then Nothing else Just (a, ord a)) ['a' .. 'm']
+          @?= [('a', 97), ('b', 98), ('c', 99), ('d', 100), ('e', 101), ('f', 102)]
+    , testCase "takeWhileT simpler" $
+        takeWhileT (boolMaybe (<= 'f') (id &&& ord)) ['a' .. 'm']
+          @?= [('a', 97), ('b', 98), ('c', 99), ('d', 100), ('e', 101), ('f', 102)]
+    , testCase "filterT" $
+        filterT (\a -> if even a then Nothing else Just (show a)) [1 :: Int .. 10]
+          @?= ["1", "3", "5", "7", "9"]
+    , testCase "filterT simpler" $
+        filterT (boolMaybe odd show) [1 :: Int .. 10]
+          @?= ["1", "3", "5", "7", "9"]
+    , testCase "filterT" $
+        filterT (\a -> replicate (7 - a) 'x') [1 :: Int .. 10]
+          @?= ["xxxxxx", "xxxxx", "xxxx", "xxx", "xx", "x"]
+    , testCase "takeWhileT" $
+        takeWhileT (\a -> if even a then Nothing else Just (a, a + 1)) [1 :: Int .. 10]
+          @?= [(1, 2)]
+    , testCase "takeWhileT" $
+        takeWhileT (\a -> if a == 5 then Nothing else Just (show a)) [1 :: Int .. 10]
+          @?= ["1", "2", "3", "4"]
+    , testCase "takeWhileT" $
+        takeWhileT (\a -> replicate (7 - a) 'x') [1 :: Int .. 10]
+          @?= ["xxxxxx", "xxxxx", "xxxx", "xxx", "xx", "x"]
+    , testCase "partitionEithersT" $
+        partitionEithersT (\a -> if odd a then Just (show a) else Nothing) [1 .. 10 :: Int]
+          @?= ([2, 4, 6, 8, 10], ["1", "3", "5", "7", "9"])
+    , testCase "partitionEithersT" $
+        partitionEithersT (\a -> if odd a then Right (show a) else Left a) [1 .. 10 :: Int]
+          @?= ([2, 4, 6, 8, 10], ["1", "3", "5", "7", "9"])
+    , testCase "partitionEithersT" $
+        partitionEithersT (\a -> replicate (7 - a) 'x') [1 .. 10 :: Int]
+          @?= ([7, 8, 9, 10], ["xxxxxx", "xxxxx", "xxxx", "xxx", "xx", "x"])
+    , testCase "toTheseT warped" $
+        toTheseT
+          ( \a ->
+              let w = chr (a + 50)
+               in if even a
+                    then That w
+                    else
+                      if a > 4
+                        then These ("These=" ++ show a) w
+                        else This ("This=" ++ show a)
+          )
+          [1 .. 10 :: Int]
+          @?= [ This "This=1"
+              , That '4'
+              , This "This=3"
+              , That '6'
+              , These "These=5" '7'
+              , That '8'
+              , These "These=7" '9'
+              , That ':'
+              , These "These=9" ';'
+              , That '<'
+              ]
+    , testCase "toTheseT ok" $
+        toTheseT
+          ( \a ->
+              let w = chr (a + 50)
+               in if even a
+                    then if a > 4 then These ("These=" ++ show a) w else That w
+                    else This ("This=" ++ show a)
+          )
+          [1 .. 10 :: Int]
+          @?= [This "This=1", That '4', This "This=3", That '6', This "This=5", These "These=6" '8', This "This=7", These "These=8" ':', This "This=9", These "These=10" '<']
+    , testCase "toTheseT boolThese simpler" $ -- not the same as the above as "That" should not be opposite of "These"!!
+        toTheseT (boolThese even (> 4) (chr . (+ 50)) show) [1 .. 10]
+          @?= [This '3', That "2", This '5', That "4", This '7', These '8' "6", This '9', These ':' "8", This ';', These '<' "10"]
+    , testCase "unfoldrT" $
+        unfoldrT (splitAt 2) [1 :: Int .. 8]
+          @?= [[1, 2], [3, 4], [5, 6], [7, 8]]
+    , testCase "unfoldrT" $
+        unfoldrT (splitAt 2) [1 :: Int .. 7]
+          @?= [[1, 2], [3, 4], [5, 6], [7]]
+    , testCase "unfoldrT" $
+        unfoldrT (splitAt 2) [1 :: Int]
+          @?= [[1]]
+    , testCase "unfoldrT" $
+        unfoldrT (splitAt 2) ([] :: [Int])
+          @?= []
+    , testCase "unfoldrT" $
+        unfoldrT (first sum . splitAt 3) [1 :: Int .. 10]
+          @?= [6, 15, 24, 10]
+    , testCase "iterateT1" $
+        iterateT1 succSafe LT
+          @?= (LT :| [EQ, GT])
+    , testCase "iterateT1" $
+        iterateT1 succSafe GT
+          @?= (GT :| [])
+    , testCase "iterateT1" $
+        iterateT1 predSafe GT
+          @?= (GT :| [EQ, LT])
+    , testCase "spanT" $
+        spanT (\x -> SG.Arg (if x > 3 then "" else "xx" :: String) (x, x * 1000)) [1 .. 5 :: Int]
+          @?= (
+              [ SG.Arg "xx" (1, 1000)
+              , SG.Arg "xx" (2, 2000)
+              , SG.Arg "xx" (3, 3000)
+              ]
+              , [4, 5]
+              )
+    , testCase "takeWhileT" $
+        takeWhileT (\x -> SG.Arg (if x > 3 then "" else "xx" :: String) (x, x * 1000)) [1 .. 5 :: Int]
+          @?= [ SG.Arg "xx" (1, 1000)
+              , SG.Arg "xx" (2, 2000)
+              , SG.Arg "xx" (3, 3000)
+              ]
+    , testCase "takeWhileT" $
+        takeWhileT (\x -> SG.Arg (if x > 3 then Nothing else Just @String "xx") (x, x * 1000)) [1 .. 5 :: Int]
+          @?= [ SG.Arg "xx" (1, 1000)
+              , SG.Arg "xx" (2, 2000)
+              , SG.Arg "xx" (3, 3000)
+              ]
+    , testCase "spanT" $
+        spanT (\i -> if i < 4 then These "thesedata" (show i) else if i < 8 then That (show i) else This @String "thosedata") [1 :: Int .. 10]
+          @?= (["1", "2", "3", "4", "5", "6", "7"], [1, 2, 3, 8, 9, 10])
+    , testCase "partitionEithersT" $
+        partitionEithersT (\a -> if even a then Left @String "1" else Right (a, True)) [1 :: Int .. 4]
+          @?= (
+              [ "1"
+              , "1"
+              ]
+              ,
+              [
+                ( 1
+                , True
+                )
+              ,
+                ( 3
+                , True
+                )
+              ]
+              )
+    , testCase "partitionEithersT" $
+        partitionEithersT even [1 :: Int .. 5]
+          @?= (
+              [ 1
+              , 3
+              , 5
+              ]
+              ,
+              [ 2
+              , 4
+              ]
+              )
+    , testCase "L.span" $
+        L.span even [2 :: Int, 4, 6, 8, 9, 11, 13]
+          @?= (
+              [ 2
+              , 4
+              , 6
+              , 8
+              ]
+              ,
+              [ 9
+              , 11
+              , 13
+              ]
+              )
+    , testCase "spanT" $
+        spanT (\a -> if even a then Just (chr (a + 50)) else Nothing) [2 :: Int, 4, 6, 8, 9, 11, 13]
+          @?= ( "468:"
+              ,
+              [ 9
+              , 11
+              , 13
+              ]
+              )
+    , testCase "spanT simpler" $
+        spanT (boolMaybe even (chr . (+ 50))) [2 :: Int, 4, 6, 8, 9, 11, 13]
+          @?= ( "468:"
+              ,
+              [ 9
+              , 11
+              , 13
+              ]
+              )
+    , testCase "apThese" $ apThese 'x' (Just @Int 1) @?= That 1
+    , testCase "apThese" $ apThese 'x' True @?= That 'x'
+    , testCase "apThese" $ apThese 'x' False @?= This 'x'
+    , testCase "apThese" $ apThese 'x' (Nothing @Double) @?= This 'x'
+    , testCase "partitionEithersT" $
+        partitionEithersT (\a -> if even a then Right (chr (a + 50)) else Left (show a ++ "oops")) [1 .. 10]
+          @?= (["1oops", "3oops", "5oops", "7oops", "9oops"], "468:<")
+    , testCase "toTheseTS" $
+        toTheseTS (\z a -> (z + 1, if even a then Right (z, a) else Left (a, z, "oops" :: String))) (100 :: Integer) [2, 4, 6, 7, 8, 9 :: Int]
+          @?= ( 106
+              ,
+              [ That
+                  ( 100
+                  , 2
+                  )
+              , That
+                  ( 101
+                  , 4
+                  )
+              , That
+                  ( 102
+                  , 6
+                  )
+              , This
+                  ( 7
+                  , 103
+                  , "oops"
+                  )
+              , That
+                  ( 104
+                  , 8
+                  )
+              , This
+                  ( 9
+                  , 105
+                  , "oops"
+                  )
+              ]
+              )
+    , testCase "partitionEithersT" $
+        partitionEithersT (\a -> if even a then Right (chr (50 + a)) else Left (a, "oops" :: String)) [2, 4, 6, 7, 8, 9 :: Int]
+          @?= (
+              [
+                ( 7
+                , "oops"
+                )
+              ,
+                ( 9
+                , "oops"
+                )
+              ]
+              , "468:"
+              )
+    , testCase "spanTS" $
+        spanTS (\z a -> (z + 1, if even a then Right (z, chr (50 + a)) else Left (z, a, "oops" :: String))) (100 :: Int) [2, 4, 6, 7, 8, 9 :: Int]
+          @?= ( 104
+              ,
+              (
+              [
+                ( 100
+                , '4'
+                )
+              ,
+                ( 101
+                , '6'
+                )
+              ,
+                ( 102
+                , '8'
+                )
+              ]
+              ,
+              [ 7
+              , 8
+              , 9
+              ]
+              )
+              )
+    , testCase "L.span" $ L.span even [2, 4, 6, 5, 3, 1, 2, 3 :: Int] @?= ([2, 4, 6], [5, 3, 1, 2, 3])
+    , testCase "toMaybe" $ toMaybe (Left @String @Int "asdf", Nothing @()) @?= Nothing
+    , testCase "toMaybe" $ toMaybe (Right @Double @String "asdf", "" :: String) @?= Nothing
+    , testCase "toMaybe" $ toMaybe (Right @() @Int 11, "abc" :: String) @?= Just (11, "abc")
+    , testCase "toMaybe" $ toMaybe (Right @() @Int 11) @?= Just 11
+    , testCase "toMaybe" $ toMaybe (Just 'x') @?= Just 'x'
+    , testCase "toMaybe" $ toMaybe (Nothing @Char) @?= Nothing
+    , testCase "toMaybe" $ toMaybe (SG.Arg @String @Int "" 2) @?= Nothing
+    , testCase "toMaybe" $ toMaybe (SG.Arg @String @Int "xyz" 2) @?= Just (SG.Arg "xyz" 2)
+    , testCase "toMaybe" $ toMaybe (SG.Arg (This @Int @Bool 123) 'x') @?= Nothing
+    , testCase "toMaybe" $ toMaybe (SG.Arg (That @Double @Int 123) 'x') @?= Just (SG.Arg 123 'x')
+    , testCase "partitionTheseT" $
+        partitionTheseT (boolThese even (>= 5) show (chr . (65 +))) [1 :: Int .. 10]
+          @?= (
+              [ "1"
+              , "3"
+              , "5"
+              , "7"
+              , "9"
+              ]
+              , "CE"
+              ,
+              [
+                ( "6"
+                , 'G'
+                )
+              ,
+                ( "8"
+                , 'I'
+                )
+              ,
+                ( "10"
+                , 'K'
+                )
+              ]
+              )
+    , testCase "toTheseT" $
+        toTheseT even [1 :: Int .. 10]
+          @?= [This 1, That 2, This 3, That 4, This 5, That 6, This 7, That 8, This 9, That 10]
+    , testCase "toTheseT'" $
+        toTheseT (\a -> if even a then Just (a, show a) else Nothing) [1 :: Int .. 10]
+          @?= [This 1, That (2, "2"), This 3, That (4, "4"), This 5, That (6, "6"), This 7, That (8, "8"), This 9, That (10, "10")]
+    , testCase "unfoldrT" $
+        unfoldrT (\(a, b) -> let (x, y) = splitAt 1 a; (z, w) = splitAt 2 b in ((x, z), (y, w))) ("abc" :: String, [1 :: Int .. 10])
+          @?= [
+                ( "a"
+                ,
+                [ 1
+                , 2
+                ]
+                )
+              ,
+                ( "b"
+                ,
+                [ 3
+                , 4
+                ]
+                )
+              ,
+                ( "c"
+                ,
+                [ 5
+                , 6
+                ]
+                )
+              ]
+    , testCase "unfoldrT" $
+        unfoldrT (pairsT (splitAt 1) (splitAt 2)) ("asdf", [1 :: Int .. 6])
+          @?= [("a", [1, 2]), ("s", [3, 4]), ("d", [5, 6])]
+    , testCase "spanT" $
+        spanT Just [2 :: Int, 4, 6, 1, 3, 5, 2, 3]
+          @?= ([2, 4, 6, 1, 3, 5, 2, 3], [])
+    , testCase "spanT" $
+        spanT (boolThese even (> 4) show (chr . (+ 65))) [2 :: Int, 4, 6, 1, 3, 5, 2, 3]
+          @?= ("CEG", [6, 1, 3, 5, 2, 3])
+    , testCase "spanT" $
+        spanT (boolThese even (< 10) id show) [2, 4 .. 20 :: Int]
+          @?= (["2", "4", "6", "8", "10", "12", "14", "16", "18", "20"], [2, 4, 6, 8])
+    ]
diff --git a/test/TestBool.hs b/test/TestBool.hs
new file mode 100644
--- /dev/null
+++ b/test/TestBool.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+
+module TestBool where
+
+import Data.Char
+import Data.These
+import Primus.Bool
+import Test.Tasty
+import Test.Tasty.HUnit
+
+doit :: IO ()
+doit = defaultMain suite
+
+suite :: TestTree
+suite =
+  testGroup
+    "TestBool"
+    [ testCase "boolThese" $
+        map (boolThese even (> 5) show (chr . (+ 66))) [1 :: Int .. 10]
+          @?= [ This "1"
+              , That 'D'
+              , This "3"
+              , That 'F'
+              , This "5"
+              , These "6" 'H'
+              , This "7"
+              , These "8" 'J'
+              , This "9"
+              , These "10" 'L'
+              ]
+    , testCase "boolThese'" $
+        map (boolThese' even (> 5) show (chr . (+ 66)) (\_ a -> ("both(" ++ show a ++ ")", chr (a + 50)))) [1 :: Int .. 10]
+          @?= [ This "1"
+              , That 'D'
+              , This "3"
+              , That 'F'
+              , This "5"
+              , These "both(6)" '8'
+              , This "7"
+              , These "both(8)" ':'
+              , This "9"
+              , These "both(10)" '<'
+              ]
+    , testCase "boolEither" $
+        map (boolEither even show (chr . (+ 66))) [1 :: Int .. 10]
+          @?= [ Left "1"
+              , Right 'D'
+              , Left "3"
+              , Right 'F'
+              , Left "5"
+              , Right 'H'
+              , Left "7"
+              , Right 'J'
+              , Left "9"
+              , Right 'L'
+              ]
+    , testCase "boolM" $
+        boolM even ("odd",) ("even",) (3 :: Int) @?= ("odd" :: String, 3)
+    , testCase "boolM" $
+        boolM even ("odd",) ("even",) (4 :: Int) @?= ("even" :: String, 4)
+    , testCase "boolThese" $
+        traverse (boolThese (const True) (< 5) show id) [1 :: Int .. 10]
+          @?= These "1234" [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
+    , testCase "boolThese" $
+        traverse (boolThese (< 5) (const True) show id) [1 :: Int .. 10]
+          @?= This "12345"
+    , testCase "boolEither" $
+        traverse (boolEither (< 5) show id) [1 :: Int .. 10]
+          @?= Left "5"
+    , testCase "boolEither" $
+        traverse (boolEither (const True) show id) [1 :: Int .. 10]
+          @?= Right [1 .. 10]
+    , testCase "boolMaybe" $
+        traverse (boolMaybe (const True) (chr . (+ 64))) [1 :: Int .. 10]
+          @?= Just ['A' .. 'J']
+    , testCase "boolThese" $
+        map (boolThese even (> 5) show (chr . (+ 65))) [1 :: Int .. 10]
+          @?= [This "1", That 'C', This "3", That 'E', This "5", These "6" 'G', This "7", These "8" 'I', This "9", These "10" 'K']
+    ]
diff --git a/test/TestEnum.hs b/test/TestEnum.hs
new file mode 100644
--- /dev/null
+++ b/test/TestEnum.hs
@@ -0,0 +1,387 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module TestEnum where
+
+import Control.Arrow
+import Control.Monad
+import Data.Int
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as N
+import Data.Pos
+import Primus.AsMaybe
+import Primus.Enum
+import Primus.NonEmpty
+import Test.Tasty
+import Test.Tasty.HUnit
+
+suite :: TestTree
+suite =
+  testGroup
+    "TestEnum"
+    [ testCase "enumFrom1" $ take1 _5P (enumFrom1 _5P) @?= (_5P :| [_6P, _7P, _8P, _9P])
+    , testCase "enumFrom1R" $ enumFrom1R _5P @?= (_5P :| [_4P, _3P, _2P, _1P])
+    , testCase "enumFrom1R" $ enumFrom1R _1P @?= (_1P :| [])
+    , testCase "enumTo1" $ enumTo1 _5P @?= (_1P :| [_2P, _3P, _4P, _5P])
+    , testCase "enumTo1" $ enumTo1 _1P @?= (_1P :| [])
+    , testCase "enumTo1" $ enumTo1 EQ @?= (LT :| [EQ])
+    , testCase "enumTo1" $ enumTo1 LT @?= (LT :| [])
+    , testCase "enumTo1" $ enumTo1 GT @?= (LT :| [EQ, GT])
+    , testCase "enumFromThen1" $ take1 _5P (enumFromThen1 _5P _11P) @?= (_5P :| [_11P, _17P, _P @23, _P @29])
+    , testCase "enumFromThen1" $ enumFromThen1 _15P _10P @?= (_15P :| [_10P, _5P])
+    , testCase "enumFromThen1" $ enumFromThen1 _5P _5P @?= (_5P :| [])
+    , testCase "enumFromThen1" $ enumFromThen1 LT LT @?= (LT :| [])
+    , testCase "enumFromThen1" $ enumFromThen1 LT GT @?= (LT :| [GT])
+    , testCase "enumFromThen1" $ enumFromThen1 GT LT @?= (GT :| [LT])
+    , testCase "enumFromThen1" $ enumFromThen1 GT EQ @?= (GT :| [EQ, LT])
+    , testCase "enumFromTo1" $ enumFromTo1 _5P _9P @?= (_5P :| [_6P, _7P, _8P, _9P])
+    , testCase "enumFromTo1" $ enumFromTo1 _9P _5P @?= (_9P :| [_8P, _7P, _6P, _5P])
+    , testCase "enumFromTo1" $ enumFromTo1 _5P _5P @?= (_5P :| [])
+    , testCase "enumFromTo1" $ enumFromTo1 LT LT @?= (LT :| [])
+    , testCase "enumFromTo1" $ enumFromTo1 LT GT @?= (LT :| [EQ, GT])
+    , testCase "enumFromTo1" $ enumFromTo1 GT LT @?= (GT :| [EQ, LT])
+    , testCase "enumFromTo1" $ enumFromTo1 GT EQ @?= (GT :| [EQ])
+    , testCase "universe1" $ universe1 @?= (LT :| [EQ, GT])
+    , testCase "universe1R" $ universe1R @?= (GT :| [EQ, LT])
+    , testCase "universe1R" $ universe1R @?= (GT :| [EQ, LT])
+    , testCase "enumTo1" $ enumTo1 _4P @?= (_1P :| [_2P, _3P, _4P])
+    , testCase "enumFrom1" $ enumFrom1 EQ @?= (EQ :| [GT])
+    , testCase "enumFrom1" $ enumFrom1 GT @?= (GT :| [])
+    , testCase "enumFrom1R" $ enumFrom1R LT @?= (LT :| [])
+    , testCase "enumFrom1R" $ enumFrom1R EQ @?= (EQ :| [LT])
+    , testCase "enumFrom1R" $ enumFrom1R GT @?= (GT :| [EQ, LT])
+    , testCase "toEnumTraversable" $ toEnumTraversable @Ordering (Just ()) 0 @?= Right (Just LT)
+    , testCase "toEnumTraversable" $ toEnumTraversable @Ordering (Just ()) 2 @?= Right (Just GT)
+    , testCase "toEnumTraversable" $ toEnumTraversable @Ordering (Just ()) 10 @?= Left "cap=(0,2):padL: negative fill: would need to truncate the data"
+    , testCase "toEnumTraversable" $ toEnumTraversable @Ordering (replicate 5 ()) 242 @?= Right [GT, GT, GT, GT, GT]
+    , testCase "toEnumTraversable" $ toEnumTraversable @Ordering (replicate 5 ()) 243 @?= Left "cap=(0,242):padL: negative fill: would need to truncate the data"
+    , testCase "toEnumTraversable" $ toEnumTraversable @Ordering (replicate 5 ()) 0 @?= Right [LT, LT, LT, LT, LT]
+    , testCase "toEnumTraversable" $ toEnumTraversable @Ordering (replicate 5 ()) (-1) @?= Left "calcNextEnum:not defined for negative numbers"
+    , testCase "toEnumTraversable" $ toEnumTraversable @Ordering (replicate 5 ()) (-123) @?= Left "calcNextEnum:not defined for negative numbers"
+    , testCase "toEnumList" $ toEnumList @Ordering 14 @?= Right [EQ, EQ, GT]
+    , testCase "toEnumList" $ toEnumList1 @Ordering 0 @?= Right (LT :| [])
+    , testCase "toEnumList" $ toEnumList1 @() 0 @?= Right (() :| [])
+    , testCase "enumlist" $ traverse (fromEnumFoldable <=< toEnumList @PosNeg) [-5 .. 5] @?= Right [-5 .. 5]
+    , testCase "enumlist" $ map (toEnumList @PosOnly) [-5 .. -1] @?= replicate 5 (Left "calcNextEnum:not defined for negative numbers")
+    , testCase "enumlist" $ toEnumList @PosOnly 0 @?= Left "zerolr: not defined at zero"
+    , testCase "enumlist" $ toEnumList @PosOnly 1 @?= Right [AA1]
+    , testCase "enumlist" $ toEnumList @PosOnly 2 @?= Right [BB1]
+    , testCase "enumlist" $ toEnumList @PosOnly 3 @?= Right [CC1]
+    , testCase "enumlist" $ left (const ()) (toEnumList @PosOnly 4) @?= Left ()
+    , testCase "enumlist" $ toEnumList @PosOnly 5 @?= Right [AA1, AA1]
+    , testCase "enumlist" $ toEnumList @PosOnly 6 @?= Right [AA1, BB1]
+    , testCase "enumlist" $ toEnumList @PosOnly 7 @?= Right [AA1, CC1]
+    , testCase "enumlist" $ left (const ()) (toEnumList @PosOnly 8) @?= Left ()
+    , testCase "enumlist" $ toEnumList @PosOnly2 0 @?= Left "zerolr: not defined at zero"
+    , testCase "enumlist" $ left (const ()) (toEnumList @PosOnly2 1) @?= Left ()
+    , testCase "enumlist" $ toEnumList @PosOnly2 2 @?= Right [AA5]
+    , testCase "enumlist" $ toEnumList @PosOnly2 123 @?= Right [CC5, CC5, BB5]
+    , testCase "enumlist" $ map (toEnumList @NegOnly) [1 .. 5] @?= replicate 5 (Left "calcNextEnum:not defined for positive numbers")
+    , testCase "enumlist" $ toEnumList @NegOnly 0 @?= Left "zerolr: not defined at zero"
+    , testCase "enumlist" $ toEnumList @NegOnly (-1) @?= Right [CC4]
+    , testCase "enumlist" $ toEnumList @NegOnly (-2) @?= Right [BB4]
+    , testCase "enumlist" $ toEnumList @NegOnly (-3) @?= Right [AA4]
+    , testCase "enumlist" $ left (const ()) (toEnumList @NegOnly (-4)) @?= Left ()
+    , testCase "enumlist" $ toEnumList @NegOnly (-5) @?= Right [CC4, CC4]
+    , testCase "enumlist" $ toEnumList @NegOnly (-6) @?= Right [CC4, BB4]
+    , testCase "enumlist" $ toEnumList @NegOnly (-7) @?= Right [CC4, AA4]
+    , testCase "enumlist" $ left (const ()) (toEnumList @NegOnly (-8)) @?= Left ()
+    , testCase "enumlist" $ map (toEnumList @PosNat) [-5 .. -1] @?= replicate 5 (Left "calcNextEnum:not defined for negative numbers")
+    , testCase "enumlist" $ toEnumList @PosNat 0 @?= Right []
+    , testCase "enumlist" $ toEnumList @PosNat 1 @?= Right [BB2]
+    , testCase "enumlist" $ toEnumList @PosNat 2 @?= Right [CC2]
+    , testCase "enumlist" $ toEnumList @PosNat 3 @?= Right [DD2]
+    , testCase "enumlist" $ toEnumList @PosNat 4 @?= Right [BB2, AA2]
+    , testCase "enumlist" $ toEnumList @PosNat 5 @?= Right [BB2, BB2]
+    , testCase "enumlist" $ map (toEnumList @NegNat) [1 .. 5] @?= replicate 5 (Left "calcNextEnum:not defined for positive numbers")
+    , testCase "enumlist" $ toEnumList @NegNat 0 @?= Right []
+    , testCase "enumlist" $ toEnumList @NegNat (-1) @?= Right [CC3]
+    , testCase "enumlist" $ toEnumList @NegNat (-2) @?= Right [BB3]
+    , testCase "enumlist" $ toEnumList @NegNat (-3) @?= Right [AA3]
+    , testCase "enumlist" $ toEnumList @NegNat (-4) @?= Right [CC3, DD3]
+    , testCase "enumlist" $ toEnumList @NegNat (-5) @?= Right [CC3, CC3]
+    , testCase "enumlist" $ toEnumList @NegNat (-6) @?= Right [CC3, BB3]
+    , testCase "enumlist" $ toEnumList @NegNat (-7) @?= Right [CC3, AA3]
+    , testCase "enumlist" $ toEnumList @NegNat (-8) @?= Right [BB3, DD3]
+    , testCase "enumlist" $ toEnumList 100 @?= Right [True, True, False, False, True, False, False]
+    , testCase "enumlist1" $ toEnumList1 100 @?= Right (True :| [True, False, False, True, False, False])
+    , testCase "fromenum" $ fromEnumFoldable @PosOnly [] @?= Left "zerolr: not defined at zero"
+    , testCase "fromenum" $ fromEnumFoldable @NegNat [] @?= Right 0
+    , testCase "fromenum" $ fromEnumFoldable @PosNat [] @?= Right 0
+    , testCase "fromenum" $ fromEnumFoldable @PosNeg [] @?= Right 0
+    , testCase "universe1" $ universe1 @Ordering @?= (LT :| [EQ, GT])
+    , testCase "toEnumList" $ toEnumList @Ordering 0 @?= Right []
+    , testCase "toEnumList" $ toEnumList @Ordering 1 @?= Right [EQ]
+    , testCase "toEnumList" $ toEnumList @Ordering 2 @?= Right [GT]
+    , testCase "toEnumList" $ toEnumList @Ordering 3 @?= Right [EQ, LT]
+    , testCase "toEnumList" $ toEnumList @Ordering 10 @?= Right [EQ, LT, EQ]
+    , testCase "toEnumList" $ toEnumList @Ordering 200 @?= Right [GT, EQ, EQ, LT, GT]
+    , testCase "toEnumList1" $ toEnumList1 @Ordering 200 @?= Right (GT :| [EQ, EQ, LT, GT])
+    , testCase "toEnumList1" $ toEnumList1 @Ordering 0 @?= Right (LT :| [])
+    , testCase "toEnumList1" $ toEnumList1 @Ordering 1 @?= Right (EQ :| [])
+    , testCase "toEnumList1" $ toEnumList1 @Ordering 100 @?= Right (EQ :| [LT, GT, LT, EQ])
+    , testCase "toEnumList1" $ toEnumList1 @Ordering 27 @?= Right (EQ :| [LT, LT, LT])
+    , testCase "succ pred traversable" $ iterateT1 succTraversable [LT, LT, LT] @?= N.reverse (iterateT1 predTraversable [GT, GT, GT])
+    , testCase "succ traversable" $
+        iterateT1 succTraversable [LT, LT, LT]
+          @?= ( [LT, LT, LT]
+                  :| [ [LT, LT, EQ]
+                     , [LT, LT, GT]
+                     , [LT, EQ, LT]
+                     , [LT, EQ, EQ]
+                     , [LT, EQ, GT]
+                     , [LT, GT, LT]
+                     , [LT, GT, EQ]
+                     , [LT, GT, GT]
+                     , [EQ, LT, LT]
+                     , [EQ, LT, EQ]
+                     , [EQ, LT, GT]
+                     , [EQ, EQ, LT]
+                     , [EQ, EQ, EQ]
+                     , [EQ, EQ, GT]
+                     , [EQ, GT, LT]
+                     , [EQ, GT, EQ]
+                     , [EQ, GT, GT]
+                     , [GT, LT, LT]
+                     , [GT, LT, EQ]
+                     , [GT, LT, GT]
+                     , [GT, EQ, LT]
+                     , [GT, EQ, EQ]
+                     , [GT, EQ, GT]
+                     , [GT, GT, LT]
+                     , [GT, GT, EQ]
+                     , [GT, GT, GT]
+                     ]
+              )
+    , testCase "predSafe" $
+        predSafe LT @?= Nothing
+    , testCase "predSafe" $
+        predSafe EQ @?= Just LT
+    , testCase "predSafe" $
+        predSafe GT @?= Just EQ
+    , testCase "predSafe" $
+        predSafe AA @?= Nothing
+    , testCase "predSafe" $
+        predSafe BB @?= Just AA
+    , testCase "predSafe" $
+        predSafe EE @?= Just DD
+    , testCase "succSafe" $
+        succSafe LT @?= Just EQ
+    , testCase "succSafe" $
+        succSafe EQ @?= Just GT
+    , testCase "succSafe" $
+        succSafe GT @?= Nothing
+    , testCase "succSafe" $
+        succSafe AA @?= Just BB
+    , testCase "succSafe" $
+        succSafe DD @?= Just EE
+    , testCase "succSafe" $
+        succSafe EE @?= Nothing
+    , testCase "enumFromThen1" $ enumFromThen1 AA AA @?= AA :| []
+    , testCase "enumFromThen1" $ enumFromThen1 BB AA @?= BB :| [AA]
+    , testCase "enumFromThen1" $ enumFromThen1 BB CC @?= BB :| [CC, DD, EE]
+    , testCase "enumFromThen1" $ enumFromThen1 EE CC @?= EE :| [CC, AA]
+    , testCase "enumFromTo1" $ enumFromTo1 AA AA @?= AA :| []
+    , testCase "enumFromTo1" $ enumFromTo1 BB AA @?= BB :| [AA]
+    , testCase "enumFromTo1" $ enumFromTo1 BB EE @?= BB :| [CC, DD, EE]
+    , testCase "enumFromTo1" $ enumFromTo1 BB CC @?= BB :| [CC]
+    , testCase "enumFromTo1" $ enumFromTo1 EE CC @?= EE :| [DD, CC]
+    , testCase "predSafe" $ predSafe _4P @?= Just _3P
+    , testCase "universe1" $ universe1 @?= (AA :| [BB, CC, DD, EE])
+    , testCase "universe1R" $ universe1R @?= (EE :| [DD, CC, BB, AA])
+    , testCase "universe1" $ universe1 @?= (AA3 :| [BB3, CC3, DD3])
+    , testCase "universe1R" $ universe1R @?= (DD3 :| [CC3, BB3, AA3])
+    , testCase "fromEnumFoldable" $
+        fromEnumFoldable (replicate 5 (maxBound @Int8))
+          @?= Right 34359738367
+    , testCase "fromEnumFoldable" $
+        fromEnumFoldable (replicate 5 (minBound @Int8))
+          @?= Right (-35723051648)
+    , testCase "capacity" $
+        capacity @Int8 (replicate 5 ())
+          @?= Right (-35723051648, 34359738367)
+    , testCase "capacity" $
+        capacity @NegOnly []
+          @?= Left "capacity: unsupported mx < 0: (-3,-1)"
+    , testCase "capacity" $
+        capacity @PosOnly ['x']
+          @?= Left "capacity: unsupported mn > 0: (1,3)"
+    , testCase "universeTraversable" $
+        universeTraversable [EQ]
+          @?= Right ([LT] :| [[EQ], [GT]])
+    , testCase "universeTraversable" $
+        universeTraversable [EQ, EQ]
+          @?= Right ([LT, LT] :| [[LT, EQ], [LT, GT], [EQ, LT], [EQ, EQ], [EQ, GT], [GT, LT], [GT, EQ], [GT, GT]])
+    , testCase "universeTraversable" $
+        universeTraversable [EQ, EQ, EQ]
+          @?= Right ([LT, LT, LT] :| [[LT, LT, EQ], [LT, LT, GT], [LT, EQ, LT], [LT, EQ, EQ], [LT, EQ, GT], [LT, GT, LT], [LT, GT, EQ], [LT, GT, GT], [EQ, LT, LT], [EQ, LT, EQ], [EQ, LT, GT], [EQ, EQ, LT], [EQ, EQ, EQ], [EQ, EQ, GT], [EQ, GT, LT], [EQ, GT, EQ], [EQ, GT, GT], [GT, LT, LT], [GT, LT, EQ], [GT, LT, GT], [GT, EQ, LT], [GT, EQ, EQ], [GT, EQ, GT], [GT, GT, LT], [GT, GT, EQ], [GT, GT, GT]])
+    , testCase "universeTraversable" $
+        universeTraversable [(), (), ()]
+          @?= Right ([(), (), ()] :| [])
+    , testCase "capacity" $
+        capacity @PosNeg (replicate 5 ())
+          @?= Right (-242, 242)
+    , testCase "capacity" $
+        capacity @PosNeg (replicate 3 ())
+          @?= Right (-26, 26)
+    , testCase "universeTraversable" $
+        universeTraversable [AA, BB, CC]
+          @?= Right ([AA, AA, AA] :| [[AA, AA, BB], [AA, AA, CC], [AA, BB, AA], [AA, BB, BB], [AA, BB, CC], [AA, CC, AA], [AA, CC, BB], [AA, CC, CC], [BB, AA, AA], [BB, AA, BB], [BB, AA, CC], [BB, BB, AA], [BB, BB, BB], [BB, BB, CC], [BB, CC, AA], [BB, CC, BB], [BB, CC, CC], [CC, AA, AA], [CC, AA, BB], [CC, AA, CC], [CC, BB, AA], [CC, BB, BB], [CC, BB, CC], [CC, CC, AA], [CC, CC, BB], [CC, CC, CC], [CC, CC, DD], [CC, CC, EE], [CC, DD, CC], [CC, DD, DD], [CC, DD, EE], [CC, EE, CC], [CC, EE, DD], [CC, EE, EE], [DD, CC, CC], [DD, CC, DD], [DD, CC, EE], [DD, DD, CC], [DD, DD, DD], [DD, DD, EE], [DD, EE, CC], [DD, EE, DD], [DD, EE, EE], [EE, CC, CC], [EE, CC, DD], [EE, CC, EE], [EE, DD, CC], [EE, DD, DD], [EE, DD, EE], [EE, EE, CC], [EE, EE, DD], [EE, EE, EE]])
+    , testCase "capacity" $
+        capacity @NegNat (replicate 3 ())
+          @?= Right (-63, 0)
+    , testCase "universeTraversable" $
+        universeTraversable [AA3, AA3, AA3]
+          @?= Right ([AA3, AA3, AA3] :| [[AA3, AA3, BB3], [AA3, AA3, CC3], [AA3, AA3, DD3], [AA3, BB3, AA3], [AA3, BB3, BB3], [AA3, BB3, CC3], [AA3, BB3, DD3], [AA3, CC3, AA3], [AA3, CC3, BB3], [AA3, CC3, CC3], [AA3, CC3, DD3], [AA3, DD3, AA3], [AA3, DD3, BB3], [AA3, DD3, CC3], [AA3, DD3, DD3], [BB3, AA3, AA3], [BB3, AA3, BB3], [BB3, AA3, CC3], [BB3, AA3, DD3], [BB3, BB3, AA3], [BB3, BB3, BB3], [BB3, BB3, CC3], [BB3, BB3, DD3], [BB3, CC3, AA3], [BB3, CC3, BB3], [BB3, CC3, CC3], [BB3, CC3, DD3], [BB3, DD3, AA3], [BB3, DD3, BB3], [BB3, DD3, CC3], [BB3, DD3, DD3], [CC3, AA3, AA3], [CC3, AA3, BB3], [CC3, AA3, CC3], [CC3, AA3, DD3], [CC3, BB3, AA3], [CC3, BB3, BB3], [CC3, BB3, CC3], [CC3, BB3, DD3], [CC3, CC3, AA3], [CC3, CC3, BB3], [CC3, CC3, CC3], [CC3, CC3, DD3], [CC3, DD3, AA3], [CC3, DD3, BB3], [CC3, DD3, CC3], [CC3, DD3, DD3], [DD3, AA3, AA3], [DD3, AA3, BB3], [DD3, AA3, CC3], [DD3, AA3, DD3], [DD3, BB3, AA3], [DD3, BB3, BB3], [DD3, BB3, CC3], [DD3, BB3, DD3], [DD3, CC3, AA3], [DD3, CC3, BB3], [DD3, CC3, CC3], [DD3, CC3, DD3], [DD3, DD3, AA3], [DD3, DD3, BB3], [DD3, DD3, CC3], [DD3, DD3, DD3]])
+    , testCase "fromEnumFoldable1 universeTraversable" $
+        let m = universeTraversable [AA3, AA3, AA3]
+            z = join $ (traverse . traverse) fromEnumFoldable m
+         in z @?= Right (-63 :| [-62 .. 0])
+    , testCase "fromEnumFoldable1 universeTraversable" $
+        let m = universeTraversable [AA, AA, AA]
+            z = join $ (traverse . traverse) fromEnumFoldable m
+         in z @?= Right (-26 :| [-25 .. 26])
+    , testCase "universeTraversable" $
+        universeTraversable ([] :: [Ordering])
+          @?= Right ([] :| [])
+    , testCase "capacity" $
+        capacity @Ordering []
+          @?= Right (0, 0)
+    , testCase "integerToEnumSafe" $
+        integerToEnumSafe @() 1
+          @?= Left "integerToEnumSafe:overflow where 1 not in range [0..0]"
+    , testCase "integerToEnumSafe" $
+        integerToEnumSafe @() 0
+          @?= Right ()
+    , testCase "integerToEnumSafe" $
+        integerToEnumSafe @PosNeg 3
+          @?= Left "integerToEnumSafe:overflow where 3 not in range [-2..2]"
+    , testCase "integerToEnumSafe" $
+        integerToEnumSafe @PosNeg (-3)
+          @?= Left "integerToEnumSafe:underflow where -3 not in range [-2..2]"
+    , testCase "integerToEnumSafe" $
+        integerToEnumSafe @PosNeg (-2)
+          @?= Right AA
+    , testCase "integerToIntSafe" $
+        integerToIntSafe (fromIntegral (minBound :: Int))
+          @?= Right (-9223372036854775808)
+    , testCase "integerToIntSafe" $
+        integerToIntSafe (-1 + fromIntegral (minBound :: Int))
+          @?= Left "integerToEnumSafe:underflow where -9223372036854775809 not in range [-9223372036854775808..9223372036854775807]"
+    , testCase "integerToIntSafe" $
+        integerToIntSafe (fromIntegral (maxBound :: Int))
+          @?= Right 9223372036854775807
+    , testCase "integerToIntSafe" $
+        integerToIntSafe (1 + fromIntegral (maxBound :: Int))
+          @?= Left "integerToEnumSafe:overflow where 9223372036854775808 not in range [-9223372036854775808..9223372036854775807]"
+    , testCase "universe1" $
+        universe1 @() @?= () :| []
+    , testCase "universe1R" $
+        universe1R @() @?= () :| []
+    , testCase "enumFrom1" $
+        enumFrom1 @() () @?= () :| []
+    , testCase "enumFrom1R" $
+        enumFrom1R @() () @?= () :| []
+    , testCase "enumFromTo1" $
+        enumFromTo1 @() () () @?= () :| []
+    , testCase "enumTo1" $
+        enumTo1 @() () @?= () :| []
+    , testCase "enumFromThen1" $
+        enumFromThen1 @() () () @?= () :| []
+    , testCase "enumFromThenTo1" $
+        enumFromThenTo1 @() () () () @?= () :| []
+    , testCase "enumFrom1" $
+        enumFrom1 @PosNeg DD @?= DD :| [EE]
+    , testCase "enumFrom1R" $
+        enumFrom1R @PosNeg DD @?= DD :| [CC, BB, AA]
+    , testCase "enumFromTo1" $
+        enumFromTo1 @PosNeg DD BB @?= DD :| [CC, BB]
+    , testCase "enumTo1" $
+        enumTo1 @PosNeg AA @?= AA :| []
+    , testCase "enumFromThen1" $
+        enumFromThen1 @PosNeg AA CC @?= AA :| [CC, EE]
+    , testCase "enumFromThenTo1" $
+        enumFromThenTo1 @PosNeg AA AA BB @?= AA :| []
+    , testCase "enumFromThenTo1" $
+        enumFromThenTo1 @PosNeg EE DD DD @?= EE :| [DD]
+    , testCase "enumFromThenTo1" $
+        enumFromThenTo1 @PosNeg EE DD BB @?= EE :| [DD, CC, BB]
+    ]
+
+data PosNeg = AA | BB | CC | DD | EE deriving stock (Bounded, Show, Eq)
+instance Enum PosNeg where
+  toEnum (-2) = AA
+  toEnum (-1) = BB
+  toEnum 0 = CC
+  toEnum 1 = DD
+  toEnum 2 = EE
+  toEnum _ = error "bad toEnum PosNeg"
+
+  fromEnum AA = -2
+  fromEnum BB = -1
+  fromEnum CC = 0
+  fromEnum DD = 1
+  fromEnum EE = 2
+
+data PosNat = AA2 | BB2 | CC2 | DD2 deriving stock (Bounded, Show, Eq)
+instance Enum PosNat where
+  toEnum 0 = AA2
+  toEnum 1 = BB2
+  toEnum 2 = CC2
+  toEnum 3 = DD2
+  toEnum _ = error "bad toEnum PosNat"
+
+  fromEnum AA2 = 0
+  fromEnum BB2 = 1
+  fromEnum CC2 = 2
+  fromEnum DD2 = 3
+
+data NegNat = AA3 | BB3 | CC3 | DD3 deriving stock (Bounded, Show, Eq)
+instance Enum NegNat where
+  toEnum (-3) = AA3
+  toEnum (-2) = BB3
+  toEnum (-1) = CC3
+  toEnum 0 = DD3
+  toEnum _ = error "bad toEnum NegNat"
+
+  fromEnum AA3 = -3
+  fromEnum BB3 = -2
+  fromEnum CC3 = -1
+  fromEnum DD3 = 0
+
+data PosOnly = AA1 | BB1 | CC1 deriving stock (Bounded, Show, Eq)
+instance Enum PosOnly where
+  toEnum 1 = AA1
+  toEnum 2 = BB1
+  toEnum 3 = CC1
+  toEnum _ = error "bad toEnum PosOnly"
+
+  fromEnum AA1 = 1
+  fromEnum BB1 = 2
+  fromEnum CC1 = 3
+
+data PosOnly2 = AA5 | BB5 | CC5 deriving stock (Bounded, Show, Eq)
+instance Enum PosOnly2 where
+  toEnum 2 = AA5
+  toEnum 3 = BB5
+  toEnum 4 = CC5
+  toEnum _ = error "bad toEnum PosOnly2"
+
+  fromEnum AA5 = 2
+  fromEnum BB5 = 3
+  fromEnum CC5 = 4
+
+data NegOnly = AA4 | BB4 | CC4 deriving stock (Bounded, Show, Eq)
+instance Enum NegOnly where
+  toEnum (-3) = AA4
+  toEnum (-2) = BB4
+  toEnum (-1) = CC4
+  toEnum _ = error "bad toEnum NegOnly"
+
+  fromEnum AA4 = -3
+  fromEnum BB4 = -2
+  fromEnum CC4 = -1
diff --git a/test/TestExtra.hs b/test/TestExtra.hs
new file mode 100644
--- /dev/null
+++ b/test/TestExtra.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module TestExtra where
+
+import Primus.Extra
+import Test.Tasty
+import Test.Tasty.HUnit
+
+suite :: TestTree
+suite =
+  testGroup
+    "TestExtra"
+    [ testCase "on1" $ on1 compare length "adsf" [1 :: Int .. 2] @?= GT
+    ]
diff --git a/test/TestFold.hs b/test/TestFold.hs
new file mode 100644
--- /dev/null
+++ b/test/TestFold.hs
@@ -0,0 +1,266 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module TestFold where
+
+import Data.Bool
+import Data.Char
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as N
+import Data.Ord
+import Data.Pos
+import Data.These
+import Primus.Fold
+import Primus.NonEmpty
+import Test.Tasty
+import Test.Tasty.HUnit
+
+doit :: IO ()
+doit = defaultMain suite
+
+suite :: TestTree
+suite =
+  testGroup
+    "TestFold"
+    [ testCase "histMapL" $
+        histMapL (\ps ft z a -> ((length ft, length ps) : z, show a)) [(999, 998)] [1 .. 5 :: Int]
+          @?= ([(0, 4), (1, 3), (2, 2), (3, 1), (4, 0), (999, 998)], ["1", "2", "3", "4", "5"])
+    , testCase "histMapL" $
+        histMapL (\_ps ft z a -> (ft : z, show a)) [] [1 .. 5 :: Int]
+          @?= ([[], [5], [4, 5], [3, 4, 5], [2, 3, 4, 5]], ["1", "2", "3", "4", "5"])
+    , testCase "histMapR" $
+        histMapR (\_ps ft z a -> (ft : z, show a)) [] [1 .. 5 :: Int]
+          @?= ([[], [1], [2, 1], [3, 2, 1], [4, 3, 2, 1]], ["1", "2", "3", "4", "5"])
+    , testCase "histMapL" $
+        histMapL (\ps ft z a -> (z - 1, (z, toUpper a, ps, ft))) (100 :: Int) ['a' .. 'f']
+          @?= (94, [(100, 'A', "", "bcdef"), (99, 'B', "a", "cdef"), (98, 'C', "ba", "def"), (97, 'D', "cba", "ef"), (96, 'E', "dcba", "f"), (95, 'F', "edcba", "")])
+    , testCase "histMapR" $
+        histMapR (\ps ft z a -> (z - 1, (z, toUpper a, ps, ft))) (100 :: Int) ['a' .. 'f']
+          @?= (94, [(95, 'A', "bcdef", ""), (96, 'B', "cdef", "a"), (97, 'C', "def", "ba"), (98, 'D', "ef", "cba"), (99, 'E', "f", "dcba"), (100, 'F', "", "edcba")])
+    , testCase "histMapL'" $ histMapL' (\p f a -> (a, p, f)) ['a' .. 'f'] @?= [('a', "", "bcdef"), ('b', "a", "cdef"), ('c', "ba", "def"), ('d', "cba", "ef"), ('e', "dcba", "f"), ('f', "edcba", "")]
+    , testCase "fillTraversable" $ fillTraversable [1 :: Int, 2, 3] ("abcdef" :: String) @?= Right ("def", "abc")
+    , testCase "fillTraversableExact" $ fillTraversableExact [1 :: Int, 2, 3] ("abc" :: String) @?= Right "abc"
+    , testCase "fillTraversableExact" $ fillTraversableExact [1 :: Int, 2, 3] ("abcd" :: String) @?= Left "fillTraversableExact: too many elements found"
+    , testCase "wrapL" $ wrapL reverse ("abcdef" :: String) @?= Right "fedcba"
+    , testCase "wrapL" $ wrapL (map succ) (Just (123 :: Int)) @?= Right (Just 124)
+    , testCase "wrapL" $ wrapL (map succ) (Nothing :: Maybe Int) @?= Right Nothing
+    , testCase "padL" $ padL (replicate1 @Int _10P 1) [9999] @?= Right (1 :| [1, 1, 1, 1, 1, 1, 1, 1, 9999])
+    , testCase "padR" $ padR (replicate1 @Int _10P 1) [9999] @?= Right (9999 :| [1, 1, 1, 1, 1, 1, 1, 1, 1])
+    , testCase "padR" $ padR (replicate1 @Int _1P 4) [9999] @?= Right (9999 :| [])
+    , testCase "padR fail" $ padR (replicate1 @Int _1P 4) [9999, 123] @?= Left "padR: negative fill: would need to truncate the data"
+    , testCase "padR" $ padR ("a" :: String) [] @?= Right "a"
+    , testCase "padR fail" $ padR ("a" :: String) ("bc" :: String) @?= Left "padR: negative fill: would need to truncate the data"
+    , testCase "padL fail" $ padL ("a" :: String) ("bc" :: String) @?= Left "padL: negative fill: would need to truncate the data"
+    , testCase "padR" $ padR (replicate 5 'a') ("bc" :: String) @?= Right "bcaaa"
+    , testCase "padR" $ padR ("aa" :: String) ("bc" :: String) @?= Right "bc"
+    , testCase "padR" $ padR [1 .. 10 :: Int] [101 .. 104] @?= Right [101, 102, 103, 104, 5, 6, 7, 8, 9, 10]
+    , testCase "padL" $ padL [1 .. 10 :: Int] [101 .. 104] @?= Right [1, 2, 3, 4, 5, 6, 101, 102, 103, 104]
+    , testCase "padR" $ padR [1 .. 4 :: Int] [101 .. 104] @?= Right [101, 102, 103, 104]
+    , testCase "padL" $ padL (1 :| [2 .. 4 :: Int]) [101 .. 104] @?= Right (101 :| [102, 103, 104])
+    , testCase "padR" $ padR (1 :| [2 .. 10 :: Int]) [101 .. 104] @?= Right (101 :| [102, 103, 104, 5, 6, 7, 8, 9, 10])
+    , testCase "padL" $ padL (1 :| [2 .. 10 :: Int]) [101 .. 104] @?= Right (1 :| [2, 3, 4, 5, 6, 101, 102, 103, 104])
+    , testCase "padR" $ padR (1 :| [2 .. 4 :: Int]) [101 .. 104] @?= Right (101 :| [102, 103, 104])
+    , testCase "padL" $ padL (1 :| [2 .. 4 :: Int]) [101 .. 104] @?= Right (101 :| [102, 103, 104])
+    , testCase "zipExtrasT" $ zipExtrasT [1 :: Int .. 5] ['a' .. 'f'] @?= [These 1 'a', These 2 'b', These 3 'c', These 4 'd', These 5 'e', That 'f']
+    , testCase "zipExtrasT" $ zipExtrasT [1 :: Int .. 5] ['a' .. 'e'] @?= [These 1 'a', These 2 'b', These 3 'c', These 4 'd', These 5 'e']
+    , testCase "zipExtrasT" $ zipExtrasT [1 :: Int .. 4] ['a' .. 'e'] @?= [These 1 'a', These 2 'b', These 3 'c', These 4 'd', That 'e']
+    , testCase "zipExtrasT" $ zipExtrasT [1 :: Int .. 4] ([] @()) @?= [This 1, This 2, This 3, This 4]
+    , testCase "zipExtrasT" $ zipExtrasT ([] @()) [1 :: Int .. 4] @?= [That 1, That 2, That 3, That 4]
+    , testCase "compareLength" $ compareLength [1 :: Int .. 5] ("abc" :: String) @?= CGT
+    , testCase "compareLength" $ compareLength [1 :: Int .. 5] ("abcde" :: String) @?= CEQ
+    , testCase "compareLength" $ compareLength [1 :: Int .. 5] ("abcdefg" :: String) @?= CLT ('f' :| "g")
+    , testCase "compareLength" $ compareLength [1 :: Int .. 5] ("" :: String) @?= CGT
+    , testCase "compareLength" $ compareLength ([] :: [Int]) ("" :: String) @?= CEQ
+    , testCase "compareLength" $ compareLength (These () 'x') ('a' :| "bc") @?= CLT ('b' :| "c")
+    , testCase "compareLength" $ compareLength (These True 'x') ('a' :| "") @?= CEQ
+    , testCase "compareLength" $
+        compareLength ([] :: [Int]) ([] @Char)
+          @?= CEQ
+    , testCase "compareLength" $
+        compareLength ('a' :| ['b' .. 'g']) [100 :: Int .. 104]
+          @?= CGT
+    , testCase "compareLength" $
+        compareLength ('a' :| ['b' .. 'g']) [100 :: Int .. 105]
+          @?= CGT
+    , testCase "compareLength" $
+        compareLength ('a' :| ['b' .. 'g']) [100 :: Int .. 112]
+          @?= CLT (107 :| [108, 109, 110, 111, 112])
+    , testCase "compareLength" $
+        compareLength ('a' :| ['b' .. 'g']) [100 :: Int .. 108]
+          @?= CLT (107 :| [108])
+    , testCase "compareLength" $
+        compareLength ('a' :| ['b' .. 'g']) [100 :: Int .. 106]
+          @?= CEQ
+    , testCase "compareLengths" $
+        compareLengths ([1 :: Int .. 5] :| [[101 .. 110], [201 .. 205], [301 .. 302], [], [1001 .. 1020]])
+          @?= [ CLT (106 :| [107, 108, 109, 110])
+              , CEQ
+              , CGT
+              , CGT
+              , CLT (1006 :| [1007, 1008, 1009, 1010, 1011, 1012, 1013, 1014, 1015, 1016, 1017, 1018, 1019, 1020])
+              ]
+    , testCase "compareLengths" $
+        compareLengths ([1 :: Int .. 5] :| [[101 .. 110]])
+          @?= [CLT (106 :| [107 .. 110])]
+    , testCase "compareLengths" $
+        compareLengths ([1 :: Int .. 5] :| [])
+          @?= []
+    , testCase "compareLength infinite lhs" $
+        compareLength [1 :: Int ..] ['a' .. 'f']
+          @?= CGT
+    , testCase "compareLength infinite rhs" $
+        case compareLength ['a' .. 'f'] [1 :: Int ..] of
+          CLT ns -> N.take 10 ns @?= [7 .. 16]
+          o -> assertFailure $ "expected CLT but found " ++ show o
+    , testCase "zipWithExact" $
+        zipWithExact (,) (1 :| [2 :: Int .. 5]) ['a' .. 'e']
+          @?= Right ((1, 'a') :| [(2, 'b'), (3, 'c'), (4, 'd'), (5, 'e')])
+    , testCase "zipWithExact" $
+        zipWithExact (,) (1 :| [2 :: Int .. 5]) ['a' .. 'f']
+          @?= Left "zipWithExact: lhs has less data"
+    , testCase "zipWithExact" $
+        zipWithExact (,) (1 :| [2 :: Int .. 5]) ['a' .. 'd']
+          @?= Left "zipWithExact: lhs has more data"
+    , testCase "tailsT" $
+        tailsT (1 :| [2 :: Int, 3, 4, 5, 6, 7, 8, 9, 10])
+          @?= (1 :| [2, 3, 4, 5, 6, 7, 8, 9, 10])
+          :| [ 2 :| [3, 4, 5, 6, 7, 8, 9, 10]
+             , 3 :| [4, 5, 6, 7, 8, 9, 10]
+             , 4 :| [5, 6, 7, 8, 9, 10]
+             , 5 :| [6, 7, 8, 9, 10]
+             , 6 :| [7, 8, 9, 10]
+             , 7 :| [8, 9, 10]
+             , 8 :| [9, 10]
+             , 9 :| [10]
+             , 10 :| []
+             ]
+    , testCase "initsT" $
+        initsT (1 :| [2 :: Int, 3, 4, 5, 6, 7, 8, 9, 10])
+          @?= (1 :| [])
+          :| [ 1 :| [2]
+             , 1 :| [2, 3]
+             , 1 :| [2, 3, 4]
+             , 1 :| [2, 3, 4, 5]
+             , 1 :| [2, 3, 4, 5, 6]
+             , 1 :| [2, 3, 4, 5, 6, 7]
+             , 1 :| [2, 3, 4, 5, 6, 7, 8]
+             , 1 :| [2, 3, 4, 5, 6, 7, 8, 9]
+             , 1 :| [2, 3, 4, 5, 6, 7, 8, 9, 10]
+             ]
+    , testCase "reverseT" $
+        reverseT (1 :| [2 :: Int, 3, 4, 5, 6, 7, 8, 9, 10])
+          @?= 10 :| [9, 8, 7, 6, 5, 4, 3, 2, 1]
+    , testCase "sortByT" $
+        sortByT (comparing (\x -> Down (x `mod` 5, x))) [1 :: Int .. 10]
+          @?= [9, 4, 8, 3, 7, 2, 6, 1, 10, 5]
+    , testCase "pFoldL" $
+        pFoldL (\xs ys z a -> (xs, ys, a) : z) [([77], [88], 999)] [1 :: Int .. 5]
+          @?= [ ([4, 3, 2, 1], [], 5)
+              , ([3, 2, 1], [5], 4)
+              , ([2, 1], [4, 5], 3)
+              , ([1], [3, 4, 5], 2)
+              , ([], [2, 3, 4, 5], 1)
+              , ([77], [88], 999)
+              ]
+    , testCase "pFoldR" $
+        pFoldR (\xs ys z a -> (xs, ys, a) : z) [([77], [88], 999)] [1 :: Int .. 5]
+          @?= [ ([], [2, 3, 4, 5], 1)
+              , ([1], [3, 4, 5], 2)
+              , ([2, 1], [4, 5], 3)
+              , ([3, 2, 1], [5], 4)
+              , ([4, 3, 2, 1], [], 5)
+              , ([77], [88], 999)
+              ]
+    , testCase "pFoldL" $
+        pFoldL (\as bs b a -> (as, bs, a) : b) [] [1 :: Int .. 4]
+          @?= [([3, 2, 1], [], 4), ([2, 1], [4], 3), ([1], [3, 4], 2), ([], [2, 3, 4], 1)]
+    , testCase "pFoldR" $
+        pFoldR (\as bs b a -> (as, bs, a) : b) [] [1 :: Int .. 4]
+          @?= [([], [2, 3, 4], 1), ([1], [3, 4], 2), ([2, 1], [4], 3), ([3, 2, 1], [], 4)]
+    , testCase "unfoldl" $
+        unfoldl (\s -> if null s then Nothing else Just (splitAt 2 s)) "abcdef"
+          @?= ["ef", "cd", "ab"]
+    , testCase "unfoldl" $
+        unfoldl (\s -> if null s then Nothing else Just (splitAt 2 s)) ""
+          @?= []
+    , testCase "unfoldrM" $
+        unfoldrM (\s -> Right @() (if null s then Nothing else Just (splitAt 2 s))) ("" :: String)
+          @?= Right []
+    , testCase "unfoldlM" $
+        unfoldlM (\s -> Right @() (if null s then Nothing else Just (splitAt 2 s))) "abcdefg"
+          @?= Right ["g", "ef", "cd", "ab"]
+    , testCase "unfoldrM" $
+        unfoldrM (\s -> Right @() (if null s then Nothing else Just (splitAt 2 s))) "abcdefg"
+          @?= Right ["ab", "cd", "ef", "g"]
+    , testCase "unfoldrM" $
+        unfoldrM (\s -> if length s == 4 then Left ("xx" :: String) else Right (if null s then Nothing else Just (splitAt 2 s))) "abcd"
+          @?= Left "xx"
+    , testCase "unfoldrM" $
+        unfoldrM (\s -> if length s == 3 then Left ("xx" :: String) else Right (if null s then Nothing else Just (splitAt 2 s))) "abcdefg"
+          @?= Left "xx"
+    , testCase "unfoldlM" $
+        unfoldlM (\s -> if null s then [Nothing] else [Just $ splitAt 3 s, Just $ splitAt 5 s]) [1 :: Int .. 10]
+          @?= [ [[10], [7, 8, 9], [4, 5, 6], [1, 2, 3]]
+              , [[10], [7, 8, 9], [4, 5, 6], [1, 2, 3]]
+              , [[7, 8, 9, 10], [4, 5, 6], [1, 2, 3]]
+              , [[9, 10], [4, 5, 6, 7, 8], [1, 2, 3]]
+              , [[9, 10], [4, 5, 6, 7, 8], [1, 2, 3]]
+              , [[9, 10], [6, 7, 8], [1, 2, 3, 4, 5]]
+              , [[9, 10], [6, 7, 8], [1, 2, 3, 4, 5]]
+              , [[6, 7, 8, 9, 10], [1, 2, 3, 4, 5]]
+              ]
+    , testCase "unfoldrM" $
+        unfoldrM (\s -> if null s then [Nothing] else [Just $ splitAt 3 s, Just $ splitAt 5 s]) [1 :: Int .. 10]
+          @?= [ [[1, 2, 3], [4, 5, 6], [7, 8, 9], [10]]
+              , [[1, 2, 3], [4, 5, 6], [7, 8, 9], [10]]
+              , [[1, 2, 3], [4, 5, 6], [7, 8, 9, 10]]
+              , [[1, 2, 3], [4, 5, 6, 7, 8], [9, 10]]
+              , [[1, 2, 3], [4, 5, 6, 7, 8], [9, 10]]
+              , [[1, 2, 3, 4, 5], [6, 7, 8], [9, 10]]
+              , [[1, 2, 3, 4, 5], [6, 7, 8], [9, 10]]
+              , [[1, 2, 3, 4, 5], [6, 7, 8, 9, 10]]
+              ]
+    , testCase "unfoldlM" $
+        unfoldlM (\s -> if null s then [Nothing] else map Just [splitAt 2 s, splitAt 3 s]) "abcdef"
+          @?= [ ["ef", "cd", "ab"]
+              , ["ef", "cd", "ab"]
+              , ["f", "cde", "ab"]
+              , ["f", "cde", "ab"]
+              , ["f", "de", "abc"]
+              , ["f", "de", "abc"]
+              , ["def", "abc"]
+              ]
+    , testCase "unfoldrM" $
+        unfoldrM (\s -> if null s then [Nothing] else map Just [splitAt 2 s, splitAt 3 s]) "abcdef"
+          @?= [ ["ab", "cd", "ef"]
+              , ["ab", "cd", "ef"]
+              , ["ab", "cde", "f"]
+              , ["ab", "cde", "f"]
+              , ["abc", "de", "f"]
+              , ["abc", "de", "f"]
+              , ["abc", "def"]
+              ]
+    , testCase "unfoldrM1" $
+        unfoldrM1 (\s -> let (a, b) = splitAt 3 s; (c, d) = splitAt 5 s in bool [(a, Just b)] [(a, Nothing)] (null b) <> bool [(c, Just d)] [(c, Nothing)] (null d)) "abcdefghi"
+          @?= [ "abc" :| ["def", "ghi"]
+              , "abc" :| ["def", "ghi"]
+              , "abc" :| ["defgh", "i"]
+              , "abc" :| ["defgh", "i"]
+              , "abcde" :| ["fgh", "i"]
+              , "abcde" :| ["fgh", "i"]
+              , "abcde" :| ["fghi"]
+              ]
+    , testCase "unfoldrM" $
+        unfoldrM (\s -> if null s then [Nothing] else map Just [splitAt 3 s, splitAt 5 s]) "abcdefghi"
+          @?= [ ["abc", "def", "ghi"]
+              , ["abc", "def", "ghi"]
+              , ["abc", "defgh", "i"]
+              , ["abc", "defgh", "i"]
+              , ["abcde", "fgh", "i"]
+              , ["abcde", "fgh", "i"]
+              , ["abcde", "fghi"]
+              ]
+    ]
diff --git a/test/TestLRHist.hs b/test/TestLRHist.hs
new file mode 100644
--- /dev/null
+++ b/test/TestLRHist.hs
@@ -0,0 +1,371 @@
+{-# OPTIONS -Wno-orphans #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module TestLRHist where
+
+import Control.Monad
+import Data.Char
+import Data.Foldable
+import Data.Functor
+import qualified Data.Monoid as MM
+import Data.Proxy
+import Data.These
+import Primus.LRHist
+import qualified Primus.TypeLevel as TP
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+import "checkers" Test.QuickCheck.Classes
+import Test.Tasty
+import Test.Tasty.HUnit
+import qualified Test.Tasty.QuickCheck as TQ
+
+argsVerbose :: Args
+argsVerbose = stdArgs{maxSuccess = 500, chatty = True}
+
+doit :: IO ()
+doit = defaultMain suite
+
+instance (LRHistArbC as e a, Arbitrary a, Arbitrary e) => Arbitrary (LRHist as e a) where
+  arbitrary = lrhistArbC
+
+class LRHistArbC as e a where
+  lrhistArbC :: (Arbitrary a, Arbitrary e) => Gen (LRHist as e a)
+instance LRHistArbC '[] e a where
+  lrhistArbC = Rhi <$> arbitrary
+instance (Arbitrary a', LRHistArbC as e a') => LRHistArbC (a' ': as) e a where
+  lrhistArbC = do
+    x <- lrhistArbC @as @e @a'
+    case x of
+      LhSkip{} -> pure $ LhSkip x
+      Lh{} -> pure $ LhSkip x
+      Rhi{} -> oneof [flip Rh x <$> arbitrary, flip Lh x <$> arbitrary]
+      Rh{} -> oneof [flip Rh x <$> arbitrary, flip Lh x <$> arbitrary]
+
+instance (TP.ApplyConstraint Eq as, Eq e, Eq a) => EqProp (LRHist as e a) where (=-=) = eq
+
+testLawsLRHist0 :: [TestBatch]
+testLawsLRHist0 =
+  [functor z, monoid z, semigroup (z, Fixed (10 :: Int)), foldable z1] --  , traversable z] -- 9.2 issues
+ where
+  z = undefined :: LRHist '[] String (MM.Sum Integer, String, MM.Sum Int)
+  z1 = undefined :: LRHist '[] String (String, Integer, String, Int, Bool)
+
+testLawsLRHist1 :: [TestBatch]
+testLawsLRHist1 =
+  [functor z, monoid z, semigroup (z, Fixed (10 :: Int)), foldable z1] --   , traversable z]
+ where
+  z = undefined :: LRHist '[MM.Sum Int, String] String (MM.Sum Integer, String, MM.Sum Int)
+  z1 = undefined :: LRHist '[MM.Sum Int, String] String (String, Integer, String, Int, Bool)
+
+testLawsLRHistIO :: IO ()
+testLawsLRHistIO = do
+  traverse_ verboseBatch testLawsLRHist0
+  traverse_ verboseBatch testLawsLRHist1
+
+suite :: TestTree
+suite =
+  testGroup
+    "TestLRHist"
+    [ testCase "lhToEither" $ lhToEither (appLR Left (appLR Right (Rhi 'x'))) @?= Left @_ @String 'x'
+    , testCase "lhToEither" $ lhToEither (appLR Right (appLR Right (appLR (const (Left "xx")) (Rhi 'x')))) @?= Left @String @() "xx"
+    , testCase "lhToEither" $ lhToEither (appLR Right (appLR Right (appLR Right (Rhi 'x')))) @?= Right @String 'x'
+    , testCase "lhToEither" $ lhToEither (appLR (Right . show) (appLR Right (appLR Right (Rhi 'x')))) @?= Right @String "'x'"
+    , testCase "lhToEither" $ lhToEither (appLR Left (Rhi 'x')) @?= Left @_ @String 'x'
+    , testCase "lhToEither" $ lhToEither (Rhi 'x') @?= Right @() 'x'
+    , testCase "validateLRHist" $ validateLRHist (LhSkip (Rhi ())) @?= Left "LhSkip cannot wrap Rhi"
+    , testCase "validateLRHist" $ validateLRHist (Lh () (Rhi ())) @?= Right ()
+    , testCase "validateLRHist" $ validateLRHist (Lh () (Rh () (Rhi ()))) @?= Right ()
+    , testCase "validateLRHist" $ validateLRHist (Rh () (Lh () (Rhi ()))) @?= Left "Rh cannot wrap Lh"
+    , testCase "read" $ readsPrec @(LRHist '[Bool] String Char) 1 (show (Rh 'x' (Rhi @_ @String True))) @?= [(Rh 'x' (Rhi True), "")]
+    , testCase "read" $ readsPrec @(LRHist '[Double, Bool] String Char) 1 (show (LhSkip @_ @_ @_ @Double $ Lh @_ @_ @_ @Int "ogre" (Rhi @_ @String True))) @?= [(LhSkip (Lh "ogre" (Rhi @_ @String True)), "")]
+    , testCase "read dsl" $ readsPrec @(LRHist '[Double, Bool] String Char) 1 (show (snd (lhskip @Double $ lh @Int "ogre" (rhi @String True)))) @?= [(LhSkip (Lh "ogre" (Rhi @_ @String True)), "")]
+    , testCase "read" $ readsPrec @(LRHist '[Bool] String Char) 1 (show (Lh @_ @_ @_ @Int "ogre" (Rhi @_ @String True))) @?= [(Lh "ogre" (Rhi True), "")]
+    , testCase "read dsl" $ readsPrec @(LRHist '[Bool] String Char) 1 (show (snd (lh @Int "ogre" (rhi @String True)))) @?= [(Lh "ogre" (Rhi True), "")]
+    , testCase "dsl" $ lhskip @() (lh @Int "ogre" (rhi @String True)) @?= (Proxy, LhSkip (Lh "ogre" (Rhi True)))
+    , testCase "dsl" $ (lhskip @() $ lh @Int "ogre" $ rh True $ rhi @String True) @?= (Proxy, LhSkip (Lh "ogre" (Rh True (Rhi True))))
+    , testCase "dsl" $ (lhskip @() $ lh @Int "ogre" $ rhi @String True) @?= (Proxy, LhSkip (Lh "ogre" (Rhi True)))
+    , testCase "dsl" $ snd (lhskip @() (lh @Int "hello" (rhi @String ()))) @?= LhSkip (Lh "hello" (Rhi ()))
+    , testCase "dsl" $ snd (lhskip @Double (lhskip @() (lh @Int "hello" (rhi @String ())))) @?= LhSkip (LhSkip (Lh "hello" (Rhi ())))
+    , testCase "dsl" $ snd (lhskip @Double (lhskip @Bool (lh @Int "hello" (rh 'x' (rhi @String ()))))) @?= LhSkip (LhSkip (Lh "hello" (Rh 'x' (Rhi ()))))
+    , testCase "validateLRHist" $ validateLRHist (snd (lhskip (lhskip (lh @_ @String "xx" (rhi 'x'))))) @?= Right ()
+    , testCase "dsl" $ snd (lhskip (lhskip (lh @_ @String "xx" (rhi 'x')))) @?= (LhSkip (LhSkip (Lh "xx" (Rhi 'x'))) :: LRHist '[Double, Bool, Char] String ())
+    , testCase "read" $
+        let x :: LRHist '[Bool, Char, Int] String ()
+            x = LhSkip (LhSkip (Lh "xx" (Rhi 3)))
+         in read (show x) @?= x
+    , testCase "read" $
+        let x :: LRHist '[Bool, Char, Float, Int] String ()
+            x = LhSkip (LhSkip (Lh "xx" (Rh 1.2 (Rhi 3))))
+         in read (show x) @?= x
+    , testCase "read" $
+        let x :: LRHist '[Char, Float, Int] String Bool
+            x = Rh False (Rh 'x' (Rh 1.2 (Rhi 3)))
+         in read (show x) @?= x
+    , testCase "read" $
+        let x :: LRHist '[Bool, Char, Float, Int] String ()
+            x = Lh "yy" (Lh "xx" (Rh 'x' (Rh 1.2 (Rhi 3)))) -- even though fundamentally flawed
+         in read (show x) @?= x
+    , testCase "read" $ read @(LRHist '[Int] String Bool) (show (snd (lh @() "adf" $ rhi @String @Int 1))) @?= Lh "adf" (Rhi 1)
+    , testCase "validateLRHist" $
+        let x :: LRHist '[Bool, Char, Float, Int] String ()
+            x = Lh "yy" (Lh "xx" (Rh 'x' (Rh 1.2 (Rhi 3))))
+         in validateLRHist x @?= Left "Lh cannot wrap Lh"
+    , testCase "lhToEither" $
+        map lhToEither zz2
+          @?= [ Left "ab"
+              , Right (This 'H')
+              , Left "dude"
+              , Right (That 50)
+              ]
+    , testCase "lhToEitherI" $
+        map lhToEitherI zz2
+          @?= [ Left "ab"
+              , Right (This 'H', (72, (2, ('y', (True, ())))))
+              , Left "dude"
+              , Right (That 50, (50, (299, ('a', (False, ())))))
+              ]
+    , testCase "lhToEitherTuples" $
+        map lhToEitherTuples zz2
+          @?= [ Left "ab"
+              , Right (This 'H', 72, 2, 'y', True)
+              , Left "dude"
+              , Right (That 50, 50, 299, 'a', False)
+              ]
+    , testCase "lhToEitherTuples appLR" $
+        (zz1 <&> lhToEitherTuples . appLR (> 50))
+          @?= [ Left "ab"
+              , Right (72, 72, 2, 'y', True)
+              , Right (71, 71, 299, 'a', False)
+              , Left ""
+              ]
+    , testCase "lhToEitherTuples appLR" $
+        (zz1 <&> lhToEitherTuples . appLR (\a -> if a > 50 then Just (chr a) else Nothing))
+          @?= [ Left "ab"
+              , Right ('H', 72, 2, 'y', True)
+              , Right ('G', 71, 299, 'a', False)
+              , Left ""
+              ]
+    , testCase "appLR" $
+        map (appLR @String (\a -> if even a then Right (chr (a + 50)) else Left ("oops:" ++ show a)) . Rhi) [1 :: Int .. 6]
+          @?= [ Lh "oops:1" (Rhi 1)
+              , Rh '4' (Rhi 2)
+              , Lh "oops:3" (Rhi 3)
+              , Rh '6' (Rhi 4)
+              , Lh "oops:5" (Rhi 5)
+              , Rh '8' (Rhi 6)
+              ]
+    , testCase "appLR" $
+        map (appLR even . Rhi) [1 :: Int .. 5]
+          @?= [ Lh
+                  ()
+                  (Rhi 1)
+              , Rh
+                  2
+                  (Rhi 2)
+              , Lh
+                  ()
+                  (Rhi 3)
+              , Rh
+                  4
+                  (Rhi 4)
+              , Lh
+                  ()
+                  (Rhi 5)
+              ]
+    , testCase "appLR" $
+        map (appLR (\a -> if a <= 3 then Nothing else Just (chr (a + 50))) . appLR even . Rhi) [1 :: Int .. 6]
+          @?= [ LhSkip
+                  ( Lh
+                      ()
+                      (Rhi 1)
+                  )
+              , Lh
+                  ()
+                  ( Rh
+                      2
+                      (Rhi 2)
+                  )
+              , LhSkip
+                  ( Lh
+                      ()
+                      (Rhi 3)
+                  )
+              , Rh
+                  '6'
+                  ( Rh
+                      4
+                      (Rhi 4)
+                  )
+              , LhSkip
+                  ( Lh
+                      ()
+                      (Rhi 5)
+                  )
+              , Rh
+                  '8'
+                  ( Rh
+                      6
+                      (Rhi 6)
+                  )
+              ]
+    , testCase "lhMaybe'" $
+        map (lhMaybe' (> 3) (chr . (+ 50)) . lhBool even . Rhi) [1 :: Int .. 6]
+          @?= [ LhSkip
+                  ( Lh
+                      ()
+                      (Rhi 1)
+                  )
+              , Lh
+                  ()
+                  ( Rh
+                      2
+                      (Rhi 2)
+                  )
+              , LhSkip
+                  ( Lh
+                      ()
+                      (Rhi 3)
+                  )
+              , Rh
+                  '6'
+                  ( Rh
+                      4
+                      (Rhi 4)
+                  )
+              , LhSkip
+                  ( Lh
+                      ()
+                      (Rhi 5)
+                  )
+              , Rh
+                  '8'
+                  ( Rh
+                      6
+                      (Rhi 6)
+                  )
+              ]
+    , testCase "traverseLRHist" $
+        traverseLRHist (\z a -> (z + 1, if even a then Right (z, a) else Left (a, z))) (100 :: Int) (map Rhi [1 :: Int .. 6])
+          @?= ( 106
+              ,
+              [ Lh
+                  ( 1
+                  , 100
+                  )
+                  (Rhi 1)
+              , Rh
+                  ( 101
+                  , 2
+                  )
+                  (Rhi 2)
+              , Lh
+                  ( 3
+                  , 102
+                  )
+                  (Rhi 3)
+              , Rh
+                  ( 103
+                  , 4
+                  )
+                  (Rhi 4)
+              , Lh
+                  ( 5
+                  , 104
+                  )
+                  (Rhi 5)
+              , Rh
+                  ( 105
+                  , 6
+                  )
+                  (Rhi 6)
+              ]
+              )
+    , testCase "appLR" $
+        appLR (\a -> if even a then Just a else Nothing) (Rhi @Int @() 4)
+          @?= Rh 4 (Rhi 4)
+    , testCase "appLR" $
+        appLR (\a -> if even a then Just (chr (a + 50)) else Nothing) (Rhi @Int @() 4)
+          @?= Rh '6' (Rhi 4)
+    , testCase "appLR" $
+        appLR (\a -> if even a then Just (chr (a + 50)) else Nothing) (Rhi @Int @() 4)
+          @?= Rh '6' (Rhi 4)
+    , testCase "appLR" $
+        appLR even (Rhi @Int @() 4)
+          @?= Rh 4 (Rhi 4)
+    , testCase "appLR" $
+        appLR (\a -> if even a then Right (chr (a + 50)) else Left @String "znork") (Rhi @Int 4)
+          @?= Rh '6' (Rhi 4)
+    , testCase "appLR" $
+        appLR (\a -> if even a then Right (chr (a + 50)) else Left @String "znork") (Rhi @Int 5)
+          @?= Lh "znork" (Rhi 5)
+    , testCase "appLR" $
+        lhEither' even (const @String "znork") (chr . (+ 50)) (Rhi @Int 5)
+          @?= Lh "znork" (Rhi 5)
+    , testCase "appLRB" $
+        appLRB even show (chr . (65 +)) (Rhi @Int 12)
+          @?= Rh 'M' (Rhi 12)
+    , testCase "appLRB" $
+        appLRB even show (chr . (65 +)) (Rhi @Int 11)
+          @?= Lh "11" (Rhi 11)
+    , testCase "eitherToLH" $ eitherToLH (Left @_ @Int 'x') @?= Lh 'x' (Rhi ())
+    , testCase "eitherToLH" $ eitherToLH (Right @Int 'x') @?= Rh 'x' (Rhi ())
+    , testCase "lhEither'" $
+        lhEither' ((> 4) . length) show (join (,)) (lhMaybe' even show (lhBool even (Rhi @Int 12)))
+          @?= Lh "\"12\"" (Rh "12" (Rh 12 (Rhi 12)))
+    , testCase "traverseLRHistB" $
+        traverseLRHistB (< 'x') show id [snd $ lhskip $ lh "sdf" $ rhi 12, snd $ rh 'a' $ rh @_ @Int 999 $ rhi @_ @Int 123]
+          @?= [ LhSkip (LhSkip (Lh "sdf" (Rhi 12)))
+              , Rh 'a' (Rh 'a' (Rh 999 (Rhi 123)))
+              ]
+    ]
+
+zz1 :: [LRHist '[Int, Char, Bool] String Int]
+zz1 =
+  [ snd $ lhskip $ lh "ab" $ rh 'x' $ rhi False
+  , snd $ rh 72 $ rh 2 $ rh 'y' $ rhi True
+  , snd $ rh 71 $ rh 299 $ rh 'a' $ rhi False
+  , snd $ rh 50 $ rh 299 $ rh 'a' $ rhi False
+  ]
+
+zz2 :: [LRHist '[Int, Int, Char, Bool] String (These Char Int)]
+zz2 =
+  zz1
+    <&> appLR
+      ( \a ->
+          if even a
+            then
+              if a > 50
+                then Right (This (chr a))
+                else Right (That a)
+            else Left "dude"
+      )
+
+suiteCheckers :: TestTree
+suiteCheckers =
+  testGroup
+    "TestLRHist Checkers"
+    [ adj' False 100 1000 10 $ TQ.testProperties "LRHist '[]" (checkersToProps testLawsLRHist0)
+    , adj' False 100 1000 10 $ TQ.testProperties "LRHist (a ': as)" (checkersToProps testLawsLRHist1)
+    ]
+
+checkersToProps :: [TestBatch] -> [(String, Property)]
+checkersToProps = concatMap (\(a, bs) -> map (\(x, y) -> (a ++ " " ++ x, y)) bs)
+
+adj' :: Bool -> Int -> Int -> Int -> TestTree -> TestTree
+adj' v sz n ratio =
+  adjustOption (const $ TQ.QuickCheckMaxSize sz)
+    . adjustOption (max $ TQ.QuickCheckTests n)
+    . adjustOption (max $ TQ.QuickCheckMaxRatio ratio)
+    . adjustOption (const (TQ.QuickCheckVerbose v))
+
+
diff --git a/test/TestList.hs b/test/TestList.hs
new file mode 100644
--- /dev/null
+++ b/test/TestList.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module TestList where
+
+import Data.Char
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as N
+import Data.Pos
+import Data.These
+import Primus.List
+import Test.Tasty
+import Test.Tasty.HUnit
+
+suite :: TestTree
+suite =
+  testGroup
+    "TestList"
+    [ testCase "pairsOf1" $ pairsOf1 @Int [1, 2, 3] @?= ([(1, 2), (2, 3)], Nothing)
+    , testCase "pairsOf1" $ pairsOf1 @Int [1, 2] @?= ([(1, 2)], Nothing)
+    , testCase "pairsOf1" $ pairsOf1 @Int [1] @?= ([], Just 1)
+    , testCase "pairsOf1" $ pairsOf1 @Int [] @?= ([], Nothing)
+    , testCase "pairsOf2" $ pairsOf2 @Int [1, 2, 3, 4] @?= ([(1, 2), (3, 4)], Nothing)
+    , testCase "pairsOf2" $ pairsOf2 @Int [1, 2, 3] @?= ([(1, 2)], Just 3)
+    , testCase "pairsOf2" $ pairsOf2 @Int [1, 2] @?= ([(1, 2)], Nothing)
+    , testCase "pairsOf2" $ pairsOf2 @Int [1] @?= ([], Just 1)
+    , testCase "pairsOf2" $ pairsOf2 @Int [] @?= ([], Nothing)
+    , testCase "chunksOf" $ chunksOf @Int _4P [1 .. 13] @?= [[1, 2, 3, 4], [5, 6, 7, 8], [9, 10, 11, 12], [13]]
+    , testCase "chunksOf" $ chunksOf @Int _4P [1, 2, 3, 4, 5] @?= [[1, 2, 3, 4], [5]]
+    , testCase "chunksOf" $ chunksOf @Int _4P [1, 2, 3, 4] @?= [[1, 2, 3, 4]]
+    , testCase "chunksOf" $ chunksOf @Int _4P [1, 2, 3] @?= [[1, 2, 3]]
+    , testCase "chunksOf" $ chunksOf @Int _4P [1, 2] @?= [[1, 2]]
+    , testCase "chunksOf" $ chunksOf @Int _4P [1] @?= [[1]]
+    , testCase "chunksOf" $ chunksOf @Int _4P [] @?= []
+    , testCase "atL" $ atL 0 ['a', 'c', 'e'] @?= Just 'a'
+    , testCase "atL" $ atL 1 ['a', 'c', 'e'] @?= Just 'c'
+    , testCase "atL" $ atL 2 ['a', 'c', 'e'] @?= Just 'e'
+    , testCase "atL" $ atL 3 ['a', 'c', 'e'] @?= Nothing
+    , testCase "atL" $ atL 0 ([] :: [Int]) @?= Nothing
+    , testCase "updateAtL" $ updateAtL 0 toUpper "ace" @?= Just "Ace"
+    , testCase "updateAtL" $ updateAtL 1 toUpper "ace" @?= Just "aCe"
+    , testCase "updateAtL" $ updateAtL 2 toUpper "ace" @?= Just "acE"
+    , testCase "updateAtL" $ updateAtL 3 toUpper "ace" @?= Nothing
+    , testCase "updateAtL" $ updateAtL 0 toUpper "" @?= Nothing
+    , testCase "splitAtLGE" $ splitAtLGE @Int 0 [1, 2, 3, 4, 5] @?= Right ([], [1, 2, 3, 4, 5])
+    , testCase "splitAtLGE" $ splitAtLGE @Int 1 [1, 2, 3, 4, 5] @?= Right ([1], [2, 3, 4, 5])
+    , testCase "splitAtLGE" $ splitAtLGE @Int 5 [1, 2, 3, 4, 5] @?= Right ([1, 2, 3, 4, 5], [])
+    , testCase "splitAtLGE" $ splitAtLGE @Int 6 [1, 2, 3, 4, 5] @?= Left "not enough elements: expected 6 found 5"
+    , testCase "splitAtLGE" $ splitAtLGE @Int (-44) [1, 2, 3, 4, 5] @?= Left "negative index 44"
+    , testCase "splitAtLGE" $ splitAtLGE @Int 0 [] @?= Right ([], [])
+    , testCase "splitAtL" $ splitAtL @Int 0 [] @?= ([], SplitLEQ)
+    , testCase "splitAtL" $ splitAtL @Int 0 [1] @?= ([], SplitLGT (1 :| []))
+    , testCase "splitAtL" $ splitAtL @Int 1 [] @?= ([], SplitLLT 0)
+    , testCase "splitAtL" $ splitAtL @Int (-4) [1, 2, 3, 4, 5] @?= ([1, 2, 3, 4, 5], SplitLNeg _4P)
+    , testCase "splitAtL" $ splitAtL @Int 0 [1, 2, 3, 4, 5] @?= ([], SplitLGT (1 :| [2, 3, 4, 5]))
+    , testCase "splitAtL" $ splitAtL @Int 1 [1, 2, 3, 4, 5] @?= ([1], SplitLGT (2 :| [3, 4, 5]))
+    , testCase "splitAtL" $ splitAtL @Int 2 [1, 2, 3, 4, 5] @?= ([1, 2], SplitLGT (3 :| [4, 5]))
+    , testCase "splitAtL" $ splitAtL @Int 5 [1, 2, 3, 4, 5] @?= ([1, 2, 3, 4, 5], SplitLEQ)
+    , testCase "splitAtL" $ splitAtL @Int 6 [1, 2, 3, 4, 5] @?= ([1, 2, 3, 4, 5], SplitLLT 5)
+    , testCase "splitAtL" $ splitAtL @Int (-1) [1, 2, 3, 4, 5] @?= ([1, 2, 3, 4, 5], SplitLNeg _1P)
+    , testCase "splitAtL infinite" $
+        let (xs, ss) = splitAtL @Int 4 [1 ..]
+         in case ss of
+              SplitLGT ns -> (xs, N.take 10 ns) @?= ([1 .. 4], [5 .. 14])
+              o -> assertFailure $ "expected SplitLGT but found " ++ show o
+    , testCase "zipLongest" $ zipLongest [1 :: Int .. 5] "Abc" @?= [These 1 'A', These 2 'b', These 3 'c', This 4, This 5]
+    , testCase "zipLongest" $ zipLongest "Abc" [1 :: Int .. 5] @?= [These 'A' 1, These 'b' 2, These 'c' 3, That 4, That 5]
+    , testCase "lengthExact" $ lengthExact 2 "abc" @?= Left "GT: too many elements: expected 2"
+    , testCase "lengthExact" $ lengthExact 3 "abc" @?= Right "abc"
+    , testCase "lengthExact" $ lengthExact 4 "abc" @?= Left "LT: expected 4 found 3"
+    , testCase "lengthExact" $ lengthExact 0 "abc" @?= Left "GT: too many elements: expected 0"
+    , testCase "lengthExact" $ lengthExact 0 "" @?= Right ""
+    , testCase "partitionTheseL" $
+        partitionTheseL even (> 5) id (chr . (+ 50)) [1 :: Int .. 10]
+          @?= ([1, 3, 5, 7, 9], "46", [(6, '8'), (8, ':'), (10, '<')])
+    , testCase "partitionEithersL" $
+        partitionEithersL even id (chr . (+ 50)) [1 :: Int .. 10]
+          @?= ([1, 3, 5, 7, 9], "468:<")
+    , testCase "partitionTheseL" $
+        partitionTheseL (> 4) even id id [1 :: Int .. 10]
+          @?= ([1, 2, 3, 4], [5, 7, 9], [(6, 6), (8, 8), (10, 10)])
+    , testCase "spanMaybe" $
+        spanMaybe even show [2, 4, 6, 8, 1, 2, 3, 4 :: Int]
+          @?= (["2", "4", "6", "8"], [1, 2, 3, 4])
+    , testCase "spanMaybe even simpler" $
+        spanMaybe even (chr . (+ 50)) [2 :: Int, 4, 6, 8, 9, 11, 13]
+          @?= ( "468:"
+              ,
+              [ 9
+              , 11
+              , 13
+              ]
+              )
+    ]
diff --git a/test/TestNonEmpty.hs b/test/TestNonEmpty.hs
new file mode 100644
--- /dev/null
+++ b/test/TestNonEmpty.hs
@@ -0,0 +1,302 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module TestNonEmpty where
+
+import Control.Lens
+import Data.Char
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as N
+import Data.These
+import Data.Pos
+import Primus.Bool
+import Primus.Enum
+import Primus.NonEmpty
+import Test.Tasty
+import Test.Tasty.HUnit
+
+suite :: TestTree
+suite =
+  testGroup
+    "TestNonEmpty"
+    [ testCase "splits1" $ splits1 ('a' :| "bcd") @?= [('a' :| "", 'b' :| "cd"), ('a' :| "b", 'c' :| "d"), ('a' :| "bc", 'd' :| "")]
+    , testCase "splits1" $ splits1 ('a' :| "b") @?= [('a' :| "", 'b' :| "")]
+    , testCase "splits1" $ splits1 ('a' :| "") @?= []
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int (<) (1 :| [2, 5, 7, 10, 11]) @?= (1 :| [2, 5, 7, 10, 11]) :| []
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int (<) (1 :| [2, 5, 7, 3, 10, 11]) @?= (1 :| [2, 5, 7]) :| [3 :| [10, 11]]
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int (<) ((1 :: Int) :| []) @?= (1 :| []) :| []
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int (<) (10 :| [9, 8, 7, 6, 5]) @?= (10 :| []) :| [9 :| [], 8 :| [], 7 :| [], 6 :| [], 5 :| []]
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int ((==) . (+ 1)) (1 :| [4, 5, 7, 10, 11]) @?= (1 :| []) :| [4 :| [5], 7 :| [], 10 :| [11]]
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int ((==) . (+ 1)) (1 :| [2, 3, 4]) @?= (1 :| [2, 3, 4]) :| []
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int ((==) . (+ 1)) (10 :| [9, 8]) @?= (10 :| []) :| [9 :| [], 8 :| []]
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int ((==) . (+ 1)) (10 :| [8, 8, 9]) @?= (10 :| []) :| [8 :| [], 8 :| [9]]
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int ((==) . (+ 1)) (1 :| [2]) @?= (1 :| [2]) :| []
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int ((==) . (+ 1)) (1 :| [3]) @?= (1 :| []) :| [3 :| []]
+    , testCase "groupByAdjacent1" $ groupByAdjacent1 @Int ((==) . (+ 1)) (1 :| [0]) @?= (1 :| []) :| [0 :| []]
+    , testCase "findDupsBy" $ findDupsBy (even . ord) "abcd" @?= ([(0, 'a') :| [(2, 'c')], (1, 'b') :| [(3, 'd')]], [])
+    , testCase "findDupsBy" $ findDupsBy id "abcd" @?= ([], [(0, 'a'), (1, 'b'), (2, 'c'), (3, 'd')])
+    , testCase "findDupsBy" $ findDupsBy (even . ord) "aceg" @?= ([(0, 'a') :| [(1, 'c'), (2, 'e'), (3, 'g')]], [])
+    , testCase "findDupsBy" $ findDupsBy (even . ord) "acegzyz" @?= ([(0, 'a') :| [(1, 'c'), (2, 'e'), (3, 'g'), (5, 'y')], (4, 'z') :| [(6, 'z')]], [])
+    , testCase "findDupsBy" $ findDupsBy id "aaaaabccdc" @?= ([(0, 'a') :| [(1, 'a'), (2, 'a'), (3, 'a'), (4, 'a')], (6, 'c') :| [(7, 'c'), (9, 'c')]], [(5, 'b'), (8, 'd')])
+    , testCase "findDupsBy" $ findDupsBy id "aaa" @?= ([(0, 'a') :| [(1, 'a'), (2, 'a')]], [])
+    , testCase "findDupsBy" $ findDupsBy id "axaya" @?= ([(0, 'a') :| [(2, 'a'), (4, 'a')]], [(1, 'x'), (3, 'y')])
+    , testCase "consNonEmpty" $ (1 :| [2, 3, 4 :: Int]) ^. consNonEmpty @?= (1, [2, 3, 4])
+    , testCase "consNonEmpty" $ (1, [2, 3, 4 :: Int]) ^. from consNonEmpty @?= (1 :| [2, 3, 4])
+    , testCase "splitAt1'" $ splitAt1' @Int _1P (2 :| [3 .. 6]) @?= (2 :| [], SplitGT (3 :| [4, 5, 6]))
+    , testCase "splitAt1'" $ splitAt1' @Int _2P (2 :| [3 .. 6]) @?= (2 :| [3], SplitGT (4 :| [5, 6]))
+    , testCase "splitAt1'" $ splitAt1' @Int _3P (2 :| [3 .. 6]) @?= (2 :| [3, 4], SplitGT (5 :| [6]))
+    , testCase "splitAt1'" $ splitAt1' @Int _3P (2 :| []) @?= (2 :| [], SplitLT _1P)
+    , testCase "splitAt1'" $ splitAt1' @Int _1P (2 :| []) @?= (2 :| [], SplitEQ)
+    , testCase "chunksRange1" $ chunksRange1 @Int _1P _2P (1 :| [2 .. 5]) @?= (1 :| []) :| [3 :| [], 5 :| []]
+    , testCase "chunksRange1" $ chunksRange1 @Int _1P _2P (1 :| [2 .. 10]) @?= (1 :| []) :| [3 :| [], 5 :| [], 7 :| [], 9 :| []]
+    , testCase "chunksRange1" $ chunksRange1 @Int _3P _2P (1 :| [2 .. 10]) @?= (1 :| [2, 3]) :| [3 :| [4, 5], 5 :| [6, 7], 7 :| [8, 9], 9 :| [10]]
+    , testCase "chunksRange1" $ chunksRange1 @Int _3P _1P (1 :| [2 .. 10]) @?= (1 :| [2, 3]) :| [2 :| [3, 4], 3 :| [4, 5], 4 :| [5, 6], 5 :| [6, 7], 6 :| [7, 8], 7 :| [8, 9], 8 :| [9, 10], 9 :| [10], 10 :| []]
+    , testCase "chunksRange1" $ chunksRange1 @Int _3P _1P (1 :| []) @?= (1 :| []) :| []
+    , testCase "chunksRange1" $ chunksRange1 @Int _1P _1P (1 :| []) @?= (1 :| []) :| []
+    , testCase "unfoldr1NE" $
+        unfoldr1NE (\ns -> ((length ns, N.head ns), N.drop 1 ns)) (N.fromList "abcdef")
+          @?= ((6, 'a') :| [(5, 'b'), (4, 'c'), (3, 'd'), (2, 'e'), (1, 'f')])
+    , testCase "isEnumAscending" $ isEnumAscending @_ @Int (1 :| [2, 3, 4]) @?= S1Ok
+    , testCase "isEnumAscending" $ isEnumAscending @_ @Int (1 :| [2, 3, 4, 3]) @?= S1Fail (5, 3)
+    , testCase "isEnumAscending" $ isEnumAscending (LT :| [EQ, GT]) @?= S1Ok
+    , testCase "isEnumAscending" $ isEnumAscending (LT :| [EQ, GT, EQ]) @?= S1Short (EQ :| [])
+    , testCase "isEnumAscending" $ isEnumAscending @_ @Int (1 :| [2, 3, 4, 98, 9, 3]) @?= S1Fail (5, 98)
+    , testCase "splits3" $
+        splits3 (1 :| [2 :: Int .. 5])
+          @?= (([], 1, [2, 3, 4, 5]) :| [([1], 2, [3, 4, 5]), ([1, 2], 3, [4, 5]), ([1, 2, 3], 4, [5]), ([1, 2, 3, 4], 5, [])])
+    , testCase "splits3" $
+        splits3 ((1 :: Int) :| [])
+          @?= (([], 1, []) :| [])
+    , testCase "consNonEmpty" $
+        (consNonEmpty # (from consNonEmpty # (1 :| [2 :: Int .. 5])))
+          @?= (1 :| [2, 3, 4, 5])
+    , testCase "chunkNLen nonempty" $
+        chunkNLen (enumTo1 _3P) _4P [1 :: Int .. 12]
+          @?= Right ((1 :| [2, 3, 4]) :| [5 :| [6, 7, 8], 9 :| [10, 11, 12]])
+    , testCase "chunkNLen nonempty" $
+        chunkNLen (enumTo1 _3P) _4P [1 :: Int .. 13]
+          @?= Left "chunkN': there is still data remaining at eof"
+    , testCase "chunkNLen nonempty" $
+        chunkNLen (enumTo1 _3P) _4P [1 :: Int .. 11]
+          @?= Left "not enough elements: expected 4 found 3"
+    , testCase "chunkNLen list" $
+        chunkNLen (replicate 3 ()) _4P [1 :: Int .. 12]
+          @?= Right [1 :| [2, 3, 4], 5 :| [6, 7, 8], 9 :| [10, 11, 12]]
+    , testCase "chunkNLen list" $
+        chunkNLen (replicate 3 ()) _4P [1 :: Int .. 13] @?= Left "chunkN': there is still data remaining at eof"
+    , testCase "chunkNLen list" $
+        chunkNLen (replicate 3 ()) _4P [1 :: Int .. 11]
+          @?= Left "not enough elements: expected 4 found 3"
+    , testCase "appendL1" $
+        appendL1 [1 :: Int .. 4] (101 :| [102])
+          @?= (1 :| [2, 3, 4, 101, 102])
+    , testCase "appendR1" $
+        appendR1 (101 :| [102]) [1 :: Int .. 4]
+          @?= (101 :| [102, 1, 2, 3, 4])
+    , testCase "appendL1" $
+        appendL1 [] (101 :| [102 :: Int])
+          @?= (101 :| [102])
+    , testCase "appendR1" $
+        appendR1 (101 :| [102 :: Int]) []
+          @?= (101 :| [102])
+    , testCase "iterateMaybe1 even simpler" $
+        iterateMaybe1 (> 0) pred (5 :: Int)
+          @?= (5 :| [4, 3, 2, 1, 0])
+    , testCase "snoc1" $
+        snoc1 [1, 2, 3, 4 :: Int] 999 @?= 1 :| [2, 3, 4, 999]
+    , testCase "snoc1" $
+        snoc1 ([] :: [Int]) 999 @?= 999 :| []
+    , testCase "unsnoc1" $
+        unsnoc1 (1 :| [2, 3, 4, 999]) @?= ([1, 2, 3, 4 :: Int], 999)
+    , testCase "unsnoc1" $
+        unsnoc1 ((999 :: Int) :| []) @?= ([], 999)
+    , testCase "take1" $
+        take1 _1P ('a' :| []) @?= 'a' :| ""
+    , testCase "take1" $
+        take1 _2P ('a' :| []) @?= 'a' :| ""
+    , testCase "take1" $
+        take1 _2P ('a' :| "bc") @?= 'a' :| "b"
+    , testCase "take1" $
+        take1 _3P ('a' :| "bc") @?= 'a' :| "bc"
+    , testCase "splitAts1" $
+        splitAts1 _2P ('a' :| "bcde") @?= ('a' :| "b") :| ['c' :| "d", 'e' :| ""]
+    , testCase "splitAts1" $
+        splitAts1 _2P ('a' :| "") @?= ('a' :| "") :| []
+    , testCase "splitAts1" $
+        splitAts1 _2P ('a' :| "b") @?= ('a' :| "b") :| []
+    , testCase "splitAts1" $
+        splitAts1 _1P ('a' :| "b") @?= ('a' :| "") :| ['b' :| ""]
+    , testCase "lengthExact1" $
+        lengthExact1 _1P ('a' :| "bcdef")
+          @?= Left "GT: too many elements: expected 1"
+    , testCase "lengthExact1" $
+        lengthExact1 _6P ('a' :| "bcdef")
+          @?= Right ('a' :| "bcdef")
+    , testCase "lengthExact1" $
+        lengthExact1 _6P ('a' :| "bcde")
+          @?= Left "LT: not enough elements: expected 6 found 5"
+    , testCase "updateAt1" $
+        updateAt1 _3P (+ 100) (1 :| [2 :: Int .. 5])
+          @?= Just (1 :| [2, 103, 4, 5])
+    , testCase "updateAt1" $
+        updateAt1 _1P (+ 100) (1 :| [2 :: Int .. 5])
+          @?= Just (101 :| [2, 3, 4, 5])
+    , testCase "updateAt1" $
+        updateAt1 _5P (+ 100) (1 :| [2 :: Int .. 5])
+          @?= Just (1 :| [2, 3, 4, 105])
+    , testCase "updateAt1" $
+        updateAt1 _6P (+ 100) (1 :| [2 :: Int .. 5])
+          @?= Nothing
+    , testCase "updateAt1" $
+        updateAt1 _7P (+ 100) (1 :| [2 :: Int .. 5])
+          @?= Nothing
+    , testCase "spanAdjacent1" $
+        spanAdjacent1 (<) (1 :| [2 :: Int, 4, 5, 1, 9, 2, 3])
+          @?= (1 :| [2, 4, 5], [1, 9, 2, 3])
+    , testCase "spanAdjacent1" $
+        spanAdjacent1 (<) (9 :| [8 :: Int, 7, 1])
+          @?= (9 :| [], [8, 7, 1])
+    , testCase "spanAdjacent1" $
+        spanAdjacent1 (<) (9 :| [8 :: Int, 7, 1, 9])
+          @?= (9 :| [], [8, 7, 1, 9])
+    , testCase "spanAdjacent1" $
+        spanAdjacent1 (<) ((9 :: Int) :| [])
+          @?= (9 :| [], [])
+    , testCase "spanAdjacent1" $
+        spanAdjacent1 (<) (9 :| [10 :: Int, 11])
+          @?= (9 :| [10, 11], [])
+    , testCase "spanAdjacent1" $
+        spanAdjacent1 ((==) . (+ 1)) (1 :| [2 :: Int, 3, 4, 5, 6])
+          @?= (1 :| [2, 3, 4, 5, 6], [])
+    , testCase "spanAdjacent1" $
+        spanAdjacent1 ((==) . (+ 1)) (1 :| [2 :: Int, 3, 4, 5, 6, 8])
+          @?= (1 :| [2, 3, 4, 5, 6], [8])
+    , testCase "breakAdjacent1" $
+        breakAdjacent1 (<) (1 :| [2 :: Int, 4, 5, 1, 9, 2, 3])
+          @?= (1 :| [], [2, 4, 5, 1, 9, 2, 3])
+    , testCase "breakAdjacent1" $
+        breakAdjacent1 (<) (9 :| [8 :: Int, 7, 1])
+          @?= (9 :| [8, 7, 1], [])
+    , testCase "breakAdjacent1" $
+        breakAdjacent1 (<) (9 :| [8 :: Int, 7, 1, 9])
+          @?= (9 :| [8, 7, 1], [9])
+    , testCase "breakAdjacent1" $
+        breakAdjacent1 (<) ((9 :: Int) :| [])
+          @?= (9 :| [], [])
+    , testCase "breakAdjacent1" $
+        breakAdjacent1 ((==) . (+ 1)) (1 :| [2 :: Int, 3, 4, 5, 6, 8])
+          @?= (1 :| [], [2, 3, 4, 5, 6, 8])
+    , testCase "breakAdjacent1" $
+        breakAdjacent1 ((==) . (+ 1)) (1 :| [3 :: Int, 5])
+          @?= (1 :| [3, 5], [])
+    , testCase "breakAdjacent1" $
+        breakAdjacent1 ((==) . (+ 1)) (1 :| [3 :: Int, 5, 6])
+          @?= (1 :| [3, 5], [6])
+    , testCase "breakAdjacent1" $
+        splitAt1GE _1P (1 :| [2 :: Int, 3, 4])
+          @?= Right (1 :| [], [2, 3, 4])
+    , testCase "breakAdjacent1" $
+        splitAt1GE _2P (1 :| [2 :: Int, 3, 4])
+          @?= Right (1 :| [2], [3, 4])
+    , testCase "breakAdjacent1" $
+        splitAt1GE _4P (1 :| [2 :: Int, 3, 4])
+          @?= Right (1 :| [2, 3, 4], [])
+    , testCase "breakAdjacent1" $
+        splitAt1GE _5P (1 :| [2 :: Int, 3, 4])
+          @?= Left "not enough elements: expected 5 found 4"
+    , testCase "breakAdjacent1" $
+        splitAt1GE _5P ((1 :: Int) :| [])
+          @?= Left "not enough elements: expected 5 found 1"
+    , testCase "breakAdjacent1" $
+        splitAt1GE _1P ((1 :: Int) :| [])
+          @?= Right (1 :| [], [])
+    , testCase "zipWithExtras" $
+        zipWithExtras (,) ([] :: [Int]) "abcd"
+          @?= ([], MLRRight ('a' :| "bcd"))
+    , testCase "zipWithExtras" $
+        zipWithExtras (,) ("abcd" :: String) ([] :: [Int])
+          @?= ([], MLRLeft ('a' :| "bcd"))
+    , testCase "zipWithExtras" $
+        zipWithExtras (,) ("abcd" :: String) [1, 2, 3, 4 :: Int]
+          @?= ([('a', 1), ('b', 2), ('c', 3), ('d', 4)], MLREqual)
+    , testCase "zipWithExtras" $
+        zipWithExtras (,) ("abcd" :: String) [1, 2, 3 :: Int]
+          @?= ([('a', 1), ('b', 2), ('c', 3)], MLRLeft ('d' :| ""))
+    , testCase "zipWithExtras" $
+        zipWithExtras (,) ("abcd" :: String) [1, 2, 3, 4, 5 :: Int]
+          @?= ([('a', 1), ('b', 2), ('c', 3), ('d', 4)], MLRRight (5 :| []))
+    , testCase "zipWithExtras" $
+        zipWithExtras (,) ([] :: [Int]) ([] :: [()])
+          @?= ([], MLREqual)
+    , testCase "zipWithExtras1" $
+        zipWithExtras1 (,) ((1 :: Int) :| []) ('a' :| "bcd")
+          @?= ((1, 'a') :| [], MLRRight ('b' :| "cd"))
+    , testCase "zipWithExtras1" $
+        zipWithExtras1 (,) ('a' :| "bcd") ((1 :: Int) :| [])
+          @?= (('a', 1) :| [], MLRLeft ('b' :| "cd"))
+    , testCase "zipWithExtras1" $
+        zipWithExtras1 (,) ('a' :| "bcd") (1 :| [2, 3, 4 :: Int])
+          @?= (('a', 1) :| [('b', 2), ('c', 3), ('d', 4)], MLREqual)
+    , testCase "zipWithExtras1" $
+        zipWithExtras1 (,) ('a' :| "bcd") (1 :| [2, 3 :: Int])
+          @?= (('a', 1) :| [('b', 2), ('c', 3)], MLRLeft ('d' :| ""))
+    , testCase "zipWithExtras1" $
+        zipWithExtras1 (,) ('a' :| "bcd") (1 :| [2, 3, 4, 5 :: Int])
+          @?= (('a', 1) :| [('b', 2), ('c', 3), ('d', 4)], MLRRight (5 :| []))
+    , testCase "zipWithExtras1" $
+        zipWithExtras1 (,) ((1 :: Int) :| []) (() :| [])
+          @?= ((1, ()) :| [], MLREqual)
+    , testCase "unfoldrM1" $
+        unfoldrM1 (\s -> Just (take 3 s, boolMaybe (not . null) id (drop 3 s))) [1 :: Int .. 11]
+          @?= Just ([1, 2, 3] :| [[4, 5, 6], [7, 8, 9], [10, 11]])
+    , testCase "span1" $
+        span1 even (2 :| [4 :: Int, 6, 8, 1, 210])
+          @?= These (2 :| [4, 6, 8]) (1 :| [210])
+    , testCase "span1" $
+        span1 even (1 :| [2 :: Int, 4, 6, 8, 1, 210])
+          @?= These (2 :| [4, 6, 8]) (1 :| [1, 210])
+    , testCase "span1" $
+        span1 even (2 :| [4 :: Int, 6, 8])
+          @?= This (2 :| [4, 6, 8])
+    , testCase "span1" $
+        span1 even ((1 :: Int) :| [])
+          @?= That (1 :| [])
+    , testCase "span1" $
+        span1 even (1 :| [3 :: Int, 5])
+          @?= That (1 :| [3, 5])
+    , testCase "partition1" $
+        partition1 even (2 :| [4 :: Int, 6, 8, 1, 210])
+          @?= These (1 :| []) (2 :| [4, 6, 8, 210])
+    , testCase "partition1" $
+        partition1 even (1 :| [2 :: Int, 4, 6, 8, 1, 210])
+          @?= These (1 :| [1]) (2 :| [4, 6, 8, 210])
+    , testCase "partition1" $
+        partition1 even (1 :| [2 :: Int, 3, 4, 5, 6, 7, 8])
+          @?= These (1 :| [3, 5, 7]) (2 :| [4, 6, 8])
+    , testCase "partition1" $
+        partition1 even (2 :| [4 :: Int, 6, 8])
+          @?= That (2 :| [4, 6, 8])
+    , testCase "partition1" $
+        partition1 even ((1 :: Int) :| [])
+          @?= This (1 :| [])
+    , testCase "partition1" $
+        partition1 even (1 :| [3 :: Int, 5])
+          @?= This (1 :| [3, 5])
+    , testCase "at1" $ at1 _1P ('a' :| "ce") @?= Just 'a'
+    , testCase "at1" $ at1 _2P ('a' :| "ce") @?= Just 'c'
+    , testCase "at1" $ at1 _3P ('a' :| "ce") @?= Just 'e'
+    , testCase "at1" $ at1 _4P ('a' :| "ce") @?= Nothing
+    , testCase "at1" $ at1 _1P ('a' :| []) @?= Just 'a'
+    , testCase "updateAt1" $ updateAt1 _1P toUpper ('a' :| "ce") @?= Just ('A' :| "ce")
+    , testCase "updateAt1" $ updateAt1 _2P toUpper ('a' :| "ce") @?= Just ('a' :| "Ce")
+    , testCase "updateAt1" $ updateAt1 _3P toUpper ('a' :| "ce") @?= Just ('a' :| "cE")
+    , testCase "updateAt1" $ updateAt1 _4P toUpper ('a' :| "ce") @?= Nothing
+    , testCase "updateAt1" $ updateAt1 _1P toUpper ('a' :| []) @?= Just ('A' :| [])
+    , testCase "updateAt1" $ updateAt1 _2P toUpper ('a' :| []) @?= Nothing
+    , testCase "lengthP" $ lengthP (2 :| [1 :: Int .. 5]) @?= _6P
+    , testCase "unitsF" $ unitsF @[] _4P @?= [(), (), (), ()]
+    , testCase "unitsF" $ unitsF @NonEmpty _4P @?= (() :| [(), (), ()])
+    ]
diff --git a/test/TestNum1.hs b/test/TestNum1.hs
new file mode 100644
--- /dev/null
+++ b/test/TestNum1.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module TestNum1 where
+
+import Data.Pos
+import Data.Word
+import GHC.Natural
+import Primus.Num1
+import Test.Tasty
+import Test.Tasty.HUnit
+
+doit :: IO ()
+doit = defaultMain suite
+
+suite :: TestTree
+suite =
+  testGroup
+    "TestNum1"
+    [ testCase "Num1" $
+        fromInteger1 @Natural 0 (-100)
+          @?= Left "Natural: undefined for negative numbers -100"
+    , testCase "Num1" $ withOp2 @Natural (*) 4 5 @?= Right 20
+    , testCase "Num1" $ withOp2 @Natural (*) 9 0 @?= Right 0
+    , testCase "Num1" $ withOp2 @Natural (-) 7 5 @?= Right 2
+    , testCase "Num1" $ withOp2 @Natural (-) 5 5 @?= Right 0
+    , testCase "Num1" $
+        withOp2 @Natural (-) 4 5
+          @?= Left "Natural: undefined for negative numbers -1"
+    , testCase "pred1" $
+        pred1 @Natural (pure 0)
+          @?= Left "pred1:Natural: undefined for negative numbers -1"
+    , testCase "pred1" $
+        pred1 @Natural (pure 2)
+          @?= Right 1
+    , testCase "succ1" $
+        succ1 @Natural (pure 1)
+          @?= Right 2
+    , testCase "withOp" $
+        withOp @Natural (subtract 9) 2
+          @?= Left "Natural: undefined for negative numbers -7"
+    , testCase "withOp" $
+        withOp @Natural (subtract 9) 14
+          @?= Right 5
+    , testCase "fromInteger1" $
+        fromInteger1 _10P 0
+          @?= Left "integerToEnumSafe:underflow where 0 not in range [1..9223372036854775807]"
+    , testCase "withOp2" $ withOp2 (*) _1P _5P @?= Right _5P
+    , testCase "withOp2" $ withOp2 (*) _1P _1P @?= Right _1P
+    , testCase "withOp2" $ withOp2 (*) _1P _2P @?= Right _2P
+    , testCase "withOp2" $ withOp2 ((-) . (+ 1)) _5P _5P @?= Right _1P
+    , testCase "withOp2" $ withOp2 ((-) . (+ 1)) _5P _5P @?= Right _1P
+    , testCase "withOp2" $ withOp2 (-) _7P _5P @?= Right _2P
+    , testCase "withOp2" $
+        withOp2 (-) _5P _5P
+          @?= Left "integerToEnumSafe:underflow where 0 not in range [1..9223372036854775807]"
+    , testCase "withOp2" $
+        withOp2 (-) _5P _13P
+          @?= Left "integerToEnumSafe:underflow where -8 not in range [1..9223372036854775807]"
+    , testCase "withOp2" $
+        withOp2 (-) (_P @333) (_P @1234)
+          @?= Left "integerToEnumSafe:underflow where -901 not in range [1..9223372036854775807]"
+    , testCase "pred1" $
+        pred1 (pure _1P)
+          @?= Left "pred1:integerToEnumSafe:underflow where 0 not in range [1..9223372036854775807]"
+    , testCase "pred1" $
+        pred1 (pure _2P)
+          @?= Right _1P
+    , testCase "succ1" $
+        succ1 (pure _1P)
+          @?= Right _2P
+    , testCase "withOp" $
+        withOp (subtract 9) _2P
+          @?= Left "integerToEnumSafe:underflow where -7 not in range [1..9223372036854775807]"
+    , testCase "withOp" $
+        withOp (subtract 9) _14P
+          @?= Right _5P
+    , testCase "withOp2" $
+        withOp2 ((-) . (+ 1)) (100 :: Word8) (113 :: Word8)
+          @?= Left "integerToEnumSafe:underflow where -12 not in range [0..255]"
+    , testCase "withOp2" $
+        fromInteger1 (100 :: Word8) 2000
+          @?= Left "integerToEnumSafe:overflow where 2000 not in range [0..255]"
+    , testCase "withOp2" $
+        fromInteger1 (100 :: Word8) 122
+          @?= Right @_ @Word8 122
+    ]
diff --git a/test/TestZipNonEmpty.hs b/test/TestZipNonEmpty.hs
new file mode 100644
--- /dev/null
+++ b/test/TestZipNonEmpty.hs
@@ -0,0 +1,64 @@
+{-# OPTIONS -Wno-orphans #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module TestZipNonEmpty where
+
+import Data.Foldable
+import qualified Data.List.NonEmpty as N
+import qualified Data.Monoid as MM
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+import "checkers" Test.QuickCheck.Classes
+import Test.Tasty
+import Primus.ZipNonEmpty
+import qualified Test.Tasty.QuickCheck as TQ
+
+argsVerbose :: Args
+argsVerbose = stdArgs{maxSuccess = 500, chatty = True}
+
+instance Arbitrary a => Arbitrary (ZipNonEmpty a) where
+  -- arbitrary = ((ZipNonEmpty .) . (:|)) <$> arbitrary <*> arbitrary
+  arbitrary = ZipNonEmpty . N.fromList <$> listOf1 arbitrary
+
+instance Eq a => EqProp (ZipNonEmpty a) where (=-=) = eq
+
+testLawsZipNonEmpty :: [TestBatch]
+testLawsZipNonEmpty =
+  [functor z, semigroup (z, Fixed (10 :: Int)), foldable z1] -- , traversable z]
+ where
+  z = undefined :: ZipNonEmpty (MM.Sum Integer, String, MM.Sum Int)
+  z1 = undefined :: ZipNonEmpty (String, Integer, String, Int, Bool)
+
+testLawsZipNonEmptyIO :: IO ()
+testLawsZipNonEmptyIO = do
+  traverse_ verboseBatch testLawsZipNonEmpty
+{-
+doit :: IO ()
+doit = defaultMain suite
+
+suite :: TestTree
+suite =
+  testGroup
+    "TestZipNonEmpty"
+    []
+-}
+suiteCheckers :: TestTree
+suiteCheckers =
+  testGroup
+    "TestZipNonEmpty Checkers"
+    [ adj' False 100 1000 10 $ TQ.testProperties "ZipNonEmpty" (checkersToProps testLawsZipNonEmpty)
+    ]
+
+checkersToProps :: [TestBatch] -> [(String, Property)]
+checkersToProps = concatMap (\(a, bs) -> map (\(x, y) -> (a ++ " " ++ x, y)) bs)
+
+adj' :: Bool -> Int -> Int -> Int -> TestTree -> TestTree
+adj' v sz n ratio =
+  adjustOption (const $ TQ.QuickCheckMaxSize sz)
+    . adjustOption (max $ TQ.QuickCheckTests n)
+    . adjustOption (max $ TQ.QuickCheckMaxRatio ratio)
+    . adjustOption (const (TQ.QuickCheckVerbose v))