haskus-utils-data 1.2 → 1.3

raw patch · 5 files changed

+220/−16 lines, 5 filesdep −extraPVP ok

version bump matches the API change (PVP)

Dependencies removed: extra

API changes (from Hackage documentation)

Files

• haskus-utils-data.cabal +3/−4
• src/lib/Haskus/Utils/Either.hs +0/−2
• src/lib/Haskus/Utils/List.hs +111/−8
• src/lib/Haskus/Utils/Monad.hs +96/−2
• src/lib/Haskus/Utils/Tuple.hs +10/−0

@@ -1,5 +1,5 @@ name:                haskus-utils-data-version:             1.2+version:             1.3 synopsis:            Haskus data utility modules license:             BSD3 license-file:        LICENSE@@ -16,7 +16,7 @@  source-repository head   type: git-  location: git://github.com/haskus/haskus-utils.git+  location: git://github.com/haskus/packages.git  library   exposed-modules:@@ -34,9 +34,8 @@   other-modules:    build-depends:       -     base                       >= 4.9 && < 5+     base                       >= 4.12 && < 5    , haskus-utils-types         >= 1.5-   , extra                      >= 1.4    , recursion-schemes          >= 5.0    , containers                 >= 0.5    , mtl                        >= 2.2

@@ -1,8 +1,6 @@ module Haskus.Utils.Either    ( module Data.Either-   , module Data.Either.Extra    ) where  import Data.Either-import Data.Either.Extra

