packages feed

primus 0.2.0.0 → 0.3.0.0

raw patch · 15 files changed

+181/−67 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Primus.Lens: type Iso' s a = Iso s s a a
+ Primus.List: list :: b -> (a -> [a] -> b) -> [a] -> b
+ Primus.List: list' :: [a] -> b -> (a -> [a] -> b) -> b
+ Primus.List: listSnoc :: b -> ([a] -> a -> b) -> [a] -> b
+ Primus.List: unsnocL' :: a -> [a] -> ([a], a)
+ Primus.NonEmpty: nonempty :: (a -> [a] -> b) -> NonEmpty a -> b
+ Primus.NonEmpty: nonempty' :: NonEmpty a -> (a -> [a] -> b) -> b
+ Primus.NonEmpty: nonemptySnoc :: ([a] -> a -> b) -> NonEmpty a -> b
+ Primus.Num1: instance Primus.Num1.Num1 GHC.Types.Word
- Primus.Fold: compareLengths :: Foldable t => NonEmpty (t a) -> [CLCount a]
+ Primus.Fold: compareLengths :: forall a b t u. (Foldable t, Foldable u) => t a -> [u b] -> [CLCount b]
- Primus.List: unsnocL :: a -> [a] -> ([a], a)
+ Primus.List: unsnocL :: [a] -> Maybe ([a], a)

Files

