packages feed

util-plus (empty) → 0.1.0.0

raw patch · 12 files changed

+764/−0 lines, 12 filesdep +HTFdep +QuickCheckdep +arraysetup-changed

Dependencies added: HTF, QuickCheck, array, base, containers, hashable, safe, unordered-containers, util-plus

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright factis research GmbH (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Alexander Thiemann nor the names of other+      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+OWNER 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.
+ README.md view
@@ -0,0 +1,5 @@+# A collection of commonly used utils++[![CircleCI](https://circleci.com/gh/factisresearch/opensource-mono.svg?style=svg)](https://circleci.com/gh/factisresearch/opensource-mono)++This package contains utility functions for data types of basic libraries and common general purpose combinators.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Control/Applicative/Plus.hs view
@@ -0,0 +1,36 @@+module Control.Applicative.Plus+    ( withOptional+    , optional'+    , module Control.Applicative+    )+where++import Control.Applicative+import Control.Monad+import qualified Data.Foldable as F++{-# SPECIALIZE+       withOptional :: (a -> (b -> m c) -> m c) -> Maybe a -> (Maybe b -> m c) -> m c+ #-}+withOptional ::+    (Foldable t, Alternative t)+    => (a -> (b -> m c) -> m c)+    -> t a+    -> (t b -> m c)+    -> m c+withOptional withReq wrappedVal go =+    do let runAction =+               flip fmap wrappedVal $ \val ->+               withReq val $ \inner -> go (pure inner)+           emptyCase = go empty+           actionOrEmptyCase =+               F.foldl' (\_ a -> a) emptyCase runAction+       actionOrEmptyCase++-- | A generalized version of 'optional' that works with 'Option' for example+optional' :: (MonadPlus t, Alternative f) => f a -> f (t a)+optional' x =+    flip fmap (optional x) $ \val ->+    case val of+      Just ok -> pure ok+      Nothing -> empty
+ src/Data/List/Plus.hs view
@@ -0,0 +1,233 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.List.Plus+    ( module Data.List+    , catMaybes+    , chunksOf+    , extractLast+    , groupOn+    , groupOn'+    , groupOnSort+    , groupOnSort'+    , groupBySort+    , groupUnsortedOn+    , headM+    , lastElems+    , lastM+    , lookupM+    , makeMapping+    , mapMaybe+    , maximumM+    , merge+    , middle+    , minimumM+    , monotone+    , nubMerge+    , prefixesAndSuffixes+    , sconcatBy+    , spanTailRec+    , stripSuffix+    , tryStripPrefix+    , ungroupMay+    , withLast+    )+where++import Safe.Plus++import Control.Arrow (first, second)+import Data.Function+import Data.Hashable (Hashable)+import Data.List+import Data.Maybe (mapMaybe, catMaybes)+import qualified Data.Foldable as F+import qualified Data.HashSet as HashSet+import qualified Data.List as L+import qualified Data.List.NonEmpty as NL+import qualified Data.Semigroup as S++-- | Computes the element in the middle of the list+-- If the list has an even number of elements, you will get the element after the middle of the+-- list.+middle :: [a] -> Maybe a+middle xs =+    case drop (length xs `div` 2) xs of+      [] -> Nothing+      x:_ -> Just x++-- O(n) requires a list sorted by the group key+groupOn :: Eq b => (a -> b) -> [a] -> [(b,[a])]+groupOn _  [] =  []+groupOn proj (x:xs) = (x', (x:ys)) : groupOn proj zs+    where+      x' = proj x+      (ys,zs) = span ((==x') . proj) xs++-- First sort and then group the list+groupOnSort :: Ord b => (a -> b) -> [a] -> [(b,[a])]+groupOnSort proj = groupOn proj . L.sortOn proj++-- First sort and then group the list+groupBySort :: Ord b => (b -> b -> Ordering) -> (a -> b) -> [a] -> [(b,[a])]+groupBySort cmp proj = groupOn proj . L.sortBy (\x y -> cmp (proj x) (proj y))++-- O(n^2)+-- Group the list, but don't sort it+groupUnsortedOn :: forall a b. Eq b => (a -> b) -> [a] -> [(b, [a])]+groupUnsortedOn proj =+    L.foldl' (addToGroups) []+    where+      addToGroups :: [(b, [a])] -> a -> [(b, [a])]+      addToGroups m val =+          let key = proj val+          in case break ((== key) . fst) m of+               (_, []) -> m ++ [(key, [val])]+               (p, f:r) -> p ++ [(fst f, snd f ++ [val])] ++ r++-- O(n) requires a list sorted by the group key+groupOn' :: Eq b => (a -> (b,c)) -> [a] -> [(b,[c])]+groupOn' proj = map (second (map (snd . proj))) . groupOn (fst . proj)++groupOnSort' :: Ord b => (a -> (b,c)) -> [a] -> [(b,[c])]+groupOnSort' proj = groupOn' proj . L.sortOn (fst . proj)++sconcatBy :: (Ord b, Foldable f, S.Semigroup s) => (a -> b) -> (a -> s) -> f a -> [(b,s)]+sconcatBy p1 p2 =+    fmap proj+    . NL.groupBy ((==) `on` p1)+    . L.sortOn p1+    . F.toList+    where+      proj gr = (p1 $ NL.head gr, S.sconcat $ NL.map p2 gr)++extractLast :: a -> [a] -> ([a], a)+extractLast x xs =+    case reverse xs of+      [] -> ([], x)+      y:ys -> (x : reverse ys, y)++lastElems :: Int -> [a] -> [a]+lastElems n =+    reverse . take n . reverse++headM :: Monad m => [a] -> m a+headM xs =+    case xs of+      [] -> safeFail "Cannot compute head of empty list"+      x:_ -> return x++lastM :: Monad m => [a] -> m a+lastM xs =+    case xs of+      [] -> safeFail "Cannot compute last of empty list"+      x:[] -> return x+      _:xs -> lastM xs++withLast :: (a -> a) -> [a] -> [a]+withLast _ [] = []+withLast f [x] = [f x]+withLast f (x:xs) = x : withLast f xs++minimumM :: (Monad m, Ord a) => [a] -> m a+minimumM xs =+    case xs of+      [] -> safeFail "Cannot compute minimum of empty list"+      y:ys -> return $ L.foldl' min y ys++maximumM :: (Monad m, Ord a) => [a] -> m a+maximumM xs =+    case xs of+      [] -> safeFail "Connot compute maximum of empty list"+      y:ys -> return $ L.foldl' max y ys++lookupM :: (Eq a, Monad m) => (a -> String) -> a -> [(a,b)] -> m b+lookupM str x xs =+    case lookup x xs of+      Nothing ->+          safeFail ("Lookup of " ++ str x ++ " failed.  Valid values are: "+                    ++ show (map (str . fst) xs))+      Just a ->+          return a++ungroupMay :: [(a,[b])] -> Maybe [(a,b)]+ungroupMay [] = Just []+ungroupMay ((_,[]):_) = Nothing+ungroupMay ((a,bs):rest) =+    do r <- ungroupMay rest+       return (map ((,) a) bs ++ r)++-- Returns false if and only if there are elements in decreasing order in the list.+monotone :: (Ord a) => [a] -> Bool+monotone (x0:x1:xs)+    | x0 <= x1 = monotone (x1:xs)+    | otherwise = False+monotone _ = True++-- makeMapping takes a list of pairs and create a list of key-value pairs+-- such that each key appears only once in the result list. Moreover,+-- the result list contains the pairs in the same order as the input list.+-- Example: [(k1, v1), (k2, v2), (k1, v3)] --> [(k2, v2), (k1, v3)]+makeMapping :: (Eq a, Hashable a) => [(a, b)] -> [(a, b)]+makeMapping l =+    go (reverse l) HashSet.empty []+    where+      go [] _ acc = acc+      go (x@(k, _) : xs) done acc =+          if k `HashSet.member` done+          then go xs done acc+          else go xs (HashSet.insert k done) (x:acc)++-- | Merge two sorted list so that the resulting list is sorted as well.+--   and contains all elements from one of the lists.+--   The length of the resulting list is the sum of the lengths of the given lists.+merge :: Ord a => [a] -> [a] -> [a]+merge [] ys = ys+merge xs [] = xs+merge (x:xs) (y:ys)+    | x == y = x:y:(merge xs ys)+    | x < y = x:(merge xs (y:ys))+    | otherwise = y:(merge (x:xs) ys)++-- | Merge the two sorted lists and remove all duplicates.+nubMerge :: Ord a => [a] -> [a] -> [a]+nubMerge xs ys = nubSorted $ merge xs ys+    where+      nubSorted :: Ord a => [a] -> [a]+      nubSorted = foldr consUniqSorted []++      consUniqSorted :: Ord a => a -> [a] -> [a]+      consUniqSorted x [] = [x]+      consUniqSorted x ys@(y:_) | x == y = ys+                                | otherwise = x:ys++chunksOf :: Int -> [a] -> [[a]]+chunksOf n xs =+    case splitAt n xs of+      ([], _) -> []+      (first, rest) -> first : chunksOf n rest++stripSuffix :: (Eq a) =>  [a] -> [a] -> Maybe [a]+stripSuffix s = (fmap reverse) . L.stripPrefix (reverse s) . reverse++prefixesAndSuffixes :: [a] -> [([a],[a])]+prefixesAndSuffixes a =+    case a of+      [] -> [([], [])]+      (a : r) -> ([], a : r) : map (first (a:)) (prefixesAndSuffixes r)++-- | Strips as elements of a given prefix list as possible.  Stops stripping+-- if the prefix doesn't match anymore or is exhausted and returns the remaining+-- string.+tryStripPrefix :: Eq a => [a] -> [a] -> [a]+tryStripPrefix [] xs = xs+tryStripPrefix _ [] = []+tryStripPrefix (x:xs) yys@(y:ys)+    | x == y = tryStripPrefix xs ys+    | otherwise = yys++spanTailRec :: (a -> Bool) -> [a] -> ([a], [a])+spanTailRec p xs = go ([], xs)+    where go (xs,[]) = (reverse xs, [])+          go (xs,(y:ys))+               | p y = go (y : xs, ys)+               | otherwise = (reverse xs, y:ys)
+ src/GHC/Stack/Plus.hs view
@@ -0,0 +1,34 @@+{-| Helper functions for dealing with call stacks and source locations.+ -}+module GHC.Stack.Plus+    ( callerLocation+    , callerFile+    , callerLine+    , adjustSourceFilePath+    )+where++import GHC.Stack+import Safe (tailSafe, lastNote)++adjustSourceFilePath :: FilePath -> FilePath+adjustSourceFilePath = tailSafe . dropWhile (/='/') . drop 1 . dropWhile (/= '/')++callerLocation :: (HasCallStack) => String+callerLocation = callerFile ++ ":" ++ show callerLine++-- | The filename of the first caller which called a function with implicit+-- parameter @(callStack :: 'CallStack')@.+callerFile :: (HasCallStack) => String+callerFile = srcLocFile . callerSrcLoc $ callStack++-- | The line number of the first caller which called a function with+-- implicit parameter @(callStack :: 'CallStack')@.+callerLine :: (HasCallStack) => Int+callerLine = srcLocStartLine . callerSrcLoc $ callStack++callerSrcLoc :: CallStack -> SrcLoc+callerSrcLoc = snd . caller++caller :: CallStack -> (String, SrcLoc)+caller = lastNote "Empty CallStack?!" . getCallStack
+ src/Safe/Plus.hs view
@@ -0,0 +1,127 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+module Safe.Plus+    ( callerFile+    , callerLine+    , callerLocation+    , safeDigitToInt+    , safeRead+    , readNoteVerbose+    , safeFromJust+    , safeFromJustNote+    , safeHead+    , safeTail+    , safeInit+    , safeLast+    , safeMaximum+    , safeMinimum+    , safeHeadNote+    , safeFromRight+    , fromRightNote+    , safeFromLeft+    , fromLeftNote+    , safeAtArray+    , atArrayNote+    , safeAt+    , safeError+    , safeFail+    , safeUndef+    )+where++import Data.Array.IArray+import Data.Char+import Data.Monoid+import GHC.Stack+import GHC.Stack.Plus+import Safe++-- | Convert a single digit 'Char' to the corresponding 'Int'.+-- This function fails unless its argument satisfies 'isHexDigit',+-- but recognises both upper and lower-case hexadecimal digits+-- (i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@).+safeDigitToInt :: Monad m => Char -> m Int+safeDigitToInt c+    | isDigit c  = return $ ord c - ord '0'+    | c >= 'a' && c <= 'f' = return $ ord c - ord 'a' + 10+    | c >= 'A' && c <= 'F' = return  $ ord c - ord 'A' + 10+    | otherwise = safeFail ("Char.safeDigitToInt: not a digit " ++ show c)++safeUndef :: (HasCallStack) => a+safeUndef = safeError "undefined!"++safeRead :: (HasCallStack, Read a) => String -> a+safeRead = readNoteVerbose callerLocation++readNoteVerbose :: Read a => String -> String -> a+readNoteVerbose msg s =+    case [x | (x,t) <- reads s, ("","") <- lex t] of+      [x] -> x+      []  -> error $ "Prelude.read: no parse, " ++ msg ++ ", on " ++ prefix+      _   -> error $ "Prelude.read: ambiguous parse, " ++ msg ++ ", on " ++ prefix+    where+        prefix = '\"' : a ++ if null b then "\"" else "..."+            where (a,b) = splitAt 1024 s++safeFromJust :: (HasCallStack) => Maybe a -> a+safeFromJust = Safe.fromJustNote callerLocation++safeFromJustNote :: (HasCallStack) => String -> Maybe a -> a+safeFromJustNote s = Safe.fromJustNote (callerLocation ++ ": " ++ s)++safeFail :: (HasCallStack, Monad m) => String -> m a+safeFail x = fail (callerLocation ++ ": FAIL: " ++ x)++safeHead :: (HasCallStack) => [a] -> a+safeHead = Safe.headNote callerLocation++safeTail :: (HasCallStack) => [a] -> [a]+safeTail = Safe.tailNote callerLocation++safeInit :: (HasCallStack) => [a] -> [a]+safeInit = Safe.initNote callerLocation++safeLast :: (HasCallStack) => [a] -> a+safeLast = Safe.lastNote callerLocation++safeMaximum :: (HasCallStack, Ord a) => [a] -> a+safeMaximum = Safe.maximumNote callerLocation++safeMinimum :: (HasCallStack, Ord a) => [a] -> a+safeMinimum = Safe.minimumNote callerLocation++safeHeadNote :: (HasCallStack) => String -> [a] -> a+safeHeadNote x = Safe.headNote (callerLocation ++ ": " ++ x)++safeFromRight :: (HasCallStack) => Either a b -> b+safeFromRight = fromRightNote callerLocation++fromRightNote :: String -> Either a b -> b+fromRightNote msg (Left _) = error $ "fromRight got a left value: " ++ msg+fromRightNote _ (Right x) = x++safeFromLeft :: (HasCallStack) => Either a b -> a+safeFromLeft = fromLeftNote callerLocation++fromLeftNote :: String -> Either a b -> a+fromLeftNote msg (Right _) = safeError $ "fromLeft got a right value: " ++ msg+fromLeftNote _ (Left x) = x++safeAtArray :: (HasCallStack, IArray a e, Ix i, Show i) => a i e -> i -> e+safeAtArray = atArrayNote callerLocation++atArrayNote :: (IArray a e, Ix i, Show i) => String -> a i e -> i -> e+atArrayNote msg array index+    | inRange arrayBounds index = array ! index+    | otherwise =+        error $ concat+            [ "lookup at index ", show index, " in an array was outside of its bounds "+            , show arrayBounds, ": ", msg+            ]+    where+      arrayBounds = bounds array++safeAt :: (HasCallStack) => [a] -> Int -> a+safeAt = Safe.atNote callerLocation++safeError :: (HasCallStack) => String -> a+safeError err = error $ callerLocation <> ": " <> err
+ test/Data/List/PlusSpec.hs view
@@ -0,0 +1,209 @@+{-# OPTIONS_GHC -F -pgmF htfpp -fno-warn-type-defaults #-}+module Data.List.PlusSpec+    ( htf_thisModulesTests+    )+where++import Data.List.Plus+import Test.Framework+import Test.QuickCheck.Function+import qualified Data.List.Plus as L+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set++prop_spanTailRec :: Fun Int Bool -> [Int] -> Bool+prop_spanTailRec (Fun _ f) lst = L.span f lst == spanTailRec f lst++test_middle :: IO ()+test_middle =+    do assertNothing (middle ([] :: [Int]))+       assertEqual (Just 1) (middle [1])+       assertEqual (Just 2) (middle [1,2])+       assertEqual (Just 2) (middle [1,2,3])+       assertEqual (Just 3) (middle [1,2,3,4])++test_tryStripPrefix :: IO ()+test_tryStripPrefix =+    do assertEqual "foobar" (tryStripPrefix "" "foobar")+       assertEqual "" (tryStripPrefix "foobar" "")+       assertEqual "z" (tryStripPrefix "foobar" "foobaz")+       assertEqual "baz" (tryStripPrefix "foobar" "foobarbaz")+       assertEqual "" (tryStripPrefix "foobarbaz" "foobar")++test_groupUnsortedOn :: IO ()+test_groupUnsortedOn =+    do assertEqual [] $ groupUnsortedOn id ([] :: [()])+       assertEqual [((), [()])] $ groupUnsortedOn id [()]+       assertEqual [((), [(), ()])] $ groupUnsortedOn id [(), ()]+       assertEqual [(1, [1]), (0, [2])] $ groupUnsortedOn (`mod` 2) [1, 2]+       assertEqual [(0, [2]), (1, [1])] $ groupUnsortedOn (`mod` 2) [2, 1]+       assertEqual [(1, [1, 3]), (0, [2, 4])] $ groupUnsortedOn (`mod` 2) [1, 2, 3, 4]+       assertEqual [(1, [1, 3]), (0, [2, 4])] $ groupUnsortedOn (`mod` 2) [1, 2, 4, 3]+       assertEqual [(0, [2, 4]), (1, [1, 3])] $ groupUnsortedOn (`mod` 2) [2, 1, 4, 3]++test_groupOnSort :: IO ()+test_groupOnSort =+    do assertEqual [] $ groupOnSort id ([] :: [()])+       assertEqual [((), [()])] $ groupOnSort id [()]+       assertEqual [((), [(), ()])] $ groupOnSort id [(), ()]+       assertEqual [(0, [2]), (1, [1])] $ groupOnSort (`mod` 2) [1, 2]+       assertEqual [(0, [2]), (1, [1])] $ groupOnSort (`mod` 2) [2, 1]+       assertEqual [(0, [2, 4]), (1, [1, 3])] $ groupOnSort (`mod` 2) [1, 2, 3, 4]+       assertEqual [(0, [2, 4]), (1, [1, 3])] $ groupOnSort (`mod` 2) [1, 2, 4, 3]+       assertEqual [(0, [2, 4]), (1, [1, 3])] $ groupOnSort (`mod` 2) [2, 1, 4, 3]++test_headM :: IO ()+test_headM =+    do assertEqual Nothing $ headM ([] :: [()])+       assertEqual (Just ()) $ headM [()]+       assertEqual (Just 1) $ headM [1,2]++test_lastM :: IO ()+test_lastM =+    do assertEqual Nothing $ lastM ([] :: [()])+       assertEqual (Just ()) $ lastM [()]+       assertEqual (Just 2) $ lastM [1,2]++test_minimumM :: IO ()+test_minimumM =+    do assertEqual Nothing $ minimumM ([] :: [Int])+       assertEqual (Just 1) $ minimumM [1]+       assertEqual (Just 1) $ minimumM [1,2]+       assertEqual (Just 1) $ minimumM [2,1]+       assertEqual (Just 1) $ minimumM [2,1,2]++test_maximumM :: IO ()+test_maximumM =+    do assertEqual Nothing $ maximumM ([] :: [Int])+       assertEqual (Just 2) $ maximumM [2]+       assertEqual (Just 2) $ maximumM [2,1]+       assertEqual (Just 2) $ maximumM [1,2]+       assertEqual (Just 2) $ maximumM [1,2,1]++test_merge :: IO ()+test_merge =+    do assertEqual [1, 2, 3, 4, 5] $ nubMerge as bs+       assertEqual [] $ nubMerge empty empty+       assertEqual [1] $ nubMerge one empty+       assertEqual [1] $ nubMerge empty one+       assertEqual [1, 2, 3] $ nubMerge cs cs+       assertEqual [1, 2, 3, 4, 5, 6] $ nubMerge cs ds+       assertEqual [1, 2, 3, 4, 5, 6] $ nubMerge es fs+       assertEqual [1] $ nubMerge two one+       assertEqual [1] $ nubMerge one two+       assertEqual [1] $ nubMerge three empty+       assertEqual [1] $ nubMerge empty three++       assertEqual [1, 2, 2, 3, 4, 4, 5] $ merge as bs+       assertEqual [] $ merge empty empty+       assertEqual [1] $ merge one empty+       assertEqual [1] $ merge empty one+       assertEqual [1, 1, 2, 2, 3, 3] $ merge cs cs+       assertEqual [1, 2, 3, 4, 5, 6] $ merge cs ds+       assertEqual [1, 2, 3, 4, 5, 6] $ merge es fs+       assertEqual [1, 1, 1] $ merge two one+       assertEqual [1, 1, 1] $ merge one two+       assertEqual [1, 1, 1] $ merge three empty+       assertEqual [1, 1, 1] $ merge empty three+    where+      empty, one, two, three, as, bs, cs, ds, es, fs :: [Int]+      as = [1, 2, 3, 4]+      bs = [2, 4, 5]+      cs = [1, 2, 3]+      ds = [4, 5, 6]+      es = [1, 3, 5]+      fs = [2, 4, 6]+      empty = []+      one = [1]+      two = [1, 1]+      three = [1, 1, 1]+++test_ungroup :: IO ()+test_ungroup =+    assertEqual (Just [("a","1"),("a","2"),("a","3"),("b","4")])+              $ ungroupMay [("a",["1","2","3"]),("b",["4"])]++test_ungroupGroup :: IO ()+test_ungroupGroup =+    do let list = [("x","1"),("y","1"),("y","3"),("y","1")]+       assertEqual (Just list) (ungroupMay $ groupOn' id list)++test_stripSuffix :: IO ()+test_stripSuffix =+    do assertEqual (Just "foo") $ stripSuffix "bar" "foobar"+       assertEqual (Just "") $ stripSuffix "bar" "bar"+       assertEqual Nothing $ stripSuffix "bar" "foobars"++test_monotone :: IO ()+test_monotone =+    do assertEqual True $ monotone [1,2,3]+       assertEqual False $ monotone [-1,0,3,2]+       assertEqual True $ monotone [1]+       assertEqual True $ monotone ([] :: [Int])++test_lastElems :: IO ()+test_lastElems =+    do assertEqual ([]::[Int]) (lastElems 100 [])+       assertEqual [1,2,3] (lastElems 5 [1,2,3])+       assertEqual [1,2,3] (lastElems 3 [1,2,3])+       assertEqual [2,3] (lastElems 2 [1,2,3])+++prop_lastElems :: [Int] -> Int -> Bool+prop_lastElems l n =+    lastElems n l `L.isSuffixOf` l++test_makeMapping :: IO ()+test_makeMapping =+    do assertEqual [] (makeMapping ([]::[(Int, String)]))+       let l = [(1::Int, "one"), (2, "two")] in assertEqual l (makeMapping l)+       assertEqual [(2::Int, "two"), (1, "three")]+                   (makeMapping [(1, "one"), (2, "two"), (1, "three")])+       assertEqual [(1::Int, "x")] (makeMapping [(1,"x"),(1,"x")])+       let l2 = [(-2,""),(-2,"a"),(-2,"")]+       assertBool $ checkOrder (makeMapping l2) l2++test_chunksOf :: IO ()+test_chunksOf =+    do assertEqual [] (chunksOf 1 ([] :: [Int]))+       assertEqual [] (chunksOf 0 [1])+       assertEqual [[1], [2], [3], [4]] (chunksOf 1 [1, 2, 3, 4])+       assertEqual [[1, 2], [3, 4]] (chunksOf 2 [1, 2, 3, 4])+       assertEqual [[1, 2], [3]] (chunksOf 2 [1, 2, 3])+       assertEqual [[1, 2, 3]] (chunksOf 3 [1, 2, 3])++test_prefixesAndSuffixes :: IO ()+test_prefixesAndSuffixes =+    do assertEqual (prefixesAndSuffixes "") [("","")]+       assertEqual (prefixesAndSuffixes "Hallo")+           [("","Hallo"), ("H","allo"),("Ha","llo"),("Hal","lo"),("Hall","o"),("Hallo","")]++prop_makeMappingConcat :: [(Int, String)] -> Bool+prop_makeMappingConcat l =+    makeMapping l == makeMapping (l ++ l)++prop_makeMappingKeysUnique :: [(Int, String)] -> Bool+prop_makeMappingKeysUnique l =+    length (map fst (makeMapping l)) == Set.size (Set.fromList (map fst l))++prop_makeMappingKeyValsOk :: [(Int, String)] -> Bool+prop_makeMappingKeyValsOk l =+    Map.fromList (makeMapping l) == Map.fromList l++prop_makeMappingOrderingOk :: [(Int, String)] -> Bool+prop_makeMappingOrderingOk l =+    checkOrder (makeMapping l) l++checkOrder :: [(Int, String)] -> [(Int, String)] -> Bool+checkOrder [] [] = True+checkOrder (x:xs) (y:ys)+    | x == y = checkOrder xs (dropWhile ((fst x ==) . fst) ys)+    | otherwise = checkOrder (x:xs) ys+checkOrder _ _ = False++test_withLast :: IO ()+test_withLast =+    do assertEqual [] (withLast not [])+       assertEqual [False] (withLast not [True])+       assertEqual [True,False] (withLast not [True,True])
+ test/GHC/Stack/PlusSpec.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module GHC.Stack.PlusSpec+    ( htf_thisModulesTests+    )+where++import GHC.Stack.Plus+import Test.Framework++test_callerSrcLoc :: IO ()+test_callerSrcLoc =+    do assertEqual __FILE__ callerFile+       assertEqual __LINE__ callerLine
+ test/Safe/PlusSpec.hs view
@@ -0,0 +1,15 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Safe.PlusSpec where++import GHC.Exception+import Safe.Plus+import Test.Framework++test_safeError :: IO ()+test_safeError =+    assertThrows (safeError msg) (matches (format __FILE__ __LINE__))+    where+      matches expected (ErrorCallWithLocation actual _) = expected == actual+      format :: String -> Int -> String+      format file line = file ++ ":" ++ show line ++ ": " ++ msg+      msg = "error message"
+ test/Spec.hs view
@@ -0,0 +1,11 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Main where++import {-@ HTF_TESTS @-} Data.List.PlusSpec+import {-@ HTF_TESTS @-} GHC.Stack.PlusSpec+import {-@ HTF_TESTS @-} Safe.PlusSpec++import Test.Framework++main :: IO ()+main = htfMain htf_importedTests
+ util-plus.cabal view
@@ -0,0 +1,49 @@+name:                util-plus+version:             0.1.0.0+synopsis:            A collection of commonly used utils+description:         A collection of commonly used util functions for basic libaries+homepage:            https://github.com/factisresearch/opensource-mono#readme+license:             BSD3+license-file:        LICENSE+author:              factis research GmbH+maintainer:          mail@athiemann.net+copyright:           2017 factis research GmbH+category:            Data+build-type:          Simple+extra-source-files:+    README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     GHC.Stack.Plus+                     , Safe.Plus+                     , Data.List.Plus+                     , Control.Applicative.Plus+  build-depends:       base >= 4.7 && < 5+                     , safe+                     , array+                     , hashable+                     , containers+                     , unordered-containers+  default-language:    Haskell2010+  ghc-options:       -Wall++test-suite util-plus-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       GHC.Stack.PlusSpec+                     , Safe.PlusSpec+                     , Data.List.PlusSpec+  build-depends:       base >= 4.7 && < 5+                     , HTF+                     , QuickCheck+                     , containers+                     , util-plus+  ghc-options:       -Wall+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/factisresearch/opensource-mono