logict-0.6.0.3/Control/0000755000000000000000000000000013462120752012747 5ustar0000000000000000logict-0.6.0.3/Control/Monad/0000755000000000000000000000000013462134614014007 5ustar0000000000000000logict-0.6.0.3/Control/Monad/Logic/0000755000000000000000000000000013462120752015042 5ustar0000000000000000logict-0.6.0.3/Control/Monad/Logic.hs0000644000000000000000000001475113462134614015410 0ustar0000000000000000{-# LANGUAGE CPP, UndecidableInstances, Rank2Types, FlexibleInstances, MultiParamTypeClasses #-} ------------------------------------------------------------------------- -- | -- Module : Control.Monad.Logic -- Copyright : (c) Dan Doel -- License : BSD3 -- -- Maintainer : dan.doel@gmail.com -- Stability : experimental -- Portability : non-portable (multi-parameter type classes) -- -- A backtracking, logic programming monad. -- -- Adapted from the paper -- /Backtracking, Interleaving, and Terminating -- Monad Transformers/, by -- Oleg Kiselyov, Chung-chieh Shan, Daniel P. Friedman, Amr Sabry -- (). ------------------------------------------------------------------------- module Control.Monad.Logic ( module Control.Monad.Logic.Class, -- * The Logic monad Logic, logic, runLogic, observe, observeMany, observeAll, -- * The LogicT monad transformer LogicT(..), runLogicT, observeT, observeManyT, observeAllT, module Control.Monad, module Control.Monad.Trans ) where import Control.Applicative import Control.Monad import qualified Control.Monad.Fail as Fail import Control.Monad.Identity import Control.Monad.Trans import Control.Monad.Reader.Class import Control.Monad.State.Class import Control.Monad.Error.Class import Data.Monoid (Monoid(mappend, mempty)) import qualified Data.Foldable as F import qualified Data.Traversable as T import Control.Monad.Logic.Class ------------------------------------------------------------------------- -- | A monad transformer for performing backtracking computations -- layered over another monad 'm' newtype LogicT m a = LogicT { unLogicT :: forall r. (a -> m r -> m r) -> m r -> m r } ------------------------------------------------------------------------- -- | Extracts the first result from a LogicT computation, -- failing otherwise. #if !MIN_VERSION_base(4,13,0) observeT :: Monad m => LogicT m a -> m a #else observeT :: MonadFail m => LogicT m a -> m a #endif observeT lt = unLogicT lt (const . return) (fail "No answer.") ------------------------------------------------------------------------- -- | Extracts all results from a LogicT computation. observeAllT :: Monad m => LogicT m a -> m [a] observeAllT m = unLogicT m (liftM . (:)) (return []) ------------------------------------------------------------------------- -- | Extracts up to a given number of results from a LogicT computation. observeManyT :: Monad m => Int -> LogicT m a -> m [a] observeManyT n m | n <= 0 = return [] | n == 1 = unLogicT m (\a _ -> return [a]) (return []) | otherwise = unLogicT (msplit m) sk (return []) where sk Nothing _ = return [] sk (Just (a, m')) _ = (a:) `liftM` observeManyT (n-1) m' ------------------------------------------------------------------------- -- | Runs a LogicT computation with the specified initial success and -- failure continuations. runLogicT :: LogicT m a -> (a -> m r -> m r) -> m r -> m r runLogicT = unLogicT ------------------------------------------------------------------------- -- | The basic Logic monad, for performing backtracking computations -- returning values of type 'a' type Logic = LogicT Identity ------------------------------------------------------------------------- -- | A smart constructor for Logic computations. logic :: (forall r. (a -> r -> r) -> r -> r) -> Logic a logic f = LogicT $ \k -> Identity . f (\a -> runIdentity . k a . Identity) . runIdentity ------------------------------------------------------------------------- -- | Extracts the first result from a Logic computation. observe :: Logic a -> a observe lt = runIdentity $ unLogicT lt (const . return) (error "No answer.") ------------------------------------------------------------------------- -- | Extracts all results from a Logic computation. observeAll :: Logic a -> [a] observeAll = runIdentity . observeAllT ------------------------------------------------------------------------- -- | Extracts up to a given number of results from a Logic computation. observeMany :: Int -> Logic a -> [a] observeMany i = runIdentity . observeManyT i ------------------------------------------------------------------------- -- | Runs a Logic computation with the specified initial success and -- failure continuations. runLogic :: Logic a -> (a -> r -> r) -> r -> r runLogic l s f = runIdentity $ unLogicT l si fi where si = fmap . s fi = Identity f instance Functor (LogicT f) where fmap f lt = LogicT $ \sk fk -> unLogicT lt (sk . f) fk instance Applicative (LogicT f) where pure a = LogicT $ \sk fk -> sk a fk f <*> a = LogicT $ \sk fk -> unLogicT f (\g fk' -> unLogicT a (sk . g) fk') fk instance Alternative (LogicT f) where empty = LogicT $ \_ fk -> fk f1 <|> f2 = LogicT $ \sk fk -> unLogicT f1 sk (unLogicT f2 sk fk) instance Monad (LogicT m) where return a = LogicT $ \sk fk -> sk a fk m >>= f = LogicT $ \sk fk -> unLogicT m (\a fk' -> unLogicT (f a) sk fk') fk #if !MIN_VERSION_base(4,13,0) fail = Fail.fail #endif instance Fail.MonadFail (LogicT m) where fail _ = LogicT $ \_ fk -> fk instance MonadPlus (LogicT m) where mzero = LogicT $ \_ fk -> fk m1 `mplus` m2 = LogicT $ \sk fk -> unLogicT m1 sk (unLogicT m2 sk fk) instance MonadTrans LogicT where lift m = LogicT $ \sk fk -> m >>= \a -> sk a fk instance (MonadIO m) => MonadIO (LogicT m) where liftIO = lift . liftIO instance (Monad m) => MonadLogic (LogicT m) where msplit m = lift $ unLogicT m ssk (return Nothing) where ssk a fk = return $ Just (a, (lift fk >>= reflect)) instance (Monad m, F.Foldable m) => F.Foldable (LogicT m) where foldMap f m = F.fold $ unLogicT m (liftM . mappend . f) (return mempty) instance T.Traversable (LogicT Identity) where traverse g l = runLogic l (\a ft -> cons <$> g a <*> ft) (pure mzero) where cons a l' = return a `mplus` l' -- Needs undecidable instances instance MonadReader r m => MonadReader r (LogicT m) where ask = lift ask local f m = LogicT $ \sk fk -> unLogicT m ((local f .) . sk) (local f fk) -- Needs undecidable instances instance MonadState s m => MonadState s (LogicT m) where get = lift get put = lift . put -- Needs undecidable instances instance MonadError e m => MonadError e (LogicT m) where throwError = lift . throwError catchError m h = LogicT $ \sk fk -> let handle r = r `catchError` \e -> unLogicT (h e) sk fk in handle $ unLogicT m (\a -> sk a . handle) fk logict-0.6.0.3/Control/Monad/Logic/Class.hs0000644000000000000000000002140312276004074016443 0ustar0000000000000000------------------------------------------------------------------------- -- | -- Module : Control.Monad.Logic.Class -- Copyright : (c) Dan Doel -- License : BSD3 -- -- Maintainer : dan.doel@gmail.com -- Stability : experimental -- Portability : non-portable (multi-parameter type classes) -- -- A backtracking, logic programming monad. -- -- Adapted from the paper -- /Backtracking, Interleaving, and Terminating -- Monad Transformers/, by -- Oleg Kiselyov, Chung-chieh Shan, Daniel P. Friedman, Amr Sabry -- () ------------------------------------------------------------------------- module Control.Monad.Logic.Class (MonadLogic(..), reflect, lnot) where import qualified Control.Monad.State.Lazy as LazyST import qualified Control.Monad.State.Strict as StrictST import Control.Monad.Reader import Data.Monoid import qualified Control.Monad.Writer.Lazy as LazyWT import qualified Control.Monad.Writer.Strict as StrictWT ------------------------------------------------------------------------------- -- | Minimal implementation: msplit class (MonadPlus m) => MonadLogic m where -- | Attempts to split the computation, giving access to the first -- result. Satisfies the following laws: -- -- > msplit mzero == return Nothing -- > msplit (return a `mplus` m) == return (Just (a, m)) msplit :: m a -> m (Maybe (a, m a)) -- | Fair disjunction. It is possible for a logical computation -- to have an infinite number of potential results, for instance: -- -- > odds = return 1 `mplus` liftM (2+) odds -- -- Such computations can cause problems in some circumstances. Consider: -- -- > do x <- odds `mplus` return 2 -- > if even x then return x else mzero -- -- Such a computation may never consider the 'return 2', and will -- therefore never terminate. By contrast, interleave ensures fair -- consideration of both branches of a disjunction interleave :: m a -> m a -> m a -- | Fair conjunction. Similarly to the previous function, consider -- the distributivity law for MonadPlus: -- -- > (mplus a b) >>= k = (a >>= k) `mplus` (b >>= k) -- -- If 'a >>= k' can backtrack arbitrarily many tmes, (b >>= k) may never -- be considered. (>>-) takes similar care to consider both branches of -- a disjunctive computation. (>>-) :: m a -> (a -> m b) -> m b infixl 1 >>- -- | Logical conditional. The equivalent of Prolog's soft-cut. If its -- first argument succeeds at all, then the results will be fed into -- the success branch. Otherwise, the failure branch is taken. -- satisfies the following laws: -- -- > ifte (return a) th el == th a -- > ifte mzero th el == el -- > ifte (return a `mplus` m) th el == th a `mplus` (m >>= th) ifte :: m a -> (a -> m b) -> m b -> m b -- | Pruning. Selects one result out of many. Useful for when multiple -- results of a computation will be equivalent, or should be treated as -- such. once :: m a -> m a -- All the class functions besides msplit can be derived from msplit, if -- desired interleave m1 m2 = msplit m1 >>= maybe m2 (\(a, m1') -> return a `mplus` interleave m2 m1') m >>- f = do (a, m') <- maybe mzero return =<< msplit m interleave (f a) (m' >>- f) ifte t th el = msplit t >>= maybe el (\(a,m) -> th a `mplus` (m >>= th)) once m = do (a, _) <- maybe mzero return =<< msplit m return a ------------------------------------------------------------------------------- -- | The inverse of msplit. Satisfies the following law: -- -- > msplit m >>= reflect == m reflect :: MonadLogic m => Maybe (a, m a) -> m a reflect Nothing = mzero reflect (Just (a, m)) = return a `mplus` m -- | Inverts a logic computation. If @m@ succeeds with at least one value, -- @lnot m@ fails. If @m@ fails, then @lnot m@ succeeds the value @()@. lnot :: MonadLogic m => m a -> m () lnot m = ifte (once m) (const mzero) (return ()) -- An instance of MonadLogic for lists instance MonadLogic [] where msplit [] = return Nothing msplit (x:xs) = return $ Just (x, xs) -- Some of these may be questionable instances. Splitting a transformer does -- not allow you to provide different input to the monadic object returned. -- So, for instance, in: -- -- let Just (_, rm') = runReaderT (msplit rm) r -- in runReaderT rm' r' -- -- The "r'" parameter will be ignored, as "r" was already threaded through the -- computation. The results are similar for StateT. However, this is likely not -- an issue as most uses of msplit (all the ones in this library, at least) would -- not allow for that anyway. instance MonadLogic m => MonadLogic (ReaderT e m) where msplit rm = ReaderT $ \e -> do r <- msplit $ runReaderT rm e case r of Nothing -> return Nothing Just (a, m) -> return (Just (a, lift m)) instance MonadLogic m => MonadLogic (StrictST.StateT s m) where msplit sm = StrictST.StateT $ \s -> do r <- msplit (StrictST.runStateT sm s) case r of Nothing -> return (Nothing, s) Just ((a,s'), m) -> return (Just (a, StrictST.StateT (\_ -> m)), s') interleave ma mb = StrictST.StateT $ \s -> StrictST.runStateT ma s `interleave` StrictST.runStateT mb s ma >>- f = StrictST.StateT $ \s -> StrictST.runStateT ma s >>- \(a,s') -> StrictST.runStateT (f a) s' ifte t th el = StrictST.StateT $ \s -> ifte (StrictST.runStateT t s) (\(a,s') -> StrictST.runStateT (th a) s') (StrictST.runStateT el s) once ma = StrictST.StateT $ \s -> once (StrictST.runStateT ma s) instance MonadLogic m => MonadLogic (LazyST.StateT s m) where msplit sm = LazyST.StateT $ \s -> do r <- msplit (LazyST.runStateT sm s) case r of Nothing -> return (Nothing, s) Just ((a,s'), m) -> return (Just (a, LazyST.StateT (\_ -> m)), s') interleave ma mb = LazyST.StateT $ \s -> LazyST.runStateT ma s `interleave` LazyST.runStateT mb s ma >>- f = LazyST.StateT $ \s -> LazyST.runStateT ma s >>- \(a,s') -> LazyST.runStateT (f a) s' ifte t th el = LazyST.StateT $ \s -> ifte (LazyST.runStateT t s) (\(a,s') -> LazyST.runStateT (th a) s') (LazyST.runStateT el s) once ma = LazyST.StateT $ \s -> once (LazyST.runStateT ma s) instance (MonadLogic m, Monoid w) => MonadLogic (StrictWT.WriterT w m) where msplit wm = StrictWT.WriterT $ do r <- msplit (StrictWT.runWriterT wm) case r of Nothing -> return (Nothing, mempty) Just ((a,w), m) -> return (Just (a, StrictWT.WriterT m), w) interleave ma mb = StrictWT.WriterT $ StrictWT.runWriterT ma `interleave` StrictWT.runWriterT mb ma >>- f = StrictWT.WriterT $ StrictWT.runWriterT ma >>- \(a,w) -> StrictWT.runWriterT (StrictWT.tell w >> f a) ifte t th el = StrictWT.WriterT $ ifte (StrictWT.runWriterT t) (\(a,w) -> StrictWT.runWriterT (StrictWT.tell w >> th a)) (StrictWT.runWriterT el) once ma = StrictWT.WriterT $ once (StrictWT.runWriterT ma) instance (MonadLogic m, Monoid w) => MonadLogic (LazyWT.WriterT w m) where msplit wm = LazyWT.WriterT $ do r <- msplit (LazyWT.runWriterT wm) case r of Nothing -> return (Nothing, mempty) Just ((a,w), m) -> return (Just (a, LazyWT.WriterT m), w) interleave ma mb = LazyWT.WriterT $ LazyWT.runWriterT ma `interleave` LazyWT.runWriterT mb ma >>- f = LazyWT.WriterT $ LazyWT.runWriterT ma >>- \(a,w) -> LazyWT.runWriterT (LazyWT.tell w >> f a) ifte t th el = LazyWT.WriterT $ ifte (LazyWT.runWriterT t) (\(a,w) -> LazyWT.runWriterT (LazyWT.tell w >> th a)) (LazyWT.runWriterT el) once ma = LazyWT.WriterT $ once (LazyWT.runWriterT ma) logict-0.6.0.3/LICENSE0000644000000000000000000000273412276004074012342 0ustar0000000000000000This module is under this "3 clause" BSD license: Copyright (c) 2007-2010, Dan Doel All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of the contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. logict-0.6.0.3/Setup.lhs0000644000000000000000000000011512276004074013134 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain logict-0.6.0.3/logict.cabal0000644000000000000000000000307213462134712013577 0ustar0000000000000000name: logict version: 0.6.0.3 description: A continuation-based, backtracking, logic programming monad. An adaptation of the two-continuation implementation found in the paper "Backtracking, Interleaving, and Terminating Monad Transformers" available here: synopsis: A backtracking logic-programming monad. category: Control license: BSD3 license-file: LICENSE copyright: Copyright (c) 2007-2014, Dan Doel, Copyright (c) 2011-2013, Edward Kmett, Copyright (c) 2014, Roman Cheplyaka author: Dan Doel maintainer: Andrew Lelechenko homepage: https://github.com/Bodigrim/logict#readme cabal-version: >= 1.9.2 tested-with: GHC build-type: Simple extra-source-files: changelog.md source-repository head type: git location: https://github.com/Bodigrim/logict library build-depends: base >=2 && < 5, mtl>=2 && <2.3 if impl(ghc < 8.0) build-depends: fail exposed-modules: Control.Monad.Logic, Control.Monad.Logic.Class extensions: MultiParamTypeClasses, UndecidableInstances, Rank2Types, FlexibleInstances ghc-options: -O2 -Wall logict-0.6.0.3/changelog.md0000644000000000000000000000005513462134614013602 0ustar0000000000000000# 0.6.0.3 * Comply with MonadFail proposal.