-- | Common core functions.
module Sound.Sc3.Common.Base where

import Data.Char {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Ord {- base -}

-- * Function

-- | Unary function.
type Fn1 a b = a -> b

-- | Binary function.
type Fn2 a b c = a -> b -> c

-- | Ternary function.
type Fn3 a b c d = a -> b -> c -> d

-- | Quaternary function.
type Fn4 a b c d e = a -> b -> c -> d -> e

-- | 5-parameter function.
type Fn5 a b c d e f = a -> b -> c -> d -> e -> f

-- | 6-parameter function.
type Fn6 a b c d e f g = a -> b -> c -> d -> e -> f -> g

-- | 10-parameter function.
type Fn10 a b c d e f g h i j k = a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k

-- | 11-parameter function.
type Fn11 a b c d e f g h i j k l = a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l

-- | Apply /f/ n times, ie. iterate f x !! n
--
-- > iter 3 (* 2) 1 == 8
-- > iterate (* 2) 1 !! 3 == 8
iter :: Int -> (a -> a) -> a -> a
iter :: forall a. Int -> (a -> a) -> a -> a
iter Int
n a -> a
f a
x = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then a
x else a -> a
f (forall a. Int -> (a -> a) -> a -> a
iter (Int
n forall a. Num a => a -> a -> a
- Int
1) a -> a
f a
x)

-- * Functor

-- | This is the same function as Control.Monad.void, which however hugs does not know of.
fvoid :: Functor f => f a -> f ()
fvoid :: forall (f :: * -> *) a. Functor f => f a -> f ()
fvoid = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ())

-- * Read

-- | Variant of 'reads' requiring exact match.
reads_exact :: Read a => String -> Maybe a
reads_exact :: forall a. Read a => [Char] -> Maybe a
reads_exact [Char]
s =
    case forall a. Read a => ReadS a
reads [Char]
s of
      [(a
r,[Char]
"")] -> forall a. a -> Maybe a
Just a
r
      [(a, [Char])]
_ -> forall a. Maybe a
Nothing

-- * String

{- | Similar to Data.List.Split.splitOn, which however hugs doesn't know of.

> string_split_at_char ':' "/usr/local/bin:/usr/bin:/bin" == ["/usr/local/bin","/usr/bin","/bin"]
> string_split_at_char ':' "/usr/local/bin" == ["/usr/local/bin"]
-}
string_split_at_char :: Char -> String -> [String]
string_split_at_char :: Char -> [Char] -> [[Char]]
string_split_at_char Char
c [Char]
s =
  case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
c) [Char]
s of
    ([Char]
lhs,[]) -> [[Char]
lhs]
    ([Char]
lhs,Char
_:[Char]
rhs) -> [Char]
lhs forall a. a -> [a] -> [a]
: Char -> [Char] -> [[Char]]
string_split_at_char Char
c [Char]
rhs

-- * String / Case

-- | Ci = Case insensitive, Cs = case sensitive, Sci = separator & case insensitive
data Case_Rule = Ci | Cs | Sci deriving (Case_Rule -> Case_Rule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Case_Rule -> Case_Rule -> Bool
$c/= :: Case_Rule -> Case_Rule -> Bool
== :: Case_Rule -> Case_Rule -> Bool
$c== :: Case_Rule -> Case_Rule -> Bool
Eq)

{- | String equality with 'Case_Rule'.

> string_eq Ci "sinOsc" "SinOsc" == True
> string_eq Sci "sin-osc" "SinOsc" == True
-}
string_eq :: Case_Rule -> String -> String -> Bool
string_eq :: Case_Rule -> [Char] -> [Char] -> Bool
string_eq Case_Rule
cr [Char]
x [Char]
y =
  let ci_form :: [Char] -> [Char]
ci_form = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
      sci_form :: [Char] -> [Char]
sci_form = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
"-_") forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
ci_form
  in case Case_Rule
cr of
       Case_Rule
Ci -> [Char] -> [Char]
ci_form [Char]
x forall a. Eq a => a -> a -> Bool
== [Char] -> [Char]
ci_form [Char]
y
       Case_Rule
Cs -> [Char]
x forall a. Eq a => a -> a -> Bool
== [Char]
y
       Case_Rule
Sci -> [Char] -> [Char]
sci_form [Char]
x forall a. Eq a => a -> a -> Bool
== [Char] -> [Char]
sci_form [Char]
y

