-- |
-- Module      :  Control.Monad.Permutations
-- Copyright   :  © 2017–present Alex Washburn
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <[email protected]>
-- Stability   :  experimental
-- Portability :  portable
--
-- This module specialized the interface to 'Monad' for potential efficiency
-- considerations, depending on the monad the permutations are run over.
--
-- For a more general interface requiring only 'Applicative', and for more
-- complete documentation, see the 'Control.Applicative.Permutations' module.
--
-- @since 1.3.0
module Control.Monad.Permutations
  ( -- ** Permutation type
    Permutation,

    -- ** Permutation evaluators
    runPermutation,
    intercalateEffect,

    -- ** Permutation constructors
    toPermutation,
    toPermutationWithDefault,
  )
where

import Control.Applicative

-- | An 'Applicative' wrapper-type for constructing permutation parsers.
data Permutation m a = P !(Maybe a) (m (Permutation m a))

instance Functor m => Functor (Permutation m) where
  fmap :: forall a b. (a -> b) -> Permutation m a -> Permutation m b
fmap a -> b
f (P Maybe a
v m (Permutation m a)
p) = forall (m :: * -> *) a.
Maybe a -> m (Permutation m a) -> Permutation m a
P (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
v) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Permutation m a)
p)

instance Alternative m => Applicative (Permutation m) where
  pure :: forall a. a -> Permutation m a
pure a
value = forall (m :: * -> *) a.
Maybe a -> m (Permutation m a) -> Permutation m a
P (forall a. a -> Maybe a
Just a
value) forall (f :: * -> *) a. Alternative f => f a
empty
  lhs :: Permutation m (a -> b)
lhs@(P Maybe (a -> b)
f m (Permutation m (a -> b))
v) <*> :: forall a b.
Permutation m (a -> b) -> Permutation m a -> Permutation m b
<*> rhs :: Permutation m a
rhs@(P Maybe a
g m (Permutation m a)
w) = forall (m :: * -> *) a.
Maybe a -> m (Permutation m a) -> Permutation m a
P (Maybe (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
g) (m (Permutation m b)
lhsAlt forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Permutation m b)
rhsAlt)
    where
      lhsAlt :: m (Permutation m b)
lhsAlt = (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Permutation m a
rhs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Permutation m (a -> b))
v
      rhsAlt :: m (Permutation m b)
rhsAlt = (Permutation m (a -> b)
lhs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Permutation m a)
w
  liftA2 :: forall a b c.
(a -> b -> c)
-> Permutation m a -> Permutation m b -> Permutation m c
liftA2 a -> b -> c
f lhs :: Permutation m a
lhs@(P Maybe a
x m (Permutation m a)
v) rhs :: Permutation m b
rhs@(P Maybe b
y m (Permutation m b)
w) = forall (m :: * -> *) a.
Maybe a -> m (Permutation m a) -> Permutation m a
P (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Maybe a
x Maybe b
y) (m (Permutation m c)
lhsAlt forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Permutation m c)
rhsAlt)
    where
      lhsAlt :: m (Permutation m c)
lhsAlt = (\Permutation m a
p -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Permutation m a
p Permutation m b
rhs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Permutation m a)
v
      rhsAlt :: m (Permutation m c)
rhsAlt = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Permutation m a
lhs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Permutation m b)
w

-- | \"Unlifts\" a permutation parser into a parser to be evaluated.
runPermutation ::
  ( Alternative m,
    Monad m
  ) =>
  -- | Permutation specification
  Permutation m a ->
  -- | Resulting base monad capable of handling the permutation
  m a
runPermutation :: forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Permutation m a -> m a
runPermutation (P Maybe a
value m (Permutation m a)
parser) = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (Permutation m a)
parser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {f :: * -> *}.
(Alternative f, Monad f) =>
Maybe (Permutation f a) -> f a
f
  where
    f :: Maybe (Permutation f a) -> f a
f Maybe (Permutation f a)
Nothing = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
value
    f (Just Permutation f a
p) = forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Permutation m a -> m a
runPermutation Permutation f a
p

-- | \"Unlifts\" a permutation parser into a parser to be evaluated with an
-- intercalated effect. Useful for separators between permutation elements.
intercalateEffect ::
  ( Alternative m,
    Monad m
  ) =>
  -- | Effect to be intercalated between permutation components
  m b ->
  -- | Permutation specification
  Permutation m a ->
  -- | Resulting base monad capable of handling the permutation
  m a
intercalateEffect :: forall (m :: * -> *) b a.
(Alternative m, Monad m) =>
m b -> Permutation m a -> m a
intercalateEffect = forall (m :: * -> *) c b a.
(Alternative m, Monad m) =>
m c -> m b -> Permutation m a -> m a
run m ()
noEffect
  where
    noEffect :: m ()
noEffect = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    run :: (Alternative m, Monad m) => m c -> m b -> Permutation m a -> m a
    run :: forall (m :: * -> *) c b a.
(Alternative m, Monad m) =>
m c -> m b -> Permutation m a -> m a
run m c
headSep m b
tailSep (P Maybe a
value m (Permutation m a)
parser) = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m c
headSep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Permutation m a)
parser) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Permutation m a) -> m a
f
      where
        f :: Maybe (Permutation m a) -> m a
f Maybe (Permutation m a)
Nothing = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
value
        f (Just Permutation m a
p) = forall (m :: * -> *) c b a.
(Alternative m, Monad m) =>
m c -> m b -> Permutation m a -> m a
run m b
tailSep m b
tailSep Permutation m a
p

-- | \"Lifts\" a parser to a permutation parser.
toPermutation ::
  Alternative m =>
  -- | Permutation component
  m a ->
  Permutation m a
toPermutation :: forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation m a
p = forall (m :: * -> *) a.
Maybe a -> m (Permutation m a) -> Permutation m a
P forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p

-- | \"Lifts\" a parser with a default value to a permutation parser.
--
-- If no permutation containing the supplied parser can be parsed from the input,
-- then the supplied default value is returned in lieu of a parse result.
toPermutationWithDefault ::
  Alternative m =>
  -- | Default Value
  a ->
  -- | Permutation component
  m a ->
  Permutation m a
toPermutationWithDefault :: forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault a
v m a
p = forall (m :: * -> *) a.
Maybe a -> m (Permutation m a) -> Permutation m a
P (forall a. a -> Maybe a
Just a
v) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p