{-# LANGUAGE Haskell2010, Safe #-} {-# OPTIONS -Wall #-} -- | -- Module : Haskell.X -- Copyright : (c) Julian Fleischer 2013 -- License : MIT (See LICENSE file in cabal package) -- -- Maintainer : julian.fleischer@fu-berlin.de -- Stability : provisional -- Portability : portable -- -- Haskell extra utility functions. Best imported by @import qualified Haskell.X as X@. module Haskell.X where import Prelude import Data.Char import Data.List import Data.Ord import Control.Arrow -- | Apply a function exhaustively. exhaustively :: Eq a => (a -> a) -> a -> a exhaustively = exhaustivelyBy (==) -- | Apply a function exhaustively. exhaustivelyBy :: (a -> a -> Bool) -> (a -> a) -> a -> a exhaustivelyBy predicate func dat = case predicate dat result of True -> result False -> exhaustivelyBy predicate func result where result = func dat -- | Apply a monadic function exhaustively. exhaustivelyM :: (Eq a, Monad m) => (a -> m a) -> a -> m a exhaustivelyM = exhaustivelyByM (==) -- | Apply a monadic function exhaustively. exhaustivelyByM :: Monad m => (a -> a -> Bool) -> (a -> m a) -> a -> m a exhaustivelyByM predicate func dat = do result <- func dat case predicate dat result of True -> return result False -> exhaustivelyByM predicate func result -- | Sort a list and leave out duplicates. Like @nub . sort@ but faster. uniqSort :: (Ord a) => [a] -> [a] uniqSort = map head . group . sort -- | Sort, then group aggregateBy :: (a -> a -> Ordering) -> [a] -> [[a]] aggregateBy x = groupBy (\a b -> x a b == EQ) . sortBy x -- | Sort, then group aggregate :: (Ord a) => [a] -> [[a]] aggregate = aggregateBy compare -- | Aggregate an association list, such that keys become unique. -- -- (c) aggregateAL :: (Ord a) => [(a,b)] -> [(a,[b])] aggregateAL = map (fst . head &&& map snd) . aggregateBy (comparing fst) -- | Replace all occurences of a specific thing in a list of things another thing. tr :: Eq a => a -> a -> [a] -> [a] tr n r (x:xs) | x == n = r : tr n r xs | otherwise = x : tr n r xs tr _ _ [] = [] -- | Counts how many elements there are in a 4 levels deep list. count4 :: [[[[a]]]] -> Int count4 = sum . map (sum . map (sum . map length)) -- | Counts how many elements there are in a 3 levels deep list. count3 :: [[[a]]] -> Int count3 = sum . map (sum . map length) -- | Counts how many elements there are in a 2 levels deep list. count2 :: [[a]] -> Int count2 = sum . map length -- | Counts how many elements there are in a 1 level deep list. count1 :: [a] -> Int count1 = length -- | Segments the elements of a 3 levels deep list such that -- the segments contain at least the specified amount of elements, -- without breaking apart any subsegments. segment3 :: Int -> [[[a]]] -> [[a]] segment3 _ [] = [] segment3 size as = if null segments then [concatMap concat as] else concatMap concat segment : segment3 size rest where segmentations = zip (inits as) (tails as) segments = dropWhile ((< size) . count3 . fst) segmentations (segment, rest) = head segments -- | Segments the elements of a 2 levels deep list such that -- the segments contain at least the specified amount of elements, -- without breaking apart any subsegments. segment2 :: Int -> [[a]] -> [[a]] segment2 _ [] = [] segment2 size as = if null segments then [concat as] else concat segment : segment2 size rest where segmentations = zip (inits as) (tails as) segments = dropWhile ((< size) . count2 . fst) segmentations (segment, rest) = head segments -- | @breakLast xs == (init xs, last xs)@ breakLast :: [a] -> ([a], a) breakLast [a] = ([], a) breakLast (a:as) = let (init', last') = breakLast as in (a:init', last') breakLast _ = error "Haskell.X.breakLast: empty list" -- | If an Either contains the same types in Left and Right, -- unify it by dropping the Either wrapper. uneither :: Either a a -> a uneither = either id id data Version = Version { versionBranch :: [Integer], versionTags :: [String] } deriving (Eq, Ord) instance Read Version where readsPrec _ = parseVersion instance Show Version where showsPrec _ (Version branch tags) xs = tail (concatMap (('.':) . show) branch) ++ concatMap ('-':) tags ++ xs parseVersion :: String -> [(Version, String)] parseVersion string = let (digits, tagRest) = parseBranch string (tags, rest) = parseTags tagRest in if null digits then [] else [(Version (map read digits) tags, rest)] where parseBranch str = let next = span isDigit str in case next of ("", rest) -> ([], rest) (ds, '.':rest) -> let (dss, rest') = parseBranch rest in (ds : dss, rest') (ds, rest) -> ([ds], rest) parseTags ('-':str) = let next = span isAlphaNum str in case next of ("", rest) -> ([], rest) (xs, rest) -> let (xss, rest') = parseTags rest in (xs : xss, rest') parseTags xs = ([], xs)