-- | 'rlookup_by' of 'string_eq'.
rlookup_str :: Case_Rule -> String -> [(a,String)] -> Maybe a
rlookup_str :: forall a. Case_Rule -> [Char] -> [(a, [Char])] -> Maybe a
rlookup_str = forall b a. (b -> b -> Bool) -> b -> [(a, b)] -> Maybe a
rlookup_by forall b c a. (b -> c) -> (a -> b) -> a -> c
. Case_Rule -> [Char] -> [Char] -> Bool
string_eq

{- | 'Enum' parser with 'Case_Rule'.

> parse_enum Ci "false" == Just False
-}
parse_enum :: (Show t,Enum t,Bounded t) => Case_Rule -> String -> Maybe t
parse_enum :: forall t.
(Show t, Enum t, Bounded t) =>
Case_Rule -> [Char] -> Maybe t
parse_enum Case_Rule
cr [Char]
nm =
    let u :: [t]
u = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
        t :: [([Char], t)]
t = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [t]
u) [t]
u
    in forall a t b. (a -> t -> Bool) -> a -> [(t, b)] -> Maybe b
lookup_by (Case_Rule -> [Char] -> [Char] -> Bool
string_eq Case_Rule
cr) [Char]
nm [([Char], t)]
t

-- * List

-- | Left to right composition of a list of functions.
--
-- > compose_l [(* 2),(+ 1)] 3 == 7
compose_l :: [t -> t] -> t -> t
compose_l :: forall t. [t -> t] -> t -> t
compose_l = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\t
x t -> t
f -> t -> t
f t
x))

-- | Right to left composition of a list of functions.
--
-- > compose_r [(* 2),(+ 1)] 3 == 8
compose_r :: [t -> t] -> t -> t
compose_r :: forall t. [t -> t] -> t -> t
compose_r = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (a -> b) -> a -> b
($))

{- | SequenceableCollection.differentiate

> > [3,4,1,1].differentiate == [3,1,-3,0]

> d_dx [3,4,1,1] == [3,1,-3,0]
> d_dx [0,1,3,6] == [0,1,2,3]
-}
d_dx :: (Num a) => [a] -> [a]
d_dx :: forall a. Num a => [a] -> [a]
d_dx [a]
l = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [a]
l (a
0forall a. a -> [a] -> [a]
:[a]
l)

{- | Variant that does not prepend zero to input, ie. 'tail' of 'd_dx'.

> d_dx' [3,4,1,1] == [1,-3,0]
> d_dx' [0,1,3,6] == [1,2,3]
-}
d_dx' :: Num n => [n] -> [n]
d_dx' :: forall a. Num a => [a] -> [a]
d_dx' [n]
l = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (forall a. [a] -> [a]
tail [n]
l) [n]
l

{- | SequenceableCollection.integrate

> > [3,4,1,1].integrate == [3,7,8,9]

> dx_d [3,4,1,1] == [3,7,8,9]
> dx_d (d_dx [0,1,3,6]) == [0,1,3,6]
> dx_d [0.5,0.5] == [0.5,1]
-}
dx_d :: Num n => [n] -> [n]
dx_d :: forall a. Num a => [a] -> [a]
dx_d = forall a. (a -> a -> a) -> [a] -> [a]
scanl1 forall a. Num a => a -> a -> a
(+)

{- | Variant pre-prending zero to output.

> dx_d' [3,4,1,1] == [0,3,7,8,9]
> dx_d' (d_dx' [0,1,3,6]) == [0,1,3,6]
> dx_d' [0.5,0.5] == [0,0.5,1]
-}
dx_d' :: Num n => [n] -> [n]
dx_d' :: forall a. Num a => [a] -> [a]
dx_d' = (n
0 forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => [a] -> [a]
dx_d

-- | 'lookup' with equality function.
lookup_by :: (a -> t -> Bool) -> a -> [(t,b)] -> Maybe b
lookup_by :: forall a t b. (a -> t -> Bool) -> a -> [(t, b)] -> Maybe b
lookup_by a -> t -> Bool
f a
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (a -> t -> Bool
f a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | Erroring variant.
lookup_by_err :: (a -> t -> Bool) -> a -> [(t,b)] -> b
lookup_by_err :: forall a t b. (a -> t -> Bool) -> a -> [(t, b)] -> b
lookup_by_err a -> t -> Bool
f a
x = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"lookup_by") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a t b. (a -> t -> Bool) -> a -> [(t, b)] -> Maybe b
lookup_by a -> t -> Bool
f a
x

