{-# LANGUAGE RankNTypes #-}
module Fadno.Util where

import Control.Applicative
import Control.Monad (replicateM)
import Test.HUnit
import Data.List
import Data.Function (on)
import qualified Debug.Trace as T
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Monad.State
import Control.Lens

-- compute intervals
diff :: Num a => [a] -> [a]
diff :: [a] -> [a]
diff = (a -> a -> a) -> [a] -> [a]
forall a c. (a -> a -> c) -> [a] -> [c]
zipTail ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-))

-- a simple reducer.
-- quicksilver says: zip`ap`tail - the Aztec god of consecutive numbers
zipTail :: (a -> a -> c) -> [a] -> [c]
zipTail :: (a -> a -> c) -> [a] -> [c]
zipTail a -> a -> c
f = (a -> a -> c) -> [a] -> [a] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> c
f ([a] -> [a] -> [c]) -> ([a] -> [a]) -> [a] -> [c]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> [a]
forall a. [a] -> [a]
tail

-- opposite of diff, compute concrete notes from intervals
integ :: Int -> [Int] -> [Int]
integ :: Int -> [Int] -> [Int]
integ = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)

-- | 'Debug.Trace.trace' with brackets.
trace :: String -> a -> a
trace :: String -> a -> a
trace String
s = String -> a -> a
forall a. String -> a -> a
T.trace (String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">")
-- | trace with output of result.
trace' :: Show a => String -> a -> a
trace' :: String -> a -> a
trace' String
s a
a = String -> a -> a -> a
forall b a. Show b => String -> b -> a -> a
trace1 String
s a
a a
a
-- | trace with extra variable, not showing result.
trace1 :: Show b => String -> b -> a -> a
trace1 :: String -> b -> a -> a
trace1 String
s b
a = String -> a -> a
forall a. String -> a -> a
trace (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
a)
-- | trace with extra variable and output of result.
trace1' :: (Show a, Show b) => String -> b -> a -> a
trace1' :: String -> b -> a -> a
trace1' String
s b
a a
b = String -> a -> a
forall a. String -> a -> a
trace (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b) a
b



-- | pop items off a stateful list, use for monadic function.
popping :: (MonadState s m) => Int -> Lens' s [a] -> ([a] -> m b) -> m b
popping :: Int -> Lens' s [a] -> ([a] -> m b) -> m b
popping Int
n Lens' s [a]
l [a] -> m b
f = do
  [a]
as <- Getting [a] s [a] -> m [a]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [a] s [a]
Lens' s [a]
l
  ([a] -> Identity [a]) -> s -> Identity s
Lens' s [a]
l (([a] -> Identity [a]) -> s -> Identity s) -> [a] -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
as
  [a] -> m b
f (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
as)

-- | 'popping' but only runs function if popped items are non-empty
popping' :: (MonadState s m) => Int -> Lens' s [a] -> ([a] -> m b) -> m (Maybe b)
popping' :: Int -> Lens' s [a] -> ([a] -> m b) -> m (Maybe b)
popping' Int
n Lens' s [a]
l [a] -> m b
f = Int -> Lens' s [a] -> ([a] -> m (Maybe b)) -> m (Maybe b)
forall s (m :: * -> *) a b.
MonadState s m =>
Int -> Lens' s [a] -> ([a] -> m b) -> m b
popping Int
n Lens' s [a]
l
                     (\[a]
as -> if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
as then Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing else b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> m b -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> m b
f [a]
as)

-- | popping with only head
popping1 :: (MonadState s m) => Lens' s [a] -> (a -> m b) -> m (Maybe b)
popping1 :: Lens' s [a] -> (a -> m b) -> m (Maybe b)
popping1 Lens' s [a]
l a -> m b
f = Int -> Lens' s [a] -> ([a] -> m b) -> m (Maybe b)
forall s (m :: * -> *) a b.
MonadState s m =>
Int -> Lens' s [a] -> ([a] -> m b) -> m (Maybe b)
popping' Int
1 Lens' s [a]
l (a -> m b
f (a -> m b) -> ([a] -> a) -> [a] -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. [a] -> a
head)

-- | 'succ' with wraparound.
wrapSucc :: (Bounded a, Enum a, Eq a) => a -> a
wrapSucc :: a -> a
wrapSucc a
s = if a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
maxBound then a
forall a. Bounded a => a
minBound else a -> a
forall a. Enum a => a -> a
succ a
s
-- | 'pred' with wraparound.
wrapPred :: (Bounded a, Enum a, Eq a) => a -> a
wrapPred :: a -> a
wrapPred a
s = if a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
minBound then a
forall a. Bounded a => a
maxBound else a -> a
forall a. Enum a => a -> a
pred a
s