@@ -25,13 +25,11 @@    , L.tail    , L.zipWith    , L.repeat-   , L.nubOn+   , nubOn    , L.nubBy    , L.sortOn    , L.sortBy-   , L.split-   , L.splitOn-   , L.groupOn+   , groupOn    , L.groupBy    , L.transpose    , (L.\\)@@ -48,13 +46,19 @@    , L.isSuffixOf    , L.elem    , L.notElem+   -- * Split+   , splitAt+   , split+   , splitOn+   , breakOn    ) where -import Prelude hiding (replicate, length, drop, take)+import Prelude hiding (replicate, length, drop, take,splitAt) +import Data.Bifunctor+import Data.Function (on) import qualified Data.List as L-import qualified Data.List.Extra as L  -- | Safely index into a list --@@ -106,11 +110,29 @@ drop :: Word -> [a] -> [a] drop n = L.drop (fromIntegral n) +-- | Apply some operation repeatedly, producing an element of output+--   and the remainder of the list.+repeatedly :: ([a] -> (b, [a])) -> [a] -> [b]+repeatedly _ [] = []+repeatedly f as = b : repeatedly f as'+    where (b, as') = f as+ -- | Split a list into chunks of a given size. The last chunk may contain fewer -- than n elements.+--+-- >>> chunksOf 3 "my test"+-- ["my ","tes","t"]+--+-- >>> chunksOf 3 "mytest"+-- ["myt","est"]+--+-- >>> chunksOf 8 ""+-- []+--+-- >> chunksOf 0 "test"+-- undefined chunksOf :: Word -> [a] -> [[a]]-chunksOf n = L.chunksOf (fromIntegral n)-+chunksOf i xs = repeatedly (splitAt i) xs  -- | Pick each element and return the element and the rest of the list --@@ -144,3 +166,84 @@ -- [(0,False),(1,True),(2,False),(3,True),(4,False),(5,True)] zipRightWith :: (a -> b) -> [a] -> [(a,b)] zipRightWith f xs = xs `zip` fmap f xs+++-- | A version of 'nub' where the equality is done on some extracted value.+--   @nubOn f@ is equivalent to @nubBy ((==) `on` f)@, but has the+--   performance advantage of only evaluating @f@ once for each element in the+--   input list.+nubOn :: Eq b => (a -> b) -> [a] -> [a]+nubOn f = map snd . L.nubBy ((==) `on` fst) . map (\x -> let y = f x in y `seq` (y, x))+++-- | A version of 'group' where the equality is done on some extracted value.+groupOn :: Eq b => (a -> b) -> [a] -> [[a]]+groupOn f = L.groupBy ((==) `on2` f)+    -- redefine on so we avoid duplicate computation for most values.+    where (.*.) `on2` g = \x -> let fx = g x in \y -> fx .*. g y++---------------------------------------+-- Split+---------------------------------------++-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of+-- length @n@ and second element is the remainder of the list:+--+-- > splitAt 6 "Hello World!" == ("Hello ","World!")+-- > splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5])+-- > splitAt 1 [1,2,3] == ([1],[2,3])+-- > splitAt 3 [1,2,3] == ([1,2,3],[])+-- > splitAt 4 [1,2,3] == ([1,2,3],[])+-- > splitAt 0 [1,2,3] == ([],[1,2,3])+-- > splitAt (-1) [1,2,3] == ([],[1,2,3])+--+-- It is equivalent to @('take' n xs, 'drop' n xs)@ when @n@ is not @_|_@+-- (@splitAt _|_ xs = _|_@).+splitAt :: Integral n => n -> [a] -> ([a],[a])+splitAt n xs = L.genericSplitAt n xs++-- | Break a list into pieces separated by the first+-- list argument, consuming the delimiter. An empty delimiter is+-- invalid, and will cause an error to be raised.+--+-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]+-- > splitOn "aaa"  "aaaXaaaXaaaXaaa"  == ["","X","X","X",""]+-- > splitOn "x"    "x"                == ["",""]+-- > splitOn "x"    ""                 == [""]+-- > \s x -> s /= "" ==> intercalate s (splitOn s x) == x+-- > \c x -> splitOn [c] x                           == split (==c) x+splitOn :: (Eq a) => [a] -> [a] -> [[a]]+splitOn [] _ = error "splitOn, needle may not be empty"+splitOn _ [] = [[]]+splitOn needle haystack = a : if null b then [] else splitOn needle $ drop (length needle) b+    where (a,b) = breakOn needle haystack+++-- | Splits a list into components delimited by separators,+-- where the predicate returns True for a separator element.  The+-- resulting components do not contain the separators.  Two adjacent+-- separators result in an empty component in the output.+--+-- > split (== 'a') "aabbaca" == ["","","bb","c",""]+-- > split (== 'a') ""        == [""]+-- > split (== ':') "::xyz:abc::123::" == ["","","xyz","abc","","123","",""]+-- > split (== ',') "my,list,here" == ["my","list","here"]+split :: (a -> Bool) -> [a] -> [[a]]+split _ [] = [[]]+split f (x:xs) | f x                   = [] : split f xs+split f (x:xs) | ~(y:ys) <- split f xs = (x:y) : ys++-- | Find the first instance of @needle@ in @haystack@.+-- The first element of the returned tuple+-- is the prefix of @haystack@ before @needle@ is matched.  The second+-- is the remainder of @haystack@, starting with the match.+-- If you want the remainder /without/ the match, use 'stripInfix'.+--+-- > breakOn "::" "a::b::c" == ("a", "::b::c")+-- > breakOn "/" "foobar"   == ("foobar", "")+-- > \needle haystack -> let (prefix,match) = breakOn needle haystack in prefix ++ match == haystack+breakOn :: Eq a => [a] -> [a] -> ([a], [a])+breakOn needle haystack+   | needle `L.isPrefixOf` haystack = ([], haystack)+breakOn _      []                   = ([], [])+breakOn needle (x:xs)               = first (x:) $ breakOn needle xs

