-- | Database as [[(key,value)]]
module Music.Theory.Db.Common where

import Data.List {- base -}
import Data.Maybe {- base -}
import Safe {- safe -}

import qualified Music.Theory.List as T {- hmt-base -}
import qualified Music.Theory.Maybe as T {- hmt-base -}

-- * Type

type Entry k v = (k,v)
type Record k v = [Entry k v]
type Db k v = [Record k v]

type Key = String
type Value = String
type Entry' = Entry Key Value
type Record' = Record Key Value
type Db' = Db Key Value

-- * Record

-- | The sequence of keys at 'Record'.
record_key_seq :: Record k v -> [k]
record_key_seq :: forall k v. Record k v -> [k]
record_key_seq = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst

-- | 'True' if 'Key' is present in 'Entity'.
record_has_key :: Eq k => k -> Record k v -> Bool
record_has_key :: forall k v. Eq k => k -> Record k v -> Bool
record_has_key k
k = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem k
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Record k v -> [k]
record_key_seq

-- | 'T.histogram' of 'record_key_seq'.
record_key_histogram :: Ord k => Record k v -> [(k,Int)]
record_key_histogram :: forall k v. Ord k => Record k v -> [(k, Int)]
record_key_histogram = forall a. Ord a => [a] -> [(a, Int)]
T.histogram forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Record k v -> [k]
record_key_seq

-- | Duplicate keys predicate.
record_has_duplicate_keys :: Ord k => Record k v -> Bool
record_has_duplicate_keys :: forall k v. Ord k => Record k v -> Bool
record_has_duplicate_keys = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Ord a => a -> a -> Bool
> Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Ord k => Record k v -> [(k, Int)]
record_key_histogram

-- | Find all associations for key using given equality function.
record_lookup_by :: (k -> k -> Bool) -> k -> Record k v -> [v]
record_lookup_by :: forall k v. (k -> k -> Bool) -> k -> Record k v -> [v]
record_lookup_by k -> k -> Bool
f k
k = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (k -> k -> Bool
f k
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | 'record_lookup_by' of '=='.
record_lookup :: Eq k => k -> Record k v -> [v]
record_lookup :: forall k v. Eq k => k -> Record k v -> [v]
record_lookup = forall k v. (k -> k -> Bool) -> k -> Record k v -> [v]
record_lookup_by forall a. Eq a => a -> a -> Bool
(==)

-- | /n/th element of 'record_lookup'.
record_lookup_at :: Eq k => (k,Int) -> Record k v -> Maybe v
record_lookup_at :: forall k v. Eq k => (k, Int) -> Record k v -> Maybe v
record_lookup_at (k
c,Int
n) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. [a] -> Int -> Maybe a
atMay Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Eq k => k -> Record k v -> [v]
record_lookup k
c

-- | Variant of 'record_lookup' requiring a unique key.  'Nothing' indicates
-- there is no entry, it is an 'error' if duplicate keys are present.
record_lookup_uniq :: Eq k => k -> Record k v -> Maybe v
record_lookup_uniq :: forall k v. Eq k => k -> Record k v -> Maybe v
record_lookup_uniq k
k Record k v
r =
    case forall k v. Eq k => k -> Record k v -> [v]
record_lookup k
k Record k v
r of
      [] -> forall a. Maybe a
Nothing
      [v
v] -> forall a. a -> Maybe a
Just v
v
      [v]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"record_lookup_uniq: non uniq"

-- | 'True' if key exists and is unique.
record_has_key_uniq :: Eq k => k -> Record k v -> Bool
record_has_key_uniq :: forall k v. Eq k => k -> Record k v -> Bool
record_has_key_uniq k
k = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Eq k => k -> Record k v -> Maybe v
record_lookup_uniq k
k

-- | Error variant.
record_lookup_uniq_err :: Eq k => k -> Record k v -> v
record_lookup_uniq_err :: forall k v. Eq k => k -> Record k v -> v
record_lookup_uniq_err k
k = forall a. [Char] -> Maybe a -> a
T.from_just [Char]
"record_lookup_uniq: none" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Eq k => k -> Record k v -> Maybe v
record_lookup_uniq k
k

-- | Default value variant.
record_lookup_uniq_def :: Eq k => v -> k -> Record k v -> v
record_lookup_uniq_def :: forall k v. Eq k => v -> k -> Record k v -> v
record_lookup_uniq_def v
v k
k = forall a. a -> Maybe a -> a
fromMaybe v
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Eq k => k -> Record k v -> Maybe v
record_lookup_uniq k
k

-- | Remove all associations for key using given equality function.
record_delete_by :: (k -> k -> Bool) -> k -> Record k v -> Record k v
record_delete_by :: forall k v. (k -> k -> Bool) -> k -> Record k v -> Record k v
record_delete_by k -> k -> Bool
f k
k = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> k -> Bool
f k
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | 'record_delete_by' of '=='.
record_delete :: Eq k => k -> Record k v -> Record k v
record_delete :: forall k v. Eq k => k -> Record k v -> Record k v
record_delete = forall k v. (k -> k -> Bool) -> k -> Record k v -> Record k v
record_delete_by forall a. Eq a => a -> a -> Bool
(==)

-- * Db

-- | Preserves order of occurence.
db_key_set :: Ord k => Db k v -> [k]
db_key_set :: forall k v. Ord k => Db k v -> [k]
db_key_set = 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 a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

db_lookup_by :: (k -> k -> Bool) -> (v -> v -> Bool) -> k -> v -> Db k v -> [Record k v]
db_lookup_by :: forall k v.
(k -> k -> Bool) -> (v -> v -> Bool) -> k -> v -> Db k v -> Db k v
db_lookup_by k -> k -> Bool
k_cmp v -> v -> Bool
v_cmp k
k v
v =
    let f :: Record k v -> Bool
f = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (v -> v -> Bool
v_cmp v
v) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (k -> k -> Bool) -> k -> Record k v -> [v]
record_lookup_by k -> k -> Bool
k_cmp k
k
    in forall a. (a -> Bool) -> [a] -> [a]
filter Record k v -> Bool
f

db_lookup :: (Eq k,Eq v) => k -> v -> Db k v -> [Record k v]
db_lookup :: forall k v. (Eq k, Eq v) => k -> v -> Db k v -> Db k v
db_lookup = forall k v.
(k -> k -> Bool) -> (v -> v -> Bool) -> k -> v -> Db k v -> Db k v
db_lookup_by forall a. Eq a => a -> a -> Bool
(==) forall a. Eq a => a -> a -> Bool
(==)

db_has_duplicate_keys :: Ord k => Db k v -> Bool
db_has_duplicate_keys :: forall k v. Ord k => Db k v -> Bool
db_has_duplicate_keys = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall k v. Ord k => Record k v -> Bool
record_has_duplicate_keys

db_key_histogram :: Ord k => Db k v -> [(k,Int)]
db_key_histogram :: forall k v. Ord k => Db k v -> [(k, Int)]
db_key_histogram Db k v
db =
    let h :: [(k, Int)]
h = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall k v. Ord k => Record k v -> [(k, Int)]
record_key_histogram Db k v
db
        f :: k -> (k, Int)
f k
k = (k
k,forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall k v. Eq k => k -> Record k v -> [v]
record_lookup k
k [(k, Int)]
h))
    in forall a b. (a -> b) -> [a] -> [b]
