module Chorale.Common (
(.*),
(.**),
(.***),
curry3,
uncurry3,
curry4,
uncurry4,
curry5,
uncurry5,
appendFst,
appendSnd,
appendFst3,
appendSnd3,
appendThd3,
removeFst3,
removeSnd3,
removeThd3,
appendFst4,
appendSnd4,
appendThd4,
appendFth4,
removeFst4,
removeSnd4,
removeThd4,
removeFth4,
appendFst5,
appendSnd5,
appendThd5,
appendFourth5,
appendFifth5,
removeFst5,
removeSnd5,
removeThd5,
removeFourth5,
removeFifth5,
make2,
make3,
make4,
make5,
fst3,
snd3,
thd3,
fst4,
snd4,
thd4,
fth4,
fst5,
snd5,
thd5,
fourth5,
fifth5,
tupleToList2,
listToTuple2,
tupleToList3,
listToTuple3,
tupleToList4,
listToTuple4,
tupleToList5,
listToTuple5,
map12,
map21,
map22,
map13,
map31,
map33,
map14,
map41,
map44,
map15,
map51,
map55,
mapFst,
mapSnd,
sequence2,
(<<),
compareUsing,
vanishes,
equaling,
sortAndGroup,
sortAndGroupBy,
sortAndGroupLookupBy,
notNull,
takeWhileList,
takeUntilList,
takeToFirst,
splitOnFirst,
nubOrd,
nubOrdBy',
zipWithDefault,
subset,
subsets,
findIndicesTuples,
replaceInList,
replaceElementInList,
removeFromList,
stripPostfix,
applyToList,
mapFoldl,
reverseMap,
count,
deleteAll,
deleteAlls,
cartesian,
xor,
xnor,
average,
justifyLeft,
justifyRight,
mapJust,
onJustUse,
mapLeft,
mapRight,
fromLeft,
fromRight,
Either3(..)) where
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import Data.Ord
import qualified Data.Set as Set
import Safe
infixr 8 .*
(.*) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(.*) = (.) . (.)
infixr 8 .**
(.**) :: (d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e
(.**) = (.) . (.*)
infixr 8 .***
(.***) :: (e -> f) -> (a -> b -> c -> d -> e) -> a -> b -> c -> d -> f
(.***) = (.) . (.**)
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 f a b c = f (a, b, c)
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f (a, b, c) = f a b c
curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 f a b c d = f (a, b, c, d)
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 f (a, b, c, d) = f a b c d
curry5 :: ((a, b, c, d, e) -> f) -> a -> b -> c -> d -> e -> f
curry5 f a b c d e = f (a, b, c, d, e)
uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
uncurry5 f (a, b, c, d, e) = f a b c d e
appendFst :: a -> b -> (a, b)
appendFst a b = (a, b)
appendSnd :: b -> a -> (a, b)
appendSnd b a = (a, b)
appendFst3 :: a -> (b, c) -> (a, b, c)
appendFst3 a (b, c) = (a, b, c)
appendSnd3 :: b -> (a, c) -> (a, b, c)
appendSnd3 b (a, c) = (a, b, c)
appendThd3 :: c -> (a, b) -> (a, b, c)
appendThd3 c (a, b) = (a, b, c)
removeFst3 :: (a, b, c) -> (b, c)
removeFst3 (_, b, c) = (b, c)
removeSnd3 :: (a, b, c) -> (a, c)
removeSnd3 (a, _, c) = (a, c)
removeThd3 :: (a, b, c) -> (a, b)
removeThd3 (a, b, _) = (a, b)
appendFst4 :: a -> (b, c, d) -> (a, b, c, d)
appendFst4 a (b, c, d) = (a, b, c, d)
appendSnd4 :: b -> (a, c, d) -> (a, b, c, d)
appendSnd4 b (a, c, d) = (a, b, c, d)
appendThd4 :: c -> (a, b, d) -> (a, b, c, d)
appendThd4 c (a, b, d) = (a, b, c, d)
appendFth4 :: d -> (a, b, c) -> (a, b, c, d)
appendFth4 d (a, b, c) = (a, b, c, d)
removeFst4 :: (a, b, c, d) -> (b, c, d)
removeFst4 (_, b, c, d) = (b, c, d)
removeSnd4 :: (a, b, c, d) -> (a, c, d)
removeSnd4 (a, _, c, d) = (a, c, d)
removeThd4 :: (a, b, c, d) -> (a, b, d)
removeThd4 (a, b, _, d) = (a, b, d)
removeFth4 :: (a, b, c, d) -> (a, b, c)
removeFth4 (a, b, c, _) = (a, b, c)
appendFst5 :: a -> (b, c, d, e) -> (a, b, c, d, e)
appendFst5 a (b, c, d, e) = (a, b, c, d, e)
appendSnd5 :: b -> (a, c, d, e) -> (a, b, c, d, e)
appendSnd5 b (a, c, d, e) = (a, b, c, d, e)
appendThd5 :: c -> (a, b, d, e) -> (a, b, c, d, e)
appendThd5 c (a, b, d, e) = (a, b, c, d, e)
appendFourth5 :: d -> (a, b, c, e) -> (a, b, c, d, e)
appendFourth5 d (a, b, c, e) = (a, b, c, d, e)
appendFifth5 :: e -> (a, b, c, d) -> (a, b, c, d, e)
appendFifth5 e (a, b, c, d) = (a, b, c, d, e)
removeFst5 :: (a, b, c, d, e) -> (b, c, d, e)
removeFst5 (_, b, c, d, e) = (b, c, d, e)
removeSnd5 :: (a, b, c, d, e) -> (a, c, d, e)
removeSnd5 (a, _, c, d, e) = (a, c, d, e)
removeThd5 :: (a, b, c, d, e) -> (a, b, d, e)
removeThd5 (a, b, _, d, e) = (a, b, d, e)
removeFourth5 :: (a, b, c, d, e) -> (a, b, c, e)
removeFourth5 (a, b, c, _, e) = (a, b, c, e)
removeFifth5 :: (a, b, c, d, e) -> (a, b, c, d)
removeFifth5 (a, b, c, d, _) = (a, b, c, d)
make2 :: a -> (a, a)
make2 a = (a, a)
make3 :: a -> (a, a, a)
make3 a = (a, a, a)
make4 :: a -> (a, a, a, a)
make4 a = (a, a, a, a)
make5 :: a -> (a, a, a, a, a)
make5 a = (a, a, a, a, a)
fst3 :: (a, b, c) -> a
fst3 (a, _, _) = a
snd3 :: (a, b, c) -> b
snd3 (_, b, _) = b
thd3 :: (a, b, c) -> c
thd3 (_, _, c) = c
fst4 :: (a, b, c, d) -> a
fst4 (a, _, _, _) = a
snd4 :: (a, b, c, d) -> b
snd4 (_, b, _, _) = b
thd4 :: (a, b, c, d) -> c
thd4 (_, _, c, _) = c
fth4 :: (a, b, c, d) -> d
fth4 (_, _, _, d) = d
fst5 :: (a, b, c, d, e) -> a
fst5 (a, _, _, _, _) = a
snd5 :: (a, b, c, d, e) -> b
snd5 (_, b, _, _, _) = b
thd5 :: (a, b, c, d, e) -> c
thd5 (_, _, c, _, _) = c
fourth5 :: (a, b, c, d, e) -> d
fourth5 (_, _, _, d, _) = d
fifth5 :: (a, b, c, d, e) -> e
fifth5 (_, _, _, _, e) = e
tupleToList2 :: (a, a) -> [a]
tupleToList2 (x, y) = [x, y]
listToTuple2 :: [a] -> Maybe (a, a)
listToTuple2 [x, y] = Just (x, y)
listToTuple2 _ = Nothing
tupleToList3 :: (a, a, a) -> [a]
tupleToList3 (x, y, z) = [x, y, z]
listToTuple3 :: [a] -> Maybe (a, a, a)
listToTuple3 [x, y, z] = Just (x, y, z)
listToTuple3 _ = Nothing
tupleToList4 :: (a, a, a, a) -> [a]
tupleToList4 (x1, x2, x3, x4) = [x1, x2, x3, x4]
listToTuple4 :: [a] -> Maybe (a, a, a, a)
listToTuple4 [x1, x2, x3, x4] = Just (x1, x2, x3, x4)
listToTuple4 _ = Nothing
tupleToList5 :: (a, a, a, a, a) -> [a]
tupleToList5 (x1, x2, x3, x4, x5) = [x1, x2, x3, x4, x5]
listToTuple5 :: [a] -> Maybe (a, a, a, a, a)
listToTuple5 [x1, x2, x3, x4, x5] = Just (x1, x2, x3, x4, x5)
listToTuple5 _ = Nothing
map12 :: (a -> a') -> (a, a) -> (a', a')
map12 f (a0, a1) = (f a0, f a1)
map21 :: (a -> a', a -> a'') -> a -> (a', a'')
map21 (f, g) a = (f a, g a)
map22 :: (a -> a', b -> b') -> (a, b) -> (a', b')
map22 (f, g) (a, b) = (f a, g b)
map13 :: (a -> a') -> (a, a, a) -> (a', a', a')
map13 f (a0, a1, a2) = (f a0, f a1, f a2)
map31 :: (a -> a', a -> a'', a -> a''') -> a -> (a', a'', a''')
map31 (f, g, h) a = (f a, g a, h a)
map33 :: (a -> a', b -> b', c -> c') -> (a, b, c) -> (a', b', c')
map33 (f, g, h) (a, b, c) = (f a, g b, h c)
map14 :: (a -> a') -> (a, a, a, a) -> (a', a', a', a')
map14 f (a0, a1, a2, a3) = (f a0, f a1, f a2, f a3)
map41 :: (a -> a', a -> a'', a -> a''', a -> a'''') -> a -> (a', a'', a''', a'''')
map41 (f, g, h, i) a = (f a, g a, h a, i a)
map44 :: (a -> a', b -> b', c -> c', d -> d') -> (a, b, c, d) -> (a', b', c', d')
map44 (f, g, h, i) (a, b, c, d) = (f a, g b, h c, i d)
map15 :: (a -> a') -> (a, a, a, a, a) -> (a', a', a', a', a')
map15 f (a0, a1, a2, a3, a4) = (f a0, f a1, f a2, f a3, f a4)
map51 :: (a -> a', a -> a'', a -> a''', a -> a'''', a -> a''''') -> a -> (a', a'', a''', a'''', a''''')
map51 (f, g, h, i, j) a = (f a, g a, h a, i a, j a)
map55 :: (a -> a', b -> b', c -> c', d -> d', e -> e') -> (a, b, c, d,e ) -> (a', b', c', d', e')
map55 (f, g, h, i, j) (a, b, c, d, e) = (f a, g b, h c, i d, j e)
mapFst :: (a -> a') -> (a, b) -> (a', b)
mapFst f = map22 (f, id)
mapSnd :: (b -> b') -> (a, b) -> (a, b')
mapSnd g = map22 (id, g)
sequence2 :: (Functor m, Monad m) => (m a, m a) -> m (a, a)
sequence2 = fmap (fromJust . listToTuple2) . sequence . tupleToList2
(<<) :: (Monad m) => m b -> m a -> m b
m1 << m2 = m2 >> m1
compareUsing :: Eq a => [a] -> a -> a -> Ordering
compareUsing as = uncurry compare .* curry (map12 (`elemIndex` as))
vanishes :: (Num a, Eq a) => a -> Bool
vanishes = (==) 0
equaling :: Eq b => (a -> b) -> a -> a -> Bool
equaling f x y = f x == f y
sortAndGroup :: Ord a => [a] -> [[a]]
sortAndGroup = sortAndGroupBy id
sortAndGroupBy :: Ord b => (a -> b) -> [a] -> [[a]]
sortAndGroupBy f = groupBy (equaling f) . sortBy (comparing f)
sortAndGroupLookupBy :: Ord b => (a -> b) -> [a] -> [(b, [a])]
sortAndGroupLookupBy f = map (map21 (f . head, id)) . sortAndGroupBy f
notNull :: [a] -> Bool
notNull = not . null
takeWhileList :: ([a] -> Bool) -> [a] -> [a]
takeWhileList p = takeWhileList' [] where
takeWhileList' ys [] = ys
takeWhileList' ys (x:xs)
| p (ys ++ [x]) = takeWhileList' (ys ++ [x]) xs
| otherwise = ys
takeUntilList :: ([a] -> Bool) -> [a] -> [a]
takeUntilList p = takeUntilList' [] where
takeUntilList' ys [] = ys
takeUntilList' ys (x:xs)
| (not . p) (ys ++ [x]) = takeUntilList' (ys ++ [x]) xs
| otherwise = ys ++ [x]
takeToFirst :: (a -> Bool) -> [a] -> [a]
takeToFirst _ [] = []
takeToFirst p (x:xs)
| p x = [x]
| otherwise = x : takeToFirst p xs
splitOnFirst :: Eq a => a -> [a] -> ([a], Maybe [a])
splitOnFirst x xs
| isJust j = mapSnd (Just . tail) . splitAt (fromJust j) $ xs
| otherwise = (xs, Nothing)
where
j = elemIndex x xs
nubOrd :: Ord a => [a] -> [a]
nubOrd = s Set.empty where
s _ [] = []
s m (x:xs)
| Set.member x m = s m xs
| otherwise = x : s (Set.insert x m) xs
nubOrdBy' :: Ord b => (a -> b) -> [a] -> [a]
nubOrdBy' f = s Map.empty where
s _ [] = []
s m (x:xs)
| Map.member (f x) m = s m xs
| otherwise = x : s (Map.insert (f x) x m) xs
zipWithDefault :: a -> (a -> a -> c) -> [a] -> [a] -> [c]
zipWithDefault a0 f (a:as) (b:bs) = f a b : zipWithDefault a0 f as bs
zipWithDefault a0 f [] (b:bs) = f a0 b : zipWithDefault a0 f [] bs
zipWithDefault a0 f (a:as) [] = f a a0 : zipWithDefault a0 f as []
zipWithDefault _ _ _ _ = []
subset :: Eq a => [a] -> [a] -> Bool
subset as bs = all (`elem` bs) as
subsets :: [a] -> [[a]]
subsets [] = [[]]
subsets (a:as) = uncurry (++) . map21 (id, map (a:)) . subsets $ as
findIndicesTuples :: (a -> Bool) -> [a] -> [([a], Int)]
findIndicesTuples f as = map (appendFst as) . findIndices f $ as
replaceInList :: Int -> [a] -> [a] -> [a]
replaceInList n as = uncurry (++) . mapSnd ((++) as. tail) . splitAt n
replaceElementInList :: Eq a => a -> [a] -> [a] -> [a]
replaceElementInList a bs as = case elemIndex a as of
Just j -> take j as ++ bs ++ replaceElementInList a bs (drop (j + 1) as)
Nothing -> as
removeFromList :: Int -> [a] ->[a]
removeFromList j = replaceInList j []
stripPostfix :: Eq a => [a] -> [a] -> Maybe [a]
stripPostfix = curry $ mapJust reverse . uncurry stripPrefix . map12 reverse
applyToList :: Int -> (a -> a) -> [a] -> [a]
applyToList n f as = replaceInList n [f $ as `at` n] as
mapFoldl :: (Maybe c -> a -> (c, b)) -> [a] -> [b]
mapFoldl f = mapFoldl' f Nothing where
mapFoldl' _ _ [] = []
mapFoldl' f' lastC (a:as) = b : mapFoldl' f' (Just c) as where
(c, b) = f' lastC a
reverseMap :: [a -> b] -> a -> [b]
reverseMap fs a = map (\f -> f a) fs
count :: (a -> Bool) -> [a] -> Int
count = length .* filter
deleteAll :: Eq a => a -> [a] -> [a]
deleteAll = filter . (/=)
deleteAlls :: Eq a => [a] -> [a] -> [a]
deleteAlls = flip $ foldr deleteAll
cartesian :: [a] -> [b] -> [(a, b)]
cartesian as bs = [(a, b) | a <- as, b <- bs]
xor :: Bool -> Bool -> Bool
xor a = xnor (not a)
xnor :: Bool -> Bool -> Bool
xnor a b = (a && b) || (not a && not b)
average :: [Double] -> Double
average xs
| null xs = error "Average cannot be computed on empty list"
| otherwise = uncurry (/) . map21 (sum, fromIntegral . length) $ xs
justifyLeft :: Int -> Char -> String -> String
justifyLeft n c s = s ++ replicate (max 0 $ n length s) c
justifyRight :: Int -> Char -> String -> String
justifyRight n c s = replicate (max 0 $ n length s) c ++ s
mapJust :: (a -> b) -> Maybe a -> Maybe b
mapJust = fmap
onJustUse :: (a -> b -> b) -> Maybe a -> b -> b
onJustUse f = \case
(Just b) -> f b
_ -> id
mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft f = either (Left . f) Right
mapRight :: (b -> c) -> Either a b -> Either a c
mapRight f = either Left (Right . f)
fromLeft :: Either a b -> a
fromLeft (Left a) = a
fromLeft _ = error "Error: fromLeft on Right"
fromRight :: Either a b -> b
fromRight (Right b) = b
fromRight _ = error "Error: fromRight on Left"
data Either3 a b c = E1 a | E2 b | E3 c