-- | do monadic 'over' -- '(%=)' -- with pass-through of (before,after)
mutating :: MonadState s m => Lens' s a -> (a -> a) -> m (a,a)
mutating :: Lens' s a -> (a -> a) -> m (a, a)
mutating Lens' s a
l a -> a
f = do
  a
a <- Getting a s a -> m a
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting a s a
Lens' s a
l
  a
a' <- (a -> Identity a) -> s -> Identity s
Lens' s a
l ((a -> Identity a) -> s -> Identity s) -> a -> m a
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= a -> a
f a
a
  (a, a) -> m (a, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,a
a')

-- | reorganize 'maybe' for chaining on Just
maybe' :: Maybe a -> b -> (a -> b) -> b
maybe' :: Maybe a -> b -> (a -> b) -> b
maybe' Maybe a
m b
n a -> b
j = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
n a -> b
j Maybe a
m

median :: Integral a => [a] -> Maybe a
median :: [a] -> Maybe a
median [] = Maybe a
forall a. Maybe a
Nothing
median [a]
ls = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
len then [a]
sorted [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
mid
                   else ([a]
sorted [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
mid a -> a -> a
forall a. Num a => a -> a -> a
+ [a]
sorted [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2
    where len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls
          sorted :: [a]
sorted = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
ls
          mid :: Int
mid = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2





-- subtract all by minimum to "normalize" around 0
normalize :: (Num a, Ord a) => [a] -> [a]
normalize :: [a] -> [a]
normalize [a]
l = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) (a -> a -> a) -> a -> a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [a]
l) [a]
l

-- PC rules state you must rotate the scale through the gamut,
-- and selecting for the least distance from tail -> head, tail-1 -> head, etc.
-- Line can be any melody, gets normalized to gamut.
pitchClassSet :: Int -> [Int] -> [Int]
pitchClassSet :: Int -> [Int] -> [Int]
pitchClassSet Int
gamut [Int]
line = let
    modg :: Int -> Int
modg = (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
gamut
    norm :: [Int]
norm = [Int] -> [Int]
forall a. (Num a, Ord a) => [a] -> [a]
normalize ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
modg ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
line
    -- rotate through gamut
    alts :: [[Int]]
alts = [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (Int -> [Int]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> [Int] -> [Int]
forall a. (Num a, Ord a) => [a] -> [a]
normalize ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int
modg (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+)) [Int]
norm) [Int
0..(Int
gamutInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
    -- compute "values" as distance from head, reversed
    vals :: [[Int]]
vals = ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
x -> [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) ([Int] -> Int
forall a. [a] -> a
head [Int]
x)) [Int]
x) [[Int]]
alts
    min :: [Int]
min = [[Int]] -> [Int]
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [[Int]]
vals
    in ([Int], [Int]) -> [Int]
forall a b. (a, b) -> a
fst (([Int], [Int]) -> [Int])
-> ([([Int], [Int])] -> ([Int], [Int]))
-> [([Int], [Int])]
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Int], [Int]) -> ([Int], [Int]) -> Ordering)
-> [([Int], [Int])] -> ([Int], [Int])
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy ([Int] -> [Int] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Int] -> [Int] -> Ordering)
-> (([Int], [Int]) -> [Int])
-> ([Int], [Int])
-> ([Int], [Int])
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([Int], [Int]) -> [Int]
forall a b. (a, b) -> b
snd) ([([Int], [Int])] -> [Int]) -> [([Int], [Int])] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]] -> [([Int], [Int])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Int]]
alts [[Int]]
vals


lfsr :: Int -> Int -> Int -> [Bool]
lfsr :: Int -> Int -> Int -> [Bool]
lfsr Int
len Int
tap1 Int
tap2 =
    if Int
lenInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
tap1 Bool -> Bool -> Bool
|| Int
lenInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
tap2 Bool -> Bool -> Bool
|| Int
tap1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
tap2 Bool -> Bool -> Bool
|| Int
lenInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
2 then
        String -> [Bool]
forall a. HasCallStack => String -> a
error (String
"lfsr: invalid arguments: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int
len,Int
tap1,Int
tap2])
    else
        (([Bool], Bool) -> Bool) -> [([Bool], Bool)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool], Bool) -> Bool
