{-# LANGUAGE CPP #-}
module Conjure.Utils
( module Data.List
, module Data.Function
, module Data.Maybe
, module Data.Monoid
, module Data.Tuple
, module Data.Typeable
, count
, nubOn
, iterateUntil
, mzip
, groupOn
#if __GLASGOW_HASKELL__ < 710
, sortOn
#endif
, takeUntil
, takeNextWhile
, takeNextUntil
, deconstructions
, isDeconstruction
, idIO
, mapHead
, sets
)
where
import Data.List
import Data.Function
import Data.Maybe
import Data.Monoid
import Data.Tuple
import Data.Typeable
import System.IO.Unsafe
count :: (a -> Bool) -> [a] -> Int
count :: (a -> Bool) -> [a] -> Int
count a -> Bool
p = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p
nubOn :: Eq b => (a -> b) -> [a] -> [a]
nubOn :: (a -> b) -> [a] -> [a]
nubOn a -> b
f = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> (a -> b) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)
iterateUntil :: (a -> a -> Bool) -> (a -> a) -> a -> a
iterateUntil :: (a -> a -> Bool) -> (a -> a) -> a -> a
iterateUntil a -> a -> Bool
(?) a -> a
f = a -> a
iu
where
iu :: a -> a
iu a
x | a
x a -> a -> Bool
? a
fx = a
x
| Bool
otherwise = a -> a
iu a
fx
where
fx :: a
fx = a -> a
f a
x
mzip :: Monoid a => [a] -> [a] -> [a]
mzip :: [a] -> [a] -> [a]
mzip [] [] = []
mzip [] [a]
ys = [a]
ys
mzip [a]
xs [] = [a]
xs
mzip (a
x:[a]
xs) (a
y:[a]
ys) = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Monoid a => [a] -> [a] -> [a]
mzip [a]
xs [a]
ys
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn :: (a -> b) -> [a] -> [[a]]
groupOn a -> b
f = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> (a -> b) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)
#if __GLASGOW_HASKELL__ < 710
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn f = sortBy (compare `on` f)
#endif
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil a -> Bool
p = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)
takeNextWhile :: (a -> a -> Bool) -> [a] -> [a]
takeNextWhile :: (a -> a -> Bool) -> [a] -> [a]
takeNextWhile a -> a -> Bool
(?) = [a] -> [a]
t
where
t :: [a] -> [a]
t (a
x:a
y:[a]
xs) | a
x a -> a -> Bool
? a
y = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
t (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
| Bool
otherwise = [a
x]
t [a]
xs = [a]
xs
takeNextUntil :: (a -> a -> Bool) -> [a] -> [a]
takeNextUntil :: (a -> a -> Bool) -> [a] -> [a]
takeNextUntil a -> a -> Bool
(?) = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
takeNextWhile (Bool -> Bool
not (Bool -> Bool) -> (a -> a -> Bool) -> a -> a -> Bool
forall b c a a. (b -> c) -> (a -> a -> b) -> a -> a -> c
.: a -> a -> Bool
(?))
where
.: :: (b -> c) -> (a -> a -> b) -> a -> a -> c
(.:) = ((a -> b) -> a -> c) -> (a -> a -> b) -> a -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((a -> b) -> a -> c) -> (a -> a -> b) -> a -> a -> c)
-> ((b -> c) -> (a -> b) -> a -> c)
-> (b -> c)
-> (a -> a -> b)
-> a
-> a
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
deconstructions :: (a -> Bool) -> (a -> a) -> a -> [a]
deconstructions :: (a -> Bool) -> (a -> a) -> a -> [a]
deconstructions a -> Bool
z a -> a
d a
x = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeUntil a -> Bool
z
([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
d a
x
isDeconstruction :: [a] -> (a -> Bool) -> (a -> a) -> Bool
isDeconstruction :: [a] -> (a -> Bool) -> (a -> a) -> Bool
isDeconstruction [a]
xs a -> Bool
z a -> a
d = (a -> Bool) -> [a] -> Int
forall a. (a -> Bool) -> [a] -> Int
count a -> Bool
is [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
where
is :: a -> Bool
is a
x = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
l ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> (a -> a) -> a -> [a]
forall a. (a -> Bool) -> (a -> a) -> a -> [a]
deconstructions a -> Bool
z a -> a
d a
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l
l :: Int
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
idIO :: (a -> IO ()) -> a -> a
idIO :: (a -> IO ()) -> a -> a
idIO a -> IO ()
action a
x = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
a -> IO ()
action a
x
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
mapHead :: (a -> a) -> [a] -> [a]
mapHead :: (a -> a) -> [a] -> [a]
mapHead a -> a
f (a
x:[a]
xs) = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
sets :: [a] -> [[a]]
sets :: [a] -> [[a]]
sets [] = [[]]
sets (a
x:[a]
xs) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [[a]]
ss [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
ss
where
ss :: [[a]]
ss = [a] -> [[a]]
forall a. [a] -> [[a]]
sets [a]
xs