Permalink
Browse files

CatList

  • Loading branch information...
mlang committed Jan 10, 2019
1 parent 6c50afb commit 4d9f859dfa2907dc288f8a88560cea2e6806a042
Showing with 13 additions and 4 deletions.
  1. +2 −1 bower.json
  2. +11 −3 src/Control/Monad/Logic/Class.purs
@@ -14,7 +14,8 @@
"dependencies": {
"purescript-prelude": "^4.1.0",
"purescript-machines": "^5.1.0",
"purescript-transformers": "^4.1.0"
"purescript-transformers": "^4.1.0",
"purescript-catenable-lists": "^5.0.0"
},
"devDependencies": {
"purescript-psci-support": "^4.0.0"
@@ -9,7 +9,10 @@ import Control.Monad.State.Trans (StateT(..))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Writer.Trans (WriterT(..))
import Control.Plus (class Plus, empty, (<|>))
import Data.Array ((:), uncons)
import Data.Array ((:))
import Data.Array (uncons) as Array
import Data.CatList (CatList)
import Data.CatList (cons, singleton, uncons) as CatList
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe)
import Data.Machine.Mealy (MealyT)
@@ -39,10 +42,15 @@ lnot :: forall m a. MonadLogic m => m a -> m Unit
lnot m = ifte (once m) (const empty) (pure unit)

instance monadLogicArray :: MonadLogic Array where
msplit = pure <<< map (\{head, tail} -> Tuple head tail) <<< uncons
interleave xs ys = uncons xs # maybe ys \{head, tail} ->
msplit xs = [Array.uncons xs <#> \{head, tail} -> Tuple head tail]
interleave xs ys = Array.uncons xs # maybe ys \{head, tail} ->
head : interleave ys tail

instance monadLogicCatList :: MonadLogic CatList where
msplit = CatList.singleton <<< CatList.uncons
interleave xs ys = CatList.uncons xs # maybe ys \(Tuple a xs') ->
CatList.cons a $ ys `interleave` xs'

instance monadLogicExceptT :: (Monoid e, MonadLogic m) => MonadLogic (ExceptT e m) where
msplit (ExceptT m) = ExceptT $ msplit m <#> maybe
(Right Nothing) \(Tuple a m') -> map (\x -> Just (Tuple x (ExceptT m'))) a

0 comments on commit 4d9f859

Please sign in to comment.