-- | Reverse 'lookup' with equality function.
rlookup_by :: (b -> b -> Bool) -> b -> [(a,b)] -> Maybe a
rlookup_by :: forall b a. (b -> b -> Bool) -> b -> [(a, b)] -> Maybe a
rlookup_by b -> b -> Bool
f b
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (b -> b -> Bool
f b
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

-- | (prev,cur,next) triples.
--
-- > pcn_triples [1..3] == [(Nothing,1,Just 2),(Just 1,2,Just 3),(Just 2,3,Nothing)]
pcn_triples :: [a] -> [(Maybe a,a,Maybe a)]
pcn_triples :: forall a. [a] -> [(Maybe a, a, Maybe a)]
pcn_triples =
    let f :: Maybe a -> [a] -> [(Maybe a, a, Maybe a)]
f Maybe a
e [a]
l = case [a]
l of
                  a
e1 : a
e2 : [a]
l' -> (Maybe a
e,a
e1,forall a. a -> Maybe a
Just a
e2) forall a. a -> [a] -> [a]
: Maybe a -> [a] -> [(Maybe a, a, Maybe a)]
f (forall a. a -> Maybe a
Just a
e1) (a
e2 forall a. a -> [a] -> [a]
: [a]
l')
                  [a
e'] -> [(Maybe a
e,a
e',forall a. Maybe a
Nothing)]
                  [] -> forall a. HasCallStack => a
undefined
    in forall {a}. Maybe a -> [a] -> [(Maybe a, a, Maybe a)]
f forall a. Maybe a
Nothing

-- | Separate first list element.
--
-- > sep_first "astring" == Just ('a',"string")
sep_first :: [t] -> Maybe (t,[t])
sep_first :: forall t. [t] -> Maybe (t, [t])
sep_first [t]
l =
    case [t]
l of
      t
e:[t]
l' -> forall a. a -> Maybe a
Just (t
e,[t]
l')
      [t]
_ -> forall a. Maybe a
Nothing

-- | Separate last list element.
--
-- > sep_last "stringb" == Just ("string",'b')
sep_last :: [t] -> Maybe ([t], t)
sep_last :: forall t. [t] -> Maybe ([t], t)
sep_last =
    let f :: (b, [a]) -> ([a], b)
f (b
e,[a]
l) = (forall a. [a] -> [a]
reverse [a]
l,b
e)
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {b} {a}. (b, [a]) -> ([a], b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. [t] -> Maybe (t, [t])
sep_first forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | Are lists of equal length?
--
-- > equal_length_p ["t1","t2"] == True
-- > equal_length_p ["t","t1","t2"] == False
equal_length_p :: [[a]] -> Bool
equal_length_p :: forall a. [[a]] -> Bool
equal_length_p = (forall a. Eq a => a -> a -> Bool
== Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length

-- | Histogram
histogram :: Ord a => [a] -> [(a,Int)]
histogram :: forall a. Ord a => [a] -> [(a, Int)]
histogram [a]
x =
    let g :: [[a]]
g = forall a. Eq a => [a] -> [[a]]
group (forall a. Ord a => [a] -> [a]
sort [a]
x)
    in forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head [[a]]
g) (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
g)

-- | !! with localised error message
at_with_error_message :: String -> [t] -> Int -> t
at_with_error_message :: forall t. [Char] -> [t] -> Int -> t
at_with_error_message [Char]
msg [t]
list Int
index =
  if Int
index forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [t]
list
  then forall a. HasCallStack => [Char] -> a
error ([Char]
"!!: index out of range: " forall a. [a] -> [a] -> [a]
++ [Char]
msg)
  else [t]
list forall a. [a] -> Int -> a
!! Int
index

-- | concat of intersperse.  This is the same function as intercalate, which hugs doesn't know of.
concat_intersperse :: [a] -> [[a]] -> [a]
concat_intersperse :: forall a. [a] -> [[a]] -> [a]
concat_intersperse [a]
x = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse [a]
x

{- | Similar to Data.List.Split.splitOn, which however hugs doesn't know of.

> list_split_at_elem ' ' "a sequence of words" == ["a","sequence","of","words"]
-}
list_split_at_elem :: Eq t => t -> [t] -> [[t]]
list_split_at_elem :: forall t. Eq t => t -> [t] -> [[t]]
list_split_at_elem t
c [t]
s =
  case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== t
c) [t]
s of
    ([t]
lhs,[]) -> [[t]
lhs]
    ([t]
lhs,t
_:[t]
rhs) -> [t]
lhs forall a. a -> [a] -> [a]
: forall t. Eq t => t -> [t] -> [[t]]
list_split_at_elem t
c [t]
rhs

{- | Data.List.sortOn, which however hugs does not know of.

> sort_on snd [('a',1),('b',0)] == [('b',0),('a',1)]
-}
sort_on :: (Ord b) => (a -> b) -> [a] -> [a]
sort_on :: forall b a. Ord b => (a -> b) -> [a] -> [a]
sort_on = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing

{- | Inserts at the first position where it compares less but not equal to the next element.

> import Data.Function {- base -}
> insertBy (compare `on` fst) (3,'x') (zip [1..5] ['a'..])
> insertBy_post (compare `on` fst) (3,'x') (zip [1..5] ['a'..])
-}
insertBy_post :: (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy_post :: forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy_post a -> a -> Ordering
cmp a
e [a]
l =
    case [a]
l of
      [] -> [a
e]
      a
h:[a]
l' -> case a -> a -> Ordering
cmp a
e a
h of
                Ordering
LT -> a
e forall a. a -> [a] -> [a]
: [a]
l
                Ordering
_ -> a
h forall a. a -> [a] -> [a]
: forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy_post a -> a -> Ordering
cmp a
e [a]
l'

-- | 'insertBy_post' using 'compare'.
insert_post :: Ord t => t -> [t] -> [t]
insert_post :: forall t. Ord t => t -> [t] -> [t]
insert_post = forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy_post forall a. Ord a => a -> a -> Ordering
compare

-- | Apply /f/ at all but last element, and /g/ at last element.
--
-- > at_last (* 2) negate [1..4] == [2,4,6,-4]
at_last :: (a -> b) -> (a -> b) -> [a] -> [b]
at_last :: forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
at_last a -> b
f a -> b
g [a]
x =
    case [a]
x of
      [] -> []
      [a
i] -> [a -> b
g a
i]
      a
i:[a]
x' -> a -> b
f a
i forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
at_last a -> b
f a -> b
g [a]
x'

-- * Tuples

-- | Zip two 4-tuples.
p4_zip :: (a,b,c,d) -> (e,f,g,h) -> ((a,e),(b,f),(c,g),(d,h))
p4_zip :: forall a b c d e f g h.
(a, b, c, d) -> (e, f, g, h) -> ((a, e), (b, f), (c, g), (d, h))
p4_zip (a
a,b
b,c
c,d
d) (e
e,f
f,g
g,h
h) = ((a
a,e
e),(b
b,f
f),(c
c,g
g),(d
d,h
h))

-- | Two-tuple.
type T2 a = (a,a)

-- | Three-tuple.
type T3 a = (a,a,a)

-- | Four-tuple.
type T4 a = (a,a,a,a)

-- | t -> (t,t)
dup2 :: t -> T2 t
dup2 :: forall t. t -> T2 t
dup2 t
t = (t
t,t
t)

-- | t -> (t,t,t)
dup3 :: t -> T3 t
dup3 :: forall t. t -> T3 t
dup3 t
t = (t
t,t
t,t
t)

-- | t -> (t,t,t,t)
dup4 :: t -> T4 t
dup4 :: forall t. t -> T4 t
dup4 t
t = (t
t,t
t,t
t,t
t)

-- | 'concatMap' of /f/ at /x/ and /g/ at /y/.
mk_duples :: (a -> c) -> (b -> c) -> [(a, b)] -> [c]
mk_duples :: forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
mk_duples a -> c
a b -> c
b = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
x,b
y) -> [a -> c
a a
x, b -> c
b b
y])