@@ -1,20 +1,30 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE LambdaCase #-}  -- | Utils for Monads module Haskus.Utils.Monad    ( MonadInIO (..)    , module Control.Monad    , module Control.Monad.IO.Class-   , module Control.Monad.Extra    , module Control.Monad.Trans.Class+   , whileM+   , loop+   , loopM+   , whenM+   , unlessM+   , ifM+   , notM+   , anyM+   , allM+   , orM+   , andM    ) where  import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad-import Control.Monad.Extra import Control.Monad.State  class MonadIO m => MonadInIO m where@@ -41,3 +51,87 @@    liftWith2 wth f =       StateT $ \s ->          liftWith2 wth (\a b -> runStateT (f a b) s)++-- | Keep running an operation until it becomes 'False'. As an example:+--+-- @+-- whileM $ do sleep 0.1; notM $ doesFileExist "foo.txt"+-- readFile "foo.txt"+-- @+--+--   If you need some state persisted between each test, use 'loopM'.+whileM :: Monad m => m Bool -> m ()+whileM act = do+    b <- act+    when b $ whileM act++-- Looping++-- | A looping operation, where the predicate returns 'Left' as a seed for the next loop+--   or 'Right' to abort the loop.+--+-- > loop (\x -> if x < 10 then Left $ x * 2 else Right $ show x) 1 == "16"+loop :: (a -> Either a b) -> a -> b+loop act x = case act x of+    Left x' -> loop act x'+    Right v -> v++-- | A monadic version of 'loop', where the predicate returns 'Left' as a seed for the next loop+--   or 'Right' to abort the loop.+loopM :: Monad m => (a -> m (Either a b)) -> a -> m b+loopM act x = act x >>= \case+   Left x' -> loopM act x'+   Right v -> return v+++-- | Like 'when', but where the test can be monadic.+whenM :: Monad m => m Bool -> m () -> m ()+whenM b t = ifM b t (return ())++-- | Like 'unless', but where the test can be monadic.+unlessM :: Monad m => m Bool -> m () -> m ()+unlessM b f = ifM b (return ()) f++-- | Like @if@, but where the test can be monadic.+ifM :: Monad m => m Bool -> m a -> m a -> m a+ifM mb t f = do+   b <- mb+   if b then t else f++-- | Like 'not', but where the test can be monadic.+notM :: Functor m => m Bool -> m Bool+notM = fmap not++-- | A version of 'any' lifted to a monad. Retains the short-circuiting behaviour.+--+-- > anyM Just [False,True ,undefined] == Just True+-- > anyM Just [False,False,undefined] == undefined+-- > \(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs)+anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool+anyM _ []     = return False+anyM p (x:xs) = ifM (p x) (return True) (anyM p xs)++-- | A version of 'all' lifted to a monad. Retains the short-circuiting behaviour.+--+-- > allM Just [True,False,undefined] == Just False+-- > allM Just [True,True ,undefined] == undefined+-- > \(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs)+allM :: Monad m => (a -> m Bool) -> [a] -> m Bool+allM _ []     = return True+allM p (x:xs) = ifM (p x) (allM p xs) (return False)++-- | A version of 'or' lifted to a monad. Retains the short-circuiting behaviour.+--+-- > orM [Just False,Just True ,undefined] == Just True+-- > orM [Just False,Just False,undefined] == undefined+-- > \xs -> Just (or xs) == orM (map Just xs)+orM :: Monad m => [m Bool] -> m Bool+orM = anyM id++-- | A version of 'and' lifted to a monad. Retains the short-circuiting behaviour.+--+-- > andM [Just True,Just False,undefined] == Just False+-- > andM [Just True,Just True ,undefined] == undefined+-- > \xs -> Just (and xs) == andM (map Just xs)+andM :: Monad m => [m Bool] -> m Bool+andM = allM id

@@ -12,7 +12,12 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE CPP #-} +#if MIN_VERSION_base(4,14,0)+{-# LANGUAGE StandaloneKindSignatures #-}+#endif+ -- | Tuple helpers module Haskus.Utils.Tuple    ( uncurry3@@ -515,7 +520,12 @@ -- | Unboxed tuple -- -- TODO: put this family into GHC+#if MIN_VERSION_base(4,14,0)+type Tuple# :: forall xs -> TYPE ('TupleRep (TypeReps xs))+type family Tuple# xs = t | t -> xs where+#else type family Tuple# xs = (t :: TYPE ('TupleRep (TypeReps xs))) | t -> xs where+#endif    Tuple# '[]                  = (##)    Tuple# '[a]                 = (# a #)    Tuple# '[a,b]               = (# a,b #)