-- | List/Logic functions.
module Music.Theory.List.Logic where

import Control.Monad {- base -}

import qualified Control.Monad.Logic as L {- logict -}

-- | 'L.MonadLogic' value to enumerate indices for all embeddings of /q/ in /p/.
all_embeddings_m :: (Eq t, MonadPlus m, L.MonadLogic m) => [t] -> [t] -> m [Int]
all_embeddings_m :: forall t (m :: * -> *).
(Eq t, MonadPlus m, MonadLogic m) =>
[t] -> [t] -> m [Int]
all_embeddings_m [t]
p [t]
q =
    let q_n :: Int
q_n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [t]
q
        recur :: [(a, a)] -> [a] -> Int -> [a] -> m [a]
recur [(a, a)]
p' [a]
q' Int
n [a]
k = -- n = length k
            if Int
n forall a. Eq a => a -> a -> Bool
== Int
q_n
            then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [a]
k)
            else do (a
m,a
c) <- forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return [(a, a)]
p')
                    let k0 :: a
k0 = forall a. [a] -> a
head [a]
k
                        c' :: a
c' = forall a. [a] -> a
head [a]
q'
                    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
c forall a. Eq a => a -> a -> Bool
== a
c' Bool -> Bool -> Bool
&& (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
k Bool -> Bool -> Bool
|| a
m forall a. Ord a => a -> a -> Bool
> a
k0))
                    let p'' :: [(a, a)]
p'' = forall a. [a] -> [a]
tail [(a, a)]
p'
                        q'' :: [a]
q'' = forall a. [a] -> [a]
tail [a]
q'
                    [(a, a)] -> [a] -> Int -> [a] -> m [a]
recur [(a, a)]
p'' [a]
q'' (Int
n forall a. Num a => a -> a -> a
+ Int
1) (a
m forall a. a -> [a] -> [a]
: [a]
k)
    in forall {m :: * -> *} {a} {a}.
(MonadPlus m, Ord a, Eq a) =>
[(a, a)] -> [a] -> Int -> [a] -> m [a]
recur (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [t]
p) [t]
q Int
0 []

-- | 'L.observeAll' of 'all_embeddings_m'
--
-- > all_embeddings "all_embeddings" "leg" == [[1,4,12],[1,7,12],[2,4,12],[2,7,12]]
all_embeddings :: Eq t => [t] -> [t] -> [[Int]]
all_embeddings :: forall t. Eq t => [t] -> [t] -> [[Int]]
all_embeddings [t]
p = forall a. Logic a -> [a]
L.observeAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *).
(Eq t, MonadPlus m, MonadLogic m) =>
[t] -> [t] -> m [Int]
all_embeddings_m [t]
p