-- | Length prefixed list variant of 'mk_duples'.
mk_duples_l :: (Int -> c) -> (a -> c) -> (b -> c) -> [(a,[b])] -> [c]
mk_duples_l :: forall c a b.
(Int -> c) -> (a -> c) -> (b -> c) -> [(a, [b])] -> [c]
mk_duples_l Int -> c
i a -> c
a b -> c
b = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
x,[b]
y) -> a -> c
a a
x forall a. a -> [a] -> [a]
: Int -> c
i (forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
y) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map b -> c
b [b]
y)

-- | 'concatMap' of /f/ at /x/ and /g/ at /y/ and /h/ at /z/.
mk_triples :: (a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]
mk_triples :: forall a d b c.
(a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]
mk_triples a -> d
a b -> d
b c -> d
c = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
x,b
y,c
z) -> [a -> d
a a
x, b -> d
b b
y, c -> d
c c
z])

-- | [x,y] -> (x,y)
t2_from_list :: [t] -> T2 t
t2_from_list :: forall t. [t] -> T2 t
t2_from_list [t]
l = case [t]
l of {[t
p,t
q] -> (t
p,t
q);[t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"t2_from_list"}

-- | [x,y,z] -> (x,y,z)
t3_from_list :: [t] -> (t,t,t)
t3_from_list :: forall t. [t] -> (t, t, t)
t3_from_list [t]
l = case [t]
l of {[t
p,t
q,t
r] -> (t
p,t
q,t
r);[t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"t3_from_list"}