module Music.Theory.List.Logic where
import Control.Monad
import qualified Control.Monad.Logic as L
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 =
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 []
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