-- | Defines a version of the ListT monad transformer, used in the REST search

module Language.REST.Internal.ListT where

import           Control.Applicative
import           Control.Monad.Trans

newtype ListT m a = ListT {
  forall (m :: * -> *) a. ListT m a -> m [a]
runListT :: m [a]
}

instance (Monad m) => Functor (ListT m) where
  fmap :: forall a b. (a -> b) -> ListT m a -> ListT m b
fmap a -> b
f (ListT m [a]
mxs) = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ do
    forall a b. (a -> b) -> [a] -> [b]
map a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [a]
mxs

instance (Monad m) => Applicative (ListT m) where
  pure :: forall a. a -> ListT m a
pure a
x                    = forall (m :: * -> *) a. m [a] -> ListT m a
ListT (forall (m :: * -> *) a. Monad m => a -> m a
return [a
x])
  (ListT m [a -> b]
mf) <*> :: forall a b. ListT m (a -> b) -> ListT m a -> ListT m b
<*> (ListT m [a]
mx) = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ do
    [a -> b]
fs <- m [a -> b]
mf
    [a]
xs <- m [a]
mx
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
      a -> b
f <- [a -> b]
fs
      forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs

instance (Monad m) => Monad (ListT m) where
  return :: forall a. a -> ListT m a
return a
x         = forall (m :: * -> *) a. m [a] -> ListT m a
ListT (forall (m :: * -> *) a. Monad m => a -> m a
return [a
x])
  (ListT m [a]
mxs) >>= :: forall a b. ListT m a -> (a -> ListT m b) -> ListT m b
>>= a -> ListT m b
f = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ do
    [a]
xs <- m [a]
mxs
    [[b]]
res <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) a. ListT m a -> m [a]
runListT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ListT m b
f) [a]
xs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[b]]
res

instance (Monad m) => Alternative (ListT m) where
  empty :: forall a. ListT m a
empty                       = forall (m :: * -> *) a. m [a] -> ListT m a
ListT (forall (m :: * -> *) a. Monad m => a -> m a
return [])
  (ListT m [a]
mxs) <|> :: forall a. ListT m a -> ListT m a -> ListT m a
<|> (ListT m [a]
mys) = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ do
    [a]
xs <- m [a]
mxs
    if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
      then m [a]
mxs
      else m [a]
mys

instance MonadTrans ListT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ListT m a
lift m a
mx = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ do
    a
x <- m a
mx
    forall (m :: * -> *) a. Monad m => a -> m a
return [a
x]