commandert (empty) → 0.1.0.0

raw patch · 5 files changed

+179/−0 lines, 5 filesdep +basedep +commandertdep +hspec

Dependencies added: base, commandert, hspec, mtl

Files

• LICENSE +9/−0
• README.md +3/−0
• commandert.cabal +37/−0
• src/Control/Monad/Commander.hs +95/−0
• test/Test.hs +35/−0

@@ -0,0 +1,9 @@+Copyright 2020 Samuel Schlesinger++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++

@@ -0,0 +1,3 @@+# commander++Free stateful backtracking monad for any functor.

@@ -0,0 +1,37 @@+cabal-version:       2.4++name:                commandert+version:             0.1.0.0+synopsis:            A monad for commanders+description:         A monad for commanders.+homepage:            https://github.com/SamuelSchlesinger/commandert+bug-reports:         https://github.com/SamuelSchlesinger/commander/issues+license:             MIT+license-file:        LICENSE+author:              Samuel Schlesinger+maintainer:          sgschlesinger@gmail.com+copyright:           2019 Samuel Schlesinger+category:            Control+extra-source-files:  README.md+tested-with:         GHC ==8.6.5 || ==8.8.4 || ==8.10.2++source-repository head+  type: git +  location: https://github.com/samuelschlesinger/commander++library+  exposed-modules:     Control.Monad.Commander+  build-depends:       base >=4.12 && < 4.15,+                       mtl >=2.2,+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite commander-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Test.hs+  build-depends:       base >=4.12 && <4.15,+                       hspec >=2.7.4,+                       mtl >=1.0,+                       commandert+  default-language:    Haskell2010

@@ -0,0 +1,95 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DeriveFunctor #-}+{- |+Module: Control.Monad.Commander+Description: A monad for stateful, backtracking computations+Copyright: (c) Samuel Schlesinger 2020+License: MIT+Maintainer: sgschlesinger@gmail.com+Stability: experimental+Portability: POSIX, Windows+-}+module Control.Monad.Commander (+  -- ** The CommanderT Monad+  {- |+    The 'CommanderT' monad is stateful and has the ability to backtrack.+  -}+  CommanderT(Action, Defeat, Victory), runCommanderT, hoistToFunctor, hoistFromFunctor,+) where++import Control.Arrow (first)+import Control.Monad (ap, MonadPlus)+import Control.Monad.Trans (MonadTrans, lift, liftIO, MonadIO)+import Control.Applicative (Alternative(empty, (<|>)))++-- | A 'CommanderT' action is a metaphor for a military commander. At each+-- step, we have a new 'Action' to take, or we could have experienced+-- 'Defeat', or we can see 'Victory'. While a real life commander+-- worries about moving his troops around in order to achieve a victory in+-- battle, a 'CommanderT' worries about iteratively transforming a state +-- to find some value.+--+-- In more practical terms, a term of type 'CommanderT' can be thought of+-- as a backtracking, stateful computation which can either result in+-- a result being produced, or nothing being produced. It is a+-- 'Monad' for any base 'Functor' you want to use as the effect inside of+-- the stateful computation, similarly to the free monad.+data CommanderT state f a+  = Action (state -> f (CommanderT state f a, state))+  | Defeat+  | Victory a+  deriving Functor++-- | We can run a 'CommanderT' on some state and see if it has+-- a successful campaign.+runCommanderT :: Monad m +              => CommanderT state m a +              -> state +              -> m (Maybe a)+runCommanderT (Action action) state = do+  (action', state') <- action state+  runCommanderT action' state'+runCommanderT Defeat _ = return Nothing+runCommanderT (Victory a) _ = return (Just a)++-- | We can go from a non-'Functor' to a 'Functor' inside of a 'CommanderT'+-- action. This does the transformation "top to bottom", as opposed to+-- 'hoistFromFunctor', which does it "bottom to top". If your natural+-- transformation is lessening, i.e. it trims branching structure, then you+-- probably want to use this function.+hoistToFunctor :: Functor g => (forall a. f a -> g a) -> CommanderT state f a -> CommanderT state g a+hoistToFunctor phi (Action action) = Action (fmap (fmap (first (hoistToFunctor phi))) $ fmap phi action)++-- | We can go from a 'Functor' to a non-'Functor' inside of a 'CommanderT'+-- action. This does the transformation "bottom to top", as opposed to+-- 'hoistToFunctor', which does it "top to bottom". If your natural+-- transformation is increasing, i.e. it adds branching structure, then you+-- probably want to use this function.+hoistFromFunctor :: Functor f => (forall a. f a -> g a) -> CommanderT state f a -> CommanderT state g a+hoistFromFunctor phi (Action action) = Action (fmap phi $ fmap (fmap (first (hoistFromFunctor phi))) action)++instance Functor f => Applicative (CommanderT state f) where+  (<*>) = ap+  pure = Victory++instance MonadTrans (CommanderT state) where+  lift ma = Action $ \state -> do+    a <- ma+    return (pure a, state)++instance MonadIO m => MonadIO (CommanderT state m) where+  liftIO ma = Action $ \state -> do+    a <- liftIO ma+    return (pure a, state)++instance Functor f => Monad (CommanderT state f) where+  Defeat >>= _ = Defeat+  Victory a >>= f = f a+  Action action >>= f = Action (fmap (\(a, s) -> (a >>= f, s)) . action)++instance Functor f => Alternative (CommanderT state f) where+  empty = Defeat +  Defeat <|> a = a +  v@(Victory _) <|> _ = v+  Action action <|> p = Action (fmap (\(a, s) -> (a <|> p, s)) . action)

@@ -0,0 +1,35 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE BlockArguments #-}+module Main where++import Test.Hspec+import Control.Monad.IO.Class+import Control.Monad.Commander+import Control.Applicative++main :: IO ()+main = hspec $ do+  describe "Control.Monad.Commander" do+    describe "runCommanderT" do+      it "runs Victory to Just" do+        runCommanderT (Victory ()) () `shouldReturn` Just ()+      it "runs Defeat to Nothing" do+        runCommanderT Defeat () `shouldReturn` Nothing @()+      it "runs pure to Just" do+        runCommanderT (pure ()) () `shouldReturn` Just ()+      it "runs a stateful action to completion" do+        let action = Action \n -> pure (if n > 0 then action else pure (), n - 1)+        runCommanderT action 100 `shouldReturn` Just ()+      it "backtracks successfully" do+        runCommanderT (Defeat <|> pure 10) () `shouldReturn` Just 10+        runCommanderT (Defeat <|> (Action \() -> pure (Defeat, ()))) () `shouldReturn` Nothing @()+        runCommanderT (Defeat <|> (Action \() -> pure (Defeat, ())) <|> pure 10) () `shouldReturn` Just 10+    it "has a reasonable functor instance" do+      runCommanderT (fmap (+ 1) (pure 10)) () `shouldReturn` Just 11+      x <- runCommanderT (fmap (+ 1) $ fmap (+ 2) (pure 10)) ()+      y <- runCommanderT (fmap ((+ 1) . (+ 2)) (pure 10)) ()+      x `shouldBe` y+    it "has a reasonable applicative instance" do+      runCommanderT (pure (+ 10) <*> pure 10) () `shouldReturn` Just 20+    it "has a reasonable monad instance" do+      runCommanderT (do { x <- pure 10; y <- pure 11; pure (x + y) }) () `shouldReturn` Just 21