-- | Extensions to "Data.Maybe".
module Music.Theory.Maybe where

import Data.Maybe {- base -}

-- | Variant with error text.
from_just :: String -> Maybe a -> a
from_just :: forall a. String -> Maybe a -> a
from_just String
err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
err)

-- | Variant of unzip.
--
-- > let r = ([Just 1,Nothing,Just 3],[Just 'a',Nothing,Just 'c'])
-- > in maybe_unzip [Just (1,'a'),Nothing,Just (3,'c')] == r
maybe_unzip :: [Maybe (a,b)] -> ([Maybe a],[Maybe b])
maybe_unzip :: forall a b. [Maybe (a, b)] -> ([Maybe a], [Maybe b])
maybe_unzip =
    let f :: Maybe (a, a) -> (Maybe a, Maybe a)
f Maybe (a, a)
x = case Maybe (a, a)
x of
                Maybe (a, a)
Nothing -> (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing)
                Just (a
i,a
j) -> (forall a. a -> Maybe a
Just a
i,forall a. a -> Maybe a
Just a
j)
    in forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. Maybe (a, a) -> (Maybe a, Maybe a)
f

-- | Replace 'Nothing' elements with last 'Just' value.  This does not
-- alter the length of the list.
--
-- > maybe_latch 1 [Nothing,Just 2,Nothing,Just 4] == [1,2,2,4]
maybe_latch :: a -> [Maybe a] -> [a]
maybe_latch :: forall a. a -> [Maybe a] -> [a]
maybe_latch a
i [Maybe a]
x =
    case [Maybe a]
x of
      [] -> []
      Just a
e:[Maybe a]
x' -> a
e forall a. a -> [a] -> [a]
: forall a. a -> [Maybe a] -> [a]
maybe_latch a
e [Maybe a]
x'
      Maybe a
Nothing:[Maybe a]
x' -> a
i forall a. a -> [a] -> [a]
: forall a. a -> [Maybe a] -> [a]
maybe_latch a
i [Maybe a]
x'

-- | Variant requiring initial value is not 'Nothing'.
--
-- > maybe_latch1 [Just 1,Nothing,Nothing,Just 4] == [1,1,1,4]
maybe_latch1 :: [Maybe a] -> [a]
maybe_latch1 :: forall a. [Maybe a] -> [a]
maybe_latch1 = forall a. a -> [Maybe a] -> [a]
maybe_latch (forall a. HasCallStack => String -> a
error String
"maybe_latch1")

-- | 'map' of 'fmap'.
--
-- > maybe_map negate [Nothing,Just 2] == [Nothing,Just (-2)]
maybe_map :: (a -> b) -> [Maybe a] -> [Maybe b]
maybe_map :: forall a b. (a -> b) -> [Maybe a] -> [Maybe b]
maybe_map = forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- | If either is 'Nothing' then 'False', else /eq/ of values.
maybe_eq_by :: (t -> u -> Bool) -> Maybe t -> Maybe u -> Bool
maybe_eq_by :: forall t u. (t -> u -> Bool) -> Maybe t -> Maybe u -> Bool
maybe_eq_by t -> u -> Bool
eq_fn Maybe t
p Maybe u
q =
    case (Maybe t
p,Maybe u
q) of
      (Just t
p',Just u
q') -> t -> u -> Bool
eq_fn t
p' u
q'
      (Maybe t, Maybe u)
_ -> Bool
False

-- | Join two values, either of which may be missing.
maybe_join' :: (s -> t) -> (s -> s -> t) -> Maybe s -> Maybe s -> Maybe t
maybe_join' :: forall s t.
(s -> t) -> (s -> s -> t) -> Maybe s -> Maybe s -> Maybe t
maybe_join' s -> t
f s -> s -> t
g Maybe s
p Maybe s
q =
    case (Maybe s
p,Maybe s
q) of
      (Maybe s
Nothing,Maybe s
_) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> t
f Maybe s
q
      (Maybe s
_,Maybe s
Nothing) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> t
f Maybe s
p
      (Just s
p',Just s
q') -> forall a. a -> Maybe a
Just (s
p' s -> s -> t
`g` s
q')

-- | 'maybe_join'' of 'id'
maybe_join :: (t -> t -> t) -> Maybe t -> Maybe t -> Maybe t
maybe_join :: forall t. (t -> t -> t) -> Maybe t -> Maybe t -> Maybe t
maybe_join = forall s t.
(s -> t) -> (s -> s -> t) -> Maybe s -> Maybe s -> Maybe t
maybe_join' forall a. a -> a
id

-- | Apply predicate inside 'Maybe'.
--
-- > maybe_predicate even (Just 3) == Nothing
maybe_predicate :: (a -> Bool) -> Maybe a -> Maybe a
maybe_predicate :: forall a. (a -> Bool) -> Maybe a -> Maybe a
maybe_predicate a -> Bool
f Maybe a
i =
    case Maybe a
i of
      Maybe a
Nothing -> forall a. Maybe a
Nothing
      Just a
j -> if a -> Bool
f a
j then forall a. a -> Maybe a
Just a
j else forall a. Maybe a
Nothing

-- | 'map' of 'maybe_predicate'.
--
-- > let r = [Nothing,Nothing,Nothing,Just 4]
-- > in maybe_filter even [Just 1,Nothing,Nothing,Just 4] == r
maybe_filter :: (a -> Bool) -> [Maybe a] -> [Maybe a]
maybe_filter :: forall a. (a -> Bool) -> [Maybe a] -> [Maybe a]
maybe_filter = forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Maybe a -> Maybe a
maybe_predicate

{- | Variant of 'catMaybes'.
     If all elements of the list are @Just a@, then gives @Just [a]@ else gives 'Nothing'.

> all_just (map Just [1..3]) == Just [1..3]
> all_just [Just 1,Nothing,Just 3] == Nothing
-}
all_just :: [Maybe a] -> Maybe [a]
all_just :: forall a. [Maybe a] -> Maybe [a]
all_just [Maybe a]
x =
    case [Maybe a]
x of
      [] -> forall a. a -> Maybe a
Just []
      Just a
i:[Maybe a]
x' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
i forall a. a -> [a] -> [a]
:) (forall a. [Maybe a] -> Maybe [a]
all_just [Maybe a]
x')
      Maybe a
Nothing:[Maybe a]
_ -> forall a. Maybe a
Nothing