map k -> (k, Int)
f (forall k v. Ord k => Db k v -> [k]
db_key_set Db k v
db)

db_to_table :: Ord k => (Maybe v -> e) -> Db k v -> ([k],[[e]])
db_to_table :: forall k v e. Ord k => (Maybe v -> e) -> Db k v -> ([k], [[e]])
db_to_table Maybe v -> e
f Db k v
db =
    let kh :: [(k, Int)]
kh = forall k v. Ord k => Db k v -> [(k, Int)]
db_key_histogram Db k v
db
        hdr :: [k]
hdr = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(k
k,Int
n) -> forall a. Int -> a -> [a]
replicate Int
n k
k) [(k, Int)]
kh
        ix :: [(k, Int)]
ix = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(k
k,Int
n) -> forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat k
k) [Int
0 .. Int
n forall a. Num a => a -> a -> a
- Int
1]) [(k, Int)]
kh
    in ([k]
hdr,forall a b. (a -> b) -> [a] -> [b]
map (\Record k v
r -> forall a b. (a -> b) -> [a] -> [b]
map (\(k, Int)
i -> Maybe v -> e
f (forall k v. Eq k => (k, Int) -> Record k v -> Maybe v
record_lookup_at (k, Int)
i Record k v
r)) [(k, Int)]
ix) Db k v
db)

-- * Collating duplicate keys.

record_collate_from :: Eq k => (k,[v]) -> Record k v -> Record k [v]
record_collate_from :: forall k v. Eq k => (k, [v]) -> Record k v -> Record k [v]
record_collate_from (k
k,[v]
v) Record k v
r =
    case Record k v
r of
      [] -> [(k
k,forall a. [a] -> [a]
reverse [v]
v)]
      (k
k',v
v'):Record k v
r' ->
          if k
k forall a. Eq a => a -> a -> Bool
== k
k'
          then forall k v. Eq k => (k, [v]) -> Record k v -> Record k [v]
record_collate_from (k
k,v
v' forall a. a -> [a] -> [a]
: [v]
v) Record k v
r'
          else (k
k,forall a. [a] -> [a]
reverse [v]
v) forall a. a -> [a] -> [a]
: forall k v. Eq k => (k, [v]) -> Record k v -> Record k [v]
record_collate_from (k
k',[v
v']) Record k v
r'

-- | Collate adjacent entries of existing sequence with equal key.
record_collate :: Eq k => Record k v -> Record k [v]
record_collate :: forall k v. Eq k => Record k v -> Record k [v]
record_collate Record k v
r =
    case Record k v
r of
      [] -> forall a. HasCallStack => [Char] -> a
error [Char]
"record_collate: nil"
      (k
k,v
v):Record k v
r' -> forall k v. Eq k => (k, [v]) -> Record k v -> Record k [v]
record_collate_from (k
k,[v
v]) Record k v
r'

record_uncollate :: Record k [v] -> Record k v
record_uncollate :: forall k v. Record k [v] -> Record k v
record_uncollate = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(k
k,[v]
v) -> forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat k
k) [v]
v)