primus.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           primus-version:        0.2.0.0+version:        0.3.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
src/Primus/Enum.hs view
@@ -136,16 +136,16 @@  -- | 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+capacity (length -> len) = lmsg "capacity" $ 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+    GT -> Left $ "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+    GT -> Left $ "unsupported mx < 0: " ++ show z   pure (lhs, rhs)  {- | convert toEnum of "a" into a list containing "a"s
src/Primus/Error.hs view
@@ -29,6 +29,7 @@    -- * decorate an error   lmsg,+   -- * miscellaneous   (.@), ) where
src/Primus/Fold.hs view
@@ -148,7 +148,7 @@   ([a] -> [a] -> a -> b) ->   t a ->   t b-histMapImpl' isright f = snd . bool histMapL histMapR isright g ()+histMapImpl' isright f = snd . histMapImpl isright g ()  where   g :: [a] -> [a] -> () -> a -> ((), b)   g ps ft () a = ((), f ps ft a)@@ -314,8 +314,12 @@   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+compareLengths :: forall a b t u+  . (Foldable t,Foldable u)+  => t a+  -> [u b]+  -> [CLCount b]+compareLengths xs = map (compareLengthBy mempty xs)  -- | compare length where lhs or rhs can be infinite but not both compareLength ::
src/Primus/Lens.hs view
@@ -10,6 +10,7 @@   Lens',   lens,   Iso,+  Iso',   iso,   Traversal,   _Fst,@@ -21,7 +22,7 @@ -- | lens type synonym type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t --- | restricted lens type synonym+-- | simpler lens type synonym type Lens' s a = Lens s s a a  -- | create a lens@@ -32,6 +33,9 @@ -- | isomorphism type synonym type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t) +-- | simpler isomorphism type synonym+type Iso' s a = Iso s s a a+ -- | create an isomoprhism iso :: (s -> a) -> (b -> t) -> Iso s t a b iso sa bt = dimap sa (fmap bt)@@ -40,12 +44,12 @@ -- | 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+-- | 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+-- | 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 #-}
src/Primus/List.hs view
@@ -47,6 +47,10 @@   allEqualBy,   snocL,   unsnocL,+  unsnocL',+    list,+    list',+  listSnoc, ) where  import Control.Arrow@@ -117,7 +121,7 @@ -- | 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)))+  | n < 0 = (xs, SplitLNeg (unsafePos "splitAtL" (-n)))   | otherwise = go 0 xs  where   go :: Int -> [a] -> ([a], SplitL a)@@ -241,13 +245,31 @@     [] -> pure mempty     a : as -> (\b -> bool first second b (a :)) <$> f a <*> go as +-- | break up a list into cases using cons+list :: b -> (a -> [a] -> b) -> [a] -> b+list z s = \case+  [] -> z+  a:as -> s a as++-- | break up a list into cases using cons+list' :: [a] -> b -> (a -> [a] -> b) -> b+list' as z s = list z s as++-- | break up a list into cases using snoc+listSnoc :: b -> ([a] -> a -> b) -> [a] -> b+listSnoc z s = maybe z (uncurry s) . unsnocL+ -- | snoc for a list snocL :: [a] -> a -> [a] snocL as a = as ++ [a] +-- | unsnoc for a list+unsnocL :: [a] -> Maybe ([a], a)+unsnocL = list Nothing (Just .@ unsnocL')+ -- | unsnoc for a value and a list-unsnocL :: a -> [a] -> ([a], a)-unsnocL a =+unsnocL' :: a -> [a] -> ([a], a)+unsnocL' a =   \case     [] -> ([], a)-    x : xs -> first (a :) (unsnocL x xs)+    x : xs -> first (a :) (unsnocL' x xs)
src/Primus/NonEmpty.hs view
@@ -93,6 +93,10 @@   findDupsBy,   replicate1,   replicate1M,++  nonemptySnoc,+  nonempty,+  nonempty', ) where  import Control.Arrow@@ -161,7 +165,7 @@ 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'+{- | creates a nonempty container of length "sz" with chunks of a given size: see 'chunkNLen'  must fill the container exactly -} chunkNLen1 ::@@ -312,6 +316,15 @@   go :: a -> [a] -> ([a], a)   go n [] = ([], n)   go n (x : xs) = first (n :) (go x xs)++nonempty :: (a -> [a] -> b) -> NonEmpty a -> b+nonempty f (a:|as) = f a as++nonempty' :: NonEmpty a -> (a -> [a] -> b) -> b+nonempty' = flip nonempty++nonemptySnoc :: ([a] -> a -> b) -> NonEmpty a -> b+nonemptySnoc f = uncurry f . unsnoc1  -- | uncons for a nonempty list uncons1 :: forall a. NonEmpty a -> (a, [a])
src/Primus/Num1.hs view
@@ -92,14 +92,12 @@     | otherwise = Right $ naturalFromInteger i  instance Num1 Pos-+instance Num1 Word instance Num1 Word8 instance Num1 Word16 instance Num1 Word32 instance Num1 Word64- instance Num1 Int- instance Num1 Int8 instance Num1 Int16 instance Num1 Int32
src/Primus/TypeLevel.hs view
@@ -138,7 +138,7 @@ -- | unsnoc a type level nonempty list type UnsnocT :: forall k. [k] -> ([k], k) type family UnsnocT ns where-  UnsnocT '[] = GL.TypeError ('GL.Text "UnsnocT: undefined for empty indices")+  UnsnocT '[] = GL.TypeError ( 'GL.Text "UnsnocT: undefined for empty indices")   UnsnocT '[a] = '( '[], a)   UnsnocT (a ': a1 ': as) = FirstConsT a (UnsnocT (a1 ': as))
test/Main.hs view
@@ -10,8 +10,8 @@ import qualified TestList import qualified TestNonEmpty import qualified TestNum1-import qualified TestZipNonEmpty import qualified TestTypeLevel+import qualified TestZipNonEmpty  main :: IO () main = do
test/TestEnum.hs view
@@ -206,10 +206,10 @@           @?= Right (-35723051648, 34359738367)     , testCase "capacity" $         capacity @NegOnly []-          @?= Left "capacity: unsupported mx < 0: (-3,-1)"+          @?= Left "capacity:unsupported mx < 0: (-3,-1)"     , testCase "capacity" $         capacity @PosOnly ['x']-          @?= Left "capacity: unsupported mn > 0: (1,3)"+          @?= Left "capacity:unsupported mn > 0: (1,3)"     , testCase "universeTraversable" $         universeTraversable [EQ]           @?= Right ([LT] :| [[EQ], [GT]])
test/TestFold.hs view
@@ -95,7 +95,7 @@         compareLength ('a' :| ['b' .. 'g']) [100 :: Int .. 106]           @?= CEQ     , testCase "compareLengths" $-        compareLengths ([1 :: Int .. 5] :| [[101 .. 110], [201 .. 205], [301 .. 302], [], [1001 .. 1020]])+        compareLengths @Int @Int [1 .. 5] [[101 .. 110], [201 .. 205], [301 .. 302], [], [1001 .. 1020]]           @?= [ CLT (106 :| [107, 108, 109, 110])               , CEQ               , CGT@@ -103,10 +103,32 @@               , CLT (1006 :| [1007, 1008, 1009, 1010, 1011, 1012, 1013, 1014, 1015, 1016, 1017, 1018, 1019, 1020])               ]     , testCase "compareLengths" $-        compareLengths ([1 :: Int .. 5] :| [[101 .. 110]])+        compareLengths @Char @Int ['a' .. 'z'] [[101 .. 110], [201 .. 205], [301 .. 302], [], [1001 .. 1020]]+          @?= [CGT,CGT,CGT,CGT,CGT]+    , testCase "compareLengths" $+        compareLengths @Char @Int ['a' .. 'd'] [[101 .. 104], [201 .. 204], [301 .. 302], [], [1001 .. 1010]]+          @?= [ CEQ+              , CEQ+              , CGT+              , CGT+              , CLT (1005 :| [1006,1007,1008,1009,1010])+              ]++    , testCase "compareLengths" $+        compareLengths @Char @Int ['a' .. 'd'] [[101 .. 110], [201 .. 205], [301 .. 302], [], [1001 .. 1010]]+          @?=+             [ CLT (105 :| [106,107,108,109,110])+             , CLT (205 :| [])+             , CGT+             , CGT+             , CLT (1005 :| [1006,1007,1008,1009,1010])+             ]++    , testCase "compareLengths" $+        compareLengths @Int @Int [1 .. 5] [[101 .. 110]]           @?= [CLT (106 :| [107 .. 110])]     , testCase "compareLengths" $-        compareLengths ([1 :: Int .. 5] :| [])+        compareLengths @Int @Int @_ @[] [1 .. 5] []           @?= []     , testCase "compareLength infinite lhs" $         compareLength [1 :: Int ..] ['a' .. 'f']
test/TestList.hs view
@@ -94,4 +94,12 @@               , 13               ]               )+    , testCase "list" $+       list 'x' undefined ([] :: [()]) @?= 'x'+    , testCase "listSnoc" $+       listSnoc 'x' undefined ([] :: [()]) @?= 'x'+    , testCase "list" $+       list undefined (,) [1::Int ..5] @?= (1,[2..5])+    , testCase "listSnoc" $+       listSnoc undefined (,) [1::Int ..5] @?= ([1,2,3,4],5)     ]
test/TestNum1.hs view
@@ -8,6 +8,7 @@  import Data.Pos import Data.Word+import Data.Int import GHC.Natural import Primus.Num1 import Test.Tasty@@ -87,4 +88,45 @@     , testCase "withOp2" $         fromInteger1 (100 :: Word8) 122           @?= Right @_ @Word8 122+    , testCase ".-" $+        (Right _4P .- Right _3P) @?= Right _1P+    , testCase ".-" $+        (Right _4P .- Right _4P) @?= Left "(.-):integerToEnumSafe:underflow where 0 not in range [1..9223372036854775807]"+    , testCase ".-" $+        (Right _4P .- Right _13P) @?= Left "(.-):integerToEnumSafe:underflow where -9 not in range [1..9223372036854775807]"+    , testCase ".- .* .+" $+        (Right _2P .* Right _20P .+ Right _4P .- Right (_P @42)) @?= Right _2P+    , testCase "abs1" $+        negate1 (Right _19P) @?= Left "negate1:integerToEnumSafe:underflow where -19 not in range [1..9223372036854775807]"+    , testCase "abs1" $+        abs1 (Right _1P) @?= Right _1P+    , testCase "abs1" $+        abs1 (Right _5P) @?= Right _5P+    , testCase "signum1" $+        signum1 (Right _19P) @?= Right _1P+    , testCase "negate1" $+        negate1 (Right _2P) @?= Left "negate1:integerToEnumSafe:underflow where -2 not in range [1..9223372036854775807]"++    , testCase "negate1" $+        negate1 (Right @_ @Word8 0) @?= Right 0+    , testCase "abs1" $+        abs1 (Right @_ @Word8 14) @?= Right 14+    , testCase "signum1" $+        signum1 (Right @_ @Word8 14) @?= Right 1+    , testCase "signum1" $+        signum1 (Right @_ @Word8 0) @?= Right 0++    , testCase "negate1" $+        negate1 (Right @_ @Int8 14) @?= Right (-14)+    , testCase "negate1" $+        negate1 (Right @_ @Int8 0) @?= Right 0+    , testCase "abs1" $+        negate1 (Right @_ @Int8 (-14)) @?= Right 14+    , testCase "signum1" $+        signum1 (Right @_ @Int8 (-14)) @?= Right (-1)+    , testCase "signum1" $+        signum1 (Right @_ @Int8 0) @?= Right 0+    , testCase "signum1" $+        signum1 (Right @_ @Int8 14) @?= Right 1+     ]
test/TestTypeLevel.hs view
@@ -1,42 +1,42 @@-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-
-module TestTypeLevel where
-
-import Primus.TypeLevel
-import Data.List.NonEmpty (NonEmpty(..))
-import Test.Tasty
-import Data.Pos
-import Test.Tasty.HUnit
-
-doit :: IO ()
-doit = defaultMain suite
-
-suite :: TestTree
-suite =
-  testGroup
-    "TestTypeLevel"
-    [ testCase "LengthT" $
-        pnat @(LengthT '[]) @?= 0
-    , testCase "LengthT" $
-        pnat @(LengthT '[ 1,2,3]) @?= 3
-    , testCase "LengthT" $
-        pnat @(LengthT '[ 1,2,3,4,5,6,7,8,9,10]) @?= 10
-    , testCase "LengthT" $
-        pnat @(LengthT '[ 1,2,3,4,5,6,7,8,9,10,11]) @?= 11
-    , testCase "LengthT" $
-        pnat @(LengthT '[ 1,2,3,4,5,6,7,8,9]) @?= 9
-    , testCase "LastT" $
-        pnat @(LastT '[ 1,2,3]) @?= 3
-    , testCase "InitT" $
-        fromNSP @(InitT '[ 1,2,3]) @?= _1P :| [_2P]
-    , testCase "SnocT" $
-        fromNSP @(SnocT '[ 1,2,3] 5) @?= _1P :| [_2P,_3P,_5P]
-    , testCase "UnsnocT Fst" $
-        fromNSP @(Fst (UnsnocT '[ 1,2,3,4])) @?= _1P :| [_2P,_3P]
-    , testCase "UnsnocT Snd" $
-        fromNP @(Snd (UnsnocT '[ 1,2,3,4])) @?= _4P
-    ]
+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module TestTypeLevel where++import Data.List.NonEmpty (NonEmpty (..))+import Data.Pos+import Primus.TypeLevel+import Test.Tasty+import Test.Tasty.HUnit++doit :: IO ()+doit = defaultMain suite++suite :: TestTree+suite =+  testGroup+    "TestTypeLevel"+    [ testCase "LengthT" $+        pnat @(LengthT '[]) @?= 0+    , testCase "LengthT" $+        pnat @(LengthT '[1, 2, 3]) @?= 3+    , testCase "LengthT" $+        pnat @(LengthT '[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]) @?= 10+    , testCase "LengthT" $+        pnat @(LengthT '[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11]) @?= 11+    , testCase "LengthT" $+        pnat @(LengthT '[1, 2, 3, 4, 5, 6, 7, 8, 9]) @?= 9+    , testCase "LastT" $+        pnat @(LastT '[1, 2, 3]) @?= 3+    , testCase "InitT" $+        fromNSP @(InitT '[1, 2, 3]) @?= _1P :| [_2P]+    , testCase "SnocT" $+        fromNSP @(SnocT '[1, 2, 3] 5) @?= _1P :| [_2P, _3P, _5P]+    , testCase "UnsnocT Fst" $+        fromNSP @(Fst (UnsnocT '[1, 2, 3, 4])) @?= _1P :| [_2P, _3P]+    , testCase "UnsnocT Snd" $+        fromNP @(Snd (UnsnocT '[1, 2, 3, 4])) @?= _4P+    ]