<commit_before>-- "Dao/Logic.hs"  A stateful monad that reverts the state in the event of
-- backtracking or throwError.
-- 
-- Copyright (C) 2008-2015  <NAME>.
--
-- Dao is free software: you can redistribute it and/or modify it under the
-- terms of the GNU General Public License as published by the Free Software
-- Foundation, either version 3 of the License, or (at your option) any later
-- version.
-- 
-- Dao is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
-- details.
-- 
-- You should have received a copy of the GNU General Public License along with
-- this program (see the file called "LICENSE"). If not, see the URL:
-- <http://www.gnu.org/licenses/agpl.html>.

{-# LANGUAGE UndecidableInstances #-}

-- | This module defines the 'LogicT' monad transformer, and 'MonadLogic' class, which can be used
-- to model nondeterministic finite state automata, and is specifically designed for stateful
-- pattern matching. Like the 'Prelude.Maybe' monad, pattern matching on bind, evaluates to
-- 'Control.Monad.mzero', resulting in backtracking.
--
-- 'LogicT' and transformers deriving from it are excellent for parsing command line arguments, but
-- should be avoided for designing parsers of strings, because every branch lazily creates a copy of
-- the state. Use "Dao.Grammar" for defining string parsers.
module Dao.Logic where

import           Control.Arrow
import           Control.Applicative
import           Control.Monad
import           Control.Monad.Except
import           Control.Monad.State.Class

----------------------------------------------------------------------------------------------------

-- | The 'LogicT' monad transformer allows for stateful pattern matching. 'LogicT' is very similar
-- to the 'Control.Monad.State.StateT' monad transformer, indeed it instantiates
-- 'Control.Monad.State.Class.MonadState'. The main difference is that the 'LogicT' monad can model
-- a function holding many possible, mutually exclusive states, and returning many possible
-- mututally exclusive values. If the monadic function backtracks using 'Control.Applicative.empty'
-- or 'Control.Monad.mzero', the state is reverted.
newtype LogicT st m a = LogicT{ runLogicT :: st -> m [(a, st)] }

instance Functor m => Functor (LogicT st m) where
  fmap f (LogicT p) = LogicT $ fmap (fmap (first f)) . p

instance (Functor m, Applicative m, Monad m) => Applicative (LogicT st m) where
  pure = return
  (<*>) = ap

instance (Functor m, Applicative m, Monad m) => Alternative (LogicT st m) where
  empty = mzero
  (<|>) = mplus

instance (Functor m, Applicative m, Monad m) => Monad (LogicT st m) where
  return o = LogicT $ \st -> return [(o, st)]
  (LogicT o) >>= f = LogicT $ \st -> o st >>= fmap concat .  mapM (\ (o, st) -> runLogicT (f o) st)

instance (Functor m, Applicative m, Monad m) => MonadPlus (LogicT st m) where
  mzero                       = LogicT $ const $ return []
  mplus (LogicT a) (LogicT b) = LogicT $ \st -> (++) <$> a st <*> b st

instance (Functor m, Applicative m, Monad m) => MonadState st (LogicT st m) where
  state f = LogicT $ \st -> return [f st]

instance (Functor m, Applicative m, Monad m, MonadIO m) => MonadIO (LogicT st m) where
  liftIO f = LogicT $ \st -> (\a -> [(a, st)]) <$> liftIO f

instance MonadTrans (LogicT st) where
  lift f = LogicT $ \st -> f >>= \a -> return [(a, st)]

-- | Similar to 'Control.Monad.State.evalStateT'.
evalLogicT :: Functor m => LogicT st m a -> st -> m [a]
evalLogicT f = fmap (fmap fst) . runLogicT f

-- | Similar to 'Control.Monad.State.execStateT'.
execLogicT :: Functor m => LogicT st m a -> st -> m [st]
execLogicT f = fmap (fmap snd) . runLogicT f

----------------------------------------------------------------------------------------------------

class (Functor m, Applicative m, Monad m) => MonadLogic st m | m -> st where
  -- | Like 'Control.Monad.State.Class.state', but return multiple possible states and outcomes.
  -- Think of this as creating a computation that is in an uncertain superposition, with many
  -- possible states and outcomes.
  --
  -- There is a law for 'superState' requiring that if the function @(st -> [(a, st)])@ that was
  -- passed to 'superState' evaluates to an empty list, then 'superState' must evaluate to
  -- 'Control.Applicative.empty' and/or 'Control.Monad.mzero'.
  superState :: (st -> [(a, st)]) -> m a
  -- | Given a 'LogicT' monadic function, use the current state with 'runLogicT' to evaluate this
  -- function, producing a list of all possible (outcome,state) pairs. Place the current state back
  -- into the 'runLogicT' monad and return the list of all possible (outcome,state) pairs.
  --
  -- There is a law for 'entangle' requiring that if the function @(m a)@ that was passed to
  -- 'entangle' evaluates to 'Control.Applicative.empty' and/or 'Control.Monad.mzero', then
  -- 'entangle' must evaluate to @'Control.Monad.return' []@.
  entangle :: m a -> m [(a, st)]

instance (Functor m, Applicative m, Monad m) => MonadLogic st (LogicT st m) where
  superState f = LogicT $ \st -> return (f st)
  entangle (LogicT f) = LogicT $ \st -> fmap (\all -> [(all, st)]) (f st)

-- | Like 'Control.Monad.State.modify', but puts the current state of the computation into an
-- uncertain superposition, with many possible states.
superModify :: MonadLogic st m => (st -> [st]) -> LogicT st m ()
superModify f = superState (fmap ((,) ()) . f)
<commit_msg>Added a pure version of 'Dao.Logic.LogicT' called 'Dao.Logic.Logic' which is 'Dao.Logic.LogicT' lifting the 'Control.Monad.Idenity.Identity' monad. Then I added two evaluator functions 'Dao.Logic.execLogic' and 'Dao.Logic.evalLogic'. All of these changes make the API of the "Dao.Logic" module a bit more similar to the "Control.Monad.State" API.<commit_after>-- "Dao/Logic.hs"  A stateful monad that reverts the state in the event of
-- backtracking or throwError.
-- 
-- Copyright (C) 2008-2015  <NAME>.
--
-- Dao is free software: you can redistribute it and/or modify it under the
-- terms of the GNU General Public License as published by the Free Software
-- Foundation, either version 3 of the License, or (at your option) any later
-- version.
-- 
-- Dao is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
-- details.
-- 
-- You should have received a copy of the GNU General Public License along with
-- this program (see the file called "LICENSE"). If not, see the URL:
-- <http://www.gnu.org/licenses/agpl.html>.

{-# LANGUAGE UndecidableInstances #-}

-- | This module defines the 'LogicT' monad transformer, and 'MonadLogic' class, which can be used
-- to model nondeterministic finite state automata, and is specifically designed for stateful
-- pattern matching. Like the 'Prelude.Maybe' monad, pattern matching on bind, evaluates to
-- 'Control.Monad.mzero', resulting in backtracking.
--
-- 'LogicT' and transformers deriving from it are excellent for parsing command line arguments, but
-- should be avoided for designing parsers of strings, because every branch lazily creates a copy of
-- the state. Use "Dao.Grammar" for defining string parsers.
module Dao.Logic where

import           Control.Arrow
import           Control.Applicative
import           Control.Monad
import           Control.Monad.Identity
import           Control.Monad.Except
import           Control.Monad.State.Class

----------------------------------------------------------------------------------------------------

-- | The 'LogicT' monad transformer allows for stateful pattern matching. 'LogicT' is very similar
-- to the 'Control.Monad.State.StateT' monad transformer, indeed it instantiates
-- 'Control.Monad.State.Class.MonadState'. The main difference is that the 'LogicT' monad can model
-- a function holding many possible, mutually exclusive states, and returning many possible
-- mututally exclusive values. If the monadic function backtracks using 'Control.Applicative.empty'
-- or 'Control.Monad.mzero', the state is reverted.
newtype LogicT st m a = LogicT{ runLogicT :: st -> m [(a, st)] }

type Logic st a = LogicT st Identity a

logic :: (st -> [(a, st)]) -> Logic st a
logic = LogicT . fmap Identity

instance Functor m => Functor (LogicT st m) where
  fmap f (LogicT p) = LogicT $ fmap (fmap (first f)) . p

instance (Functor m, Applicative m, Monad m) => Applicative (LogicT st m) where
  pure = return
  (<*>) = ap

instance (Functor m, Applicative m, Monad m) => Alternative (LogicT st m) where
  empty = mzero
  (<|>) = mplus

instance (Functor m, Applicative m, Monad m) => Monad (LogicT st m) where
  return o = LogicT $ \st -> return [(o, st)]
  (LogicT o) >>= f = LogicT $ \st -> o st >>= fmap concat .  mapM (\ (o, st) -> runLogicT (f o) st)

instance (Functor m, Applicative m, Monad m) => MonadPlus (LogicT st m) where
  mzero                       = LogicT $ const $ return []
  mplus (LogicT a) (LogicT b) = LogicT $ \st -> (++) <$> a st <*> b st

instance (Functor m, Applicative m, Monad m) => MonadState st (LogicT st m) where
  state f = LogicT $ \st -> return [f st]

instance (Functor m, Applicative m, Monad m, MonadIO m) => MonadIO (LogicT st m) where
  liftIO f = LogicT $ \st -> (\a -> [(a, st)]) <$> liftIO f

instance MonadTrans (LogicT st) where
  lift f = LogicT $ \st -> f >>= \a -> return [(a, st)]

-- | Similar to 'Control.Monad.State.evalStateT'.
evalLogicT :: Functor m => LogicT st m a -> st -> m [a]
evalLogicT f = fmap (fmap fst) . runLogicT f

evalLogic :: Logic st a -> st -> [a]
evalLogic f = runIdentity . evalLogicT f

-- | Similar to 'Control.Monad.State.execStateT'.
execLogicT :: Functor m => LogicT st m a -> st -> m [st]
execLogicT f = fmap (fmap snd) . runLogicT f

execLogic :: Logic st a -> st -> [st]
execLogic f = runIdentity . execLogicT f

----------------------------------------------------------------------------------------------------

class (Functor m, Applicative m, Monad m) => MonadLogic st m | m -> st where
  -- | Like 'Control.Monad.State.Class.state', but return multiple possible states and outcomes.
  -- Think of this as creating a computation that is in an uncertain superposition, with many
  -- possible states and outcomes.
  --
  -- There is a law for 'superState' requiring that if the function @(st -> [(a, st)])@ that was
  -- passed to 'superState' evaluates to an empty list, then 'superState' must evaluate to
  -- 'Control.Applicative.empty' and/or 'Control.Monad.mzero'.
  superState :: (st -> [(a, st)]) -> m a
  -- | Given a 'LogicT' monadic function, use the current state with 'runLogicT' to evaluate this
  -- function, producing a list of all possible (outcome,state) pairs. Place the current state back
  -- into the 'runLogicT' monad and return the list of all possible (outcome,state) pairs.
  --
  -- There is a law for 'entangle' requiring that if the function @(m a)@ that was passed to
  -- 'entangle' evaluates to 'Control.Applicative.empty' and/or 'Control.Monad.mzero', then
  -- 'entangle' must evaluate to @'Control.Monad.return' []@.
  entangle :: m a -> m [(a, st)]

instance (Functor m, Applicative m, Monad m) => MonadLogic st (LogicT st m) where
  superState f = LogicT $ \st -> return (f st)
  entangle (LogicT f) = LogicT $ \st -> fmap (\all -> [(all, st)]) (f st)

-- | Like 'Control.Monad.State.modify', but puts the current state of the computation into an
-- uncertain superposition, with many possible states.
superModify :: MonadLogic st m => (st -> [st]) -> LogicT st m ()
superModify f = superState (fmap ((,) ()) . f)

{'fraction_non_alphanumeric': 0.14799423288949198, 'fraction_numerical': 0.0015265880756509202, 'mean_word_length': 2.8662295081967213, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 107, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6671182', 'n_tokens_mistral': 3725, 'n_tokens_neox': 3591, 'n_words': 1515}