forall a b. (a, b) -> b
snd ([([Bool], Bool)] -> [Bool])
-> ([Bool] -> [([Bool], Bool)]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [([Bool], Bool)]
shift ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
len Bool
True where
            shift :: [Bool] -> [([Bool], Bool)]
shift [Bool]
r = ([Bool], Bool)
v([Bool], Bool) -> [([Bool], Bool)] -> [([Bool], Bool)]
forall a. a -> [a] -> [a]
:([Bool], Bool) -> [([Bool], Bool)]
next ([Bool], Bool)
v where v :: ([Bool], Bool)
v = ([Bool]
r, [Bool]
r [Bool] -> Int -> Bool
forall a. [a] -> Int -> a
!! Int
tap1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= [Bool]
r [Bool] -> Int -> Bool
forall a. [a] -> Int -> a
!! Int
tap2)
            next :: ([Bool], Bool) -> [([Bool], Bool)]
next ([Bool]
register,Bool
prev) = [Bool] -> [([Bool], Bool)]
shift ([Bool] -> [([Bool], Bool)]) -> [Bool] -> [([Bool], Bool)]
forall a b. (a -> b) -> a -> b
$ Bool
prevBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
register

-- | generate "A" .. "Z", "AA" .. "AZ", "BA" .. "BZ", .. "AAA" etc
rehMarks :: [String]
rehMarks :: [String]
rehMarks = [String]
a [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String) -> [String] -> [String -> String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
a [String -> String] -> [String] -> [String]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String]
a) where a :: [String]
a = (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) [Char
'A'..Char
'Z']

-- apply 'i' rotations to list
rotate :: Int -> [a] -> [a]
rotate :: Int -> [a] -> [a]
rotate Int
i [a]
l = (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a b. a -> b -> a
const (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
i ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
cycle [a]
l) [a]
l

-- get all rotations of a list
rotations :: [a] -> [[a]]
rotations :: [a] -> [[a]]
rotations [a]
l = (Int -> [a] -> [a]) -> [a] -> Int -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
rotate [a]
l (Int -> [a]) -> [Int] -> [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1..([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l)]

-- Cartesian product of specified dimension
allTuples :: Int -> [a] -> [[a]]
allTuples :: Int -> [a] -> [[a]]
allTuples = Int -> [a] -> [[a]]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM

monotonic :: [Int] -> Bool
monotonic :: [Int] -> Bool
monotonic = (Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>) (Int -> Bool) -> ([Int] -> Int) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ordering] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Ordering] -> Int) -> ([Int] -> [Ordering]) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ordering] -> [Ordering]
forall a. Eq a => [a] -> [a]
nub ([Ordering] -> [Ordering])
-> ([Int] -> [Ordering]) -> [Int] -> [Ordering]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ordering -> Bool) -> [Ordering] -> [Ordering]
forall a. (a -> Bool) -> [a] -> [a]
filter (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([Ordering] -> [Ordering])
-> ([Int] -> [Ordering]) -> [Int] -> [Ordering]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Ordering) -> [Int] -> [Ordering]
forall a c. (a -> a -> c) -> [a] -> [c]
zipTail Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

interleave :: [[a]] -> [a]
interleave :: [[a]] -> [a]
interleave = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([[a]] -> [[a]]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
pivot

pivot :: [[a]] -> [[a]]
pivot :: [[a]] -> [[a]]
pivot [[a]]
chords = (Int -> [a]) -> [Int] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [a]
iter [Int
0..Int
maxLength] where
    maxLength :: Int
maxLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
chords) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    iter :: Int -> [a]
iter Int
i = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
i) [[a]]
chords

filterOnKeys :: (Ord a) => [a] -> M.Map a b -> M.Map a b
filterOnKeys :: [a] -> Map a b -> Map a b
filterOnKeys [a]
ks = (a -> b -> Bool) -> Map a b -> Map a b
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\a
k b
_ -> a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member a
k (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
ks)

pairBy :: (a -> b) -> [a] -> [(a,b)]
pairBy :: (a -> b) -> [a] -> [(a, b)]
pairBy a -> b
f = (a -> (a, b)) -> [a] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
a -> (a
a,a -> b
f a
a))

delim :: String -> [String] -> String
delim :: String -> [String] -> String
delim String
_ []              =  String
""
delim String
_ [String
w]             = String
w
delim String
d (String
w:[String]
ws)          = String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
delim String
d [String]
ws