{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}

module Sound.Tidal.Utils where

{-
    Utils.hs - A library of handy Haskell utility functions
    Copyright (C) 2020, Alex McLean and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import Data.List (delete)
import Data.Set (Set)
import qualified Data.Set as Set
import System.IO (hPutStrLn, stderr)

-- import qualified Data.IntSet as IntSet
-- import Data.IntSet (IntSet)
#ifdef __GLASGOW_HASKELL__
import           GHC.Exts  (build)
#endif

writeError :: String -> IO ()
writeError :: String -> IO ()
writeError = Handle -> String -> IO ()
hPutStrLn Handle
stderr

mapBoth :: (a -> a) -> (a, a) -> (a, a)
mapBoth :: forall a. (a -> a) -> (a, a) -> (a, a)
mapBoth a -> a
f (a
a, a
b) = (a -> a
f a
a, a -> a
f a
b)

mapPartTimes :: (a -> a) -> ((a, a), (a, a)) -> ((a, a), (a, a))
mapPartTimes :: forall a. (a -> a) -> ((a, a), (a, a)) -> ((a, a), (a, a))
mapPartTimes a -> a
f = ((a, a) -> (a, a)) -> ((a, a), (a, a)) -> ((a, a), (a, a))
forall a. (a -> a) -> (a, a) -> (a, a)
mapBoth ((a -> a) -> (a, a) -> (a, a)
forall a. (a -> a) -> (a, a) -> (a, a)
mapBoth a -> a
f)

mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst :: forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFst a -> b
f (a
x, c
y) = (a -> b
f a
x, c
y)

mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd :: forall a b c. (a -> b) -> (c, a) -> (c, b)
mapSnd a -> b
f (c
x, a
y) = (c
x, a -> b
f a
y)

delta :: (Num a) => (a, a) -> a
delta :: forall a. Num a => (a, a) -> a
delta (a
a, a
b) = a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a

-- | The midpoint of two values
mid :: (Fractional a) => (a, a) -> a
mid :: forall a. Fractional a => (a, a) -> a
mid (a
a, a
b) = a
a a -> a -> a
forall a. Num a => a -> a -> a
+ ((a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2)

removeCommon :: (Eq a) => [a] -> [a] -> ([a], [a])
removeCommon :: forall a. Eq a => [a] -> [a] -> ([a], [a])
removeCommon [] [a]
bs = ([], [a]
bs)
removeCommon [a]
as [] = ([a]
as, [])
removeCommon (a
a : [a]
as) [a]
bs
  | a
a a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
bs = [a] -> [a] -> ([a], [a])
forall a. Eq a => [a] -> [a] -> ([a], [a])
removeCommon [a]
as (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
delete a
a [a]
bs)
  | Bool
otherwise = (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as', [a]
bs')
  where
    ([a]
as', [a]
bs') = [a] -> [a] -> ([a], [a])
forall a. Eq a => [a] -> [a] -> ([a], [a])
removeCommon [a]
as [a]
bs

readMaybe :: (Read a) => String -> Maybe a
readMaybe :: forall a. Read a => String -> Maybe a
readMaybe String
s = case [a
x | (a
x, String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
s, (String
"", String
"") <- ReadS String
lex String
t] of
  [a
x] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  [a]
_ -> Maybe a
forall a. Maybe a
Nothing

-- | like `!!` selects @n@th element from xs, but wraps over at the end of @xs@
--
-- >>> map ((!!!) [1,3,5]) [0,1,2,3,4,5]
-- [1,3,5,1,3,5]
(!!!) :: [a] -> Int -> a
!!! :: forall a. [a] -> Int -> a
(!!!) [a]
xs Int
n = [a]
xs [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)

-- | Safer version of !! -
nth :: Int -> [a] -> Maybe a
nth :: forall a. Int -> [a] -> Maybe a
nth Int
_ [] = Maybe a
forall a. Maybe a
Nothing
nth Int
0 (a
x : [a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
nth Int
n (a
_ : [a]
xs) = Int -> [a] -> Maybe a
forall a. Int -> [a] -> Maybe a
nth (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs

accumulate :: (Num t) => [t] -> [t]
accumulate :: forall t. Num t => [t] -> [t]
accumulate [] = []
accumulate (t
x : [t]
xs) = (t -> t -> t) -> t -> [t] -> [t]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl t -> t -> t
forall a. Num a => a -> a -> a
(+) t
x [t]
xs

-- | enumerate a list of things
--
-- >>> enumerate ["foo","bar","baz"]
-- [(1,"foo"), (2,"bar"), (3,"baz")]
enumerate :: [a] -> [(Int, a)]
enumerate :: forall a. [a] -> [(Int, a)]
enumerate = [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..]

-- | split given list of @a@ by given single a, e.g.
--
-- >>> wordsBy (== ':') "bd:3"
-- ["bd", "3"]
wordsBy :: (a -> Bool) -> [a] -> [[a]]
wordsBy :: forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy a -> Bool
p [a]
s = case (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p [a]
s of
  [] -> []
  a
s' : [a]
rest -> (a
s' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
w) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy a -> Bool
p (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
s'')
    where
      ([a]
w, [a]
s'') = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
rest

matchMaybe :: Maybe a -> Maybe a -> Maybe a
matchMaybe :: forall a. Maybe a -> Maybe a -> Maybe a
matchMaybe Maybe a
Nothing Maybe a
y = Maybe a
y
matchMaybe Maybe a
x Maybe a
_ = Maybe a
x

-- Available in Data.Either, but only since 4.10
fromRight :: b -> Either a b -> b
fromRight :: forall b a. b -> Either a b -> b
fromRight b
_ (Right b
b) = b
b
fromRight b
b Either a b
_ = b
b

-- Available in Data.Function, but only since 4.18
applyWhen :: Bool -> (a -> a) -> a -> a
applyWhen :: forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
True a -> a
f a
x = a -> a
f a
x
applyWhen Bool
False a -> a
_ a
x = a
x

-- pair up neighbours in list
pairs :: [a] -> [(a, a)]
pairs :: forall a. [a] -> [(a, a)]
pairs [a]
rs = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
rs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
rs)

-- The following is from Data.Containers.ListUtils, (c) Gershom Bazerman 2018,
-- Used under a BSD 3-clause license
-- https://hackage.haskell.org/package/containers

nubOrd :: (Ord a) => [a] -> [a]
nubOrd :: forall a. Ord a => [a] -> [a]
nubOrd = (a -> a) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn a -> a
forall a. a -> a
id
{-# INLINE nubOrd #-}

nubOrdOn :: (Ord b) => (a -> b) -> [a] -> [a]
nubOrdOn :: forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn a -> b
f = \[a]
xs -> (a -> b) -> Set b -> [a] -> [a]
forall b a. Ord b => (a -> b) -> Set b -> [a] -> [a]
nubOrdOnExcluding a -> b
f Set b
forall a. Set a
Set.empty [a]
xs
{-# INLINE nubOrdOn #-}

nubOrdOnExcluding :: (Ord b) => (a -> b) -> Set b -> [a] -> [a]
nubOrdOnExcluding :: forall b a. Ord b => (a -> b) -> Set b -> [a] -> [a]
nubOrdOnExcluding a -> b
f = Set b -> [a] -> [a]
go
  where
    go :: Set b -> [a] -> [a]
go Set b
_ [] = []
    go Set b
s (a
x : [a]
xs)
      | b
fx b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set b
s = Set b -> [a] -> [a]
go Set b
s [a]
xs
      | Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set b -> [a] -> [a]
go (b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert b
fx Set b
s) [a]
xs
      where
        !fx :: b
fx = a -> b
f a
x

#ifdef __GLASGOW_HASKELL__
{-# INLINABLE [1] nubOrdOnExcluding #-}

{-# RULES
-- Rewrite to a fusible form.
"nubOrdOn" [~1] forall f as s. nubOrdOnExcluding  f s as =
  build (\c n -> foldr (nubOrdOnFB f c) (constNubOn n) as s)

-- Rewrite back to a plain form
"nubOrdOnList" [1] forall f as s.
    foldr (nubOrdOnFB f (:)) (constNubOn []) as s =
       nubOrdOnExcluding f s as
 #-}

nubOrdOnFB :: Ord b
           => (a -> b)
           -> (a -> r -> r)
           -> a
           -> (Set b -> r)
           -> Set b
           -> r
nubOrdOnFB :: forall b a r.
Ord b =>
(a -> b) -> (a -> r -> r) -> a -> (Set b -> r) -> Set b -> r
nubOrdOnFB a -> b
f a -> r -> r
c a
x Set b -> r
r Set b
s
  | b
fx b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set b
s = Set b -> r
r Set b
s
  | Bool
otherwise = a
x a -> r -> r
`c` Set b -> r
r (b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert b
fx Set b
s)
  where !fx :: b
fx = a -> b
f a
x
{-# INLINABLE [0] nubOrdOnFB #-}

constNubOn :: a -> b -> a
constNubOn :: forall a b. a -> b -> a
constNubOn a
x b
_ = a
x
{-# INLINE [0] constNubOn #-}
#endif