Skip to content
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ Bugfixes:
Other improvements:

- Added module documentation to `Data.Machine.Mealy` ([#39](https://github.com/purescript-contrib/purescript-machines/pull/39))
- Loosened constraints on functions and instances ([#43](https://github.com/purescript-contrib/purescript-machines/pull/43))

## [v5.1.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v5.1.0) - 2018-06-06

Expand Down
58 changes: 29 additions & 29 deletions src/Data/Machine/Mealy.purs
Original file line number Diff line number Diff line change
Expand Up @@ -91,7 +91,7 @@ type Sink f s = MealyT f s Unit
-- | ```purescript
-- | take 10 $ source (pure 1)
-- | ```
source :: forall f s. (Monad f) => f s -> Source f s
source :: forall f s. Functor f => f s -> Source f s
source src = mealy $ \_ -> flip Emit (source src) <$> src

-- | Construct a machine which executes an effectful computation on its inputs.
Expand All @@ -100,7 +100,7 @@ source src = mealy $ \_ -> flip Emit (source src) <$> src
-- | ```purescript
-- | take 10 $ source (pure 1) >>> sink logShow
-- | ```
sink :: forall f a. (Monad f) => (a -> f Unit) -> Sink f a
sink :: forall f a. Functor f => (a -> f Unit) -> Sink f a
sink f = mealy $ \a -> const (Emit unit (sink f)) <$> f a

-- | Run a machine as an effectful computatation.
Expand All @@ -109,13 +109,13 @@ sink f = mealy $ \a -> const (Emit unit (sink f)) <$> f a
-- | ```purescript
-- | runMealy $ take 10 $ source (pure 1) >>> sink logShow
-- | ```
runMealy :: forall f. (Monad f) => MealyT f Unit Unit -> f Unit
runMealy :: forall f. Monad f => MealyT f Unit Unit -> f Unit
runMealy m = stepMealy unit m >>= f
where f Halt = pure unit
f (Emit _ m') = runMealy m'

-- | Execute (unroll) a single step on a machine.
stepMealy :: forall f s a. (Monad f) => s -> MealyT f s a -> f (Step f s a)
stepMealy :: forall f s a. s -> MealyT f s a -> f (Step f s a)
stepMealy = flip runMealyT

-- | Wrap a pure function into a machine. The function can either
Expand All @@ -131,35 +131,35 @@ stepMealy = flip runMealyT
-- | go 0 = Halt
-- | go n = Emit n (pureMealy haltOn0)
-- | ```
pureMealy :: forall f s a. (Applicative f) => (s -> Step f s a ) -> MealyT f s a
pureMealy :: forall f s a. Applicative f => (s -> Step f s a ) -> MealyT f s a
pureMealy = MealyT <<< map pure

-- | Wrap an effectful function into a machine. See `pureMealy` for
-- | an example using pure functions.
mealy :: forall f s a. (Applicative f) => (s -> f (Step f s a)) -> MealyT f s a
mealy :: forall f s a. (s -> f (Step f s a)) -> MealyT f s a
mealy = MealyT

-- | A machine which halts for any input.
halt :: forall f s a. (Applicative f) => MealyT f s a
halt :: forall f s a. Applicative f => MealyT f s a
halt = pureMealy $ const Halt

-- | Limit the number of outputs of a machine. After using up the `n`
-- | allotted outputs, the machine will halt.
take :: forall f s a. (Monad f) => Int -> MealyT f s a -> MealyT f s a
take :: forall f s a. Applicative f => Int -> MealyT f s a -> MealyT f s a
take n m = if n <= 0 then halt
else mealy $ \s -> f <$> stepMealy s m
where f Halt = Halt
f (Emit a m') = Emit a (take (n - 1) m')

-- | Skip a number of outputs for a machine.
drop :: forall f s a. (Monad f) => Int -> MealyT f s a -> MealyT f s a
drop :: forall f s a. Monad f => Int -> MealyT f s a -> MealyT f s a
drop n m = if n <= 0 then m
else mealy $ \s -> let f Halt = pure Halt
f (Emit a m') = stepMealy s (drop (n - 1) m')
in stepMealy s m >>= f

-- | Loop a machine forever.
loop :: forall f s a. (Monad f) => MealyT f s a -> MealyT f s a
loop :: forall f s a. Monad f => MealyT f s a -> MealyT f s a
loop m0 = loop' m0
where
loop' m = mealy $ \s ->
Expand All @@ -180,69 +180,69 @@ toUnfoldable s = unfoldr stepUnfold
Halt -> Nothing

-- | Zip two machines together under some function `f`.
zipWith :: forall f s a b c. (Monad f) => (a -> b -> c) -> MealyT f s a -> MealyT f s b -> MealyT f s c
zipWith :: forall f s a b c. Apply f => (a -> b -> c) -> MealyT f s a -> MealyT f s b -> MealyT f s c
zipWith f a b = f <$> a <*> b

-- | Accumulate the outputs of a machine into a new machine.
scanl :: forall f s a b. (Monad f) => (b -> a -> b) -> b -> MealyT f s a -> MealyT f s b
scanl :: forall f s a b. Functor f => (b -> a -> b) -> b -> MealyT f s a -> MealyT f s b
scanl f = go where
go b m = mealy $ \s -> let g Halt = Halt
g (Emit a m') = (let b' = f b a in Emit b' (go b' m'))
in g <$> stepMealy s m

-- | Accumulates the outputs of a machine as a `List`.
collect :: forall f s a. (Monad f) => MealyT f s a -> MealyT f s (List a)
collect :: forall f s a. Functor f => MealyT f s a -> MealyT f s (List a)
collect = scanl (flip Cons) Nil

-- | Creates a machine which emits a single value before halting.
singleton :: forall f s a. (Monad f) => a -> MealyT f s a
singleton :: forall f s a. Applicative f => a -> MealyT f s a
singleton a = pureMealy $ \s -> Emit a halt

-- | Creates a machine which either emits a single value before halting
-- | (for `Just`), or just halts (in the case of `Nothing`).
fromMaybe :: forall f s a. (Monad f) => Maybe a -> MealyT f s a
fromMaybe :: forall f s a. Applicative f => Maybe a -> MealyT f s a
fromMaybe Nothing = halt
fromMaybe (Just a) = singleton a

-- | Creates a machine whbich emits all the values of the array before
-- | halting.
fromArray :: forall f s a. (Monad f) => Array a -> MealyT f s a
fromArray :: forall f s a. Monad f => Array a -> MealyT f s a
fromArray a = let len = length a
go n | n < zero || n >= len = halt
go n = fromMaybe (a !! n) <> go (n + one)
in go zero

-- | Creates a machine which wraps an effectful computation and ignores
-- | its input.
wrapEffect :: forall f s a. (Monad f) => f a -> MealyT f s a
wrapEffect :: forall f s a. Applicative f => f a -> MealyT f s a
wrapEffect fa = MealyT $ const (flip Emit halt <$> fa)

-- MonadLogic -- TODO: Create a purescript-logic package
-- | Unwrap a machine such that its output is either `Nothing` in case
-- | it would halt, or `Just` the output value and the next computation.
msplit :: forall f s a. (Monad f) => MealyT f s a -> MealyT f s (Maybe (Tuple a (MealyT f s a)))
msplit :: forall f s a. Applicative f => MealyT f s a -> MealyT f s (Maybe (Tuple a (MealyT f s a)))
msplit m = mealy $ \s -> f <$> stepMealy s m
where f Halt = Emit (Nothing) halt
f (Emit a m') = Emit (Just $ Tuple a m') (msplit m')

-- | Interleaves the values of two machines with matching inputs and
-- | outputs.
interleave :: forall f s a. (Monad f) => MealyT f s a -> MealyT f s a -> MealyT f s a
interleave :: forall f s a. Monad f => MealyT f s a -> MealyT f s a -> MealyT f s a
interleave m1 m2 = mealy $ \s ->
stepMealy s m1 >>= case _ of
Halt -> stepMealy s m2
Emit a m1' -> pure $ Emit a (interleave m2 m1')

-- | Takes a single output from a machine.
once :: forall f s a. (Monad f) => MealyT f s a -> MealyT f s a
once :: forall f s a. Applicative f => MealyT f s a -> MealyT f s a
once = take 1

-- | If then else: given a machine producing `a`, a continuation `f`,
-- | and a machine producing `b`, generate a machine which will
-- | grab outputs from the first machine and pass them over to the
-- | continuation as long as neither halts.
-- | Once the process halts, the second (`b`) machine is returned.
ifte :: forall f s a b. (Monad f) => MealyT f s a -> (a -> MealyT f s b) -> MealyT f s b -> MealyT f s b
ifte :: forall f s a b. Monad f => MealyT f s a -> (a -> MealyT f s b) -> MealyT f s b -> MealyT f s b
ifte ma f mb = mealy $ \s ->
stepMealy s ma >>= case _ of
Halt -> stepMealy s mb
Expand All @@ -255,31 +255,31 @@ ifte ma f mb = mealy $ \s ->
-- | Given a machine and a continuation, it will pass outputs from
-- | the machine to the continuation as long as possible until
-- | one of them halts.
when :: forall f s a b. (Monad f) => MealyT f s a -> (a -> MealyT f s b) -> MealyT f s b
when :: forall f s a b. Monad f => MealyT f s a -> (a -> MealyT f s b) -> MealyT f s b
when ma f = ifte ma f halt

instance functorMealy :: (Monad f) => Functor (MealyT f s) where
instance functorMealy :: (Functor f) => Functor (MealyT f s) where
map f m = mealy $ \s -> g <$> stepMealy s m where
g (Emit a m') = Emit (f a) (f <$> m')
g Halt = Halt

instance applyMealy :: (Monad f) => Apply (MealyT f s) where
instance applyMealy :: (Apply f) => Apply (MealyT f s) where
apply f x = mealy $ \s -> ap <$> stepMealy s f <*> stepMealy s x
where
ap Halt _ = Halt
ap _ Halt = Halt
ap (Emit f' g) (Emit x' y) = Emit (f' x') (g <*> y)

instance applicativeMealy :: (Monad f) => Applicative (MealyT f s) where
instance applicativeMealy :: (Applicative f) => Applicative (MealyT f s) where
pure t = pureMealy $ \s -> Emit t halt

instance profunctorMealy :: (Monad f) => Profunctor (MealyT f) where
instance profunctorMealy :: (Functor f) => Profunctor (MealyT f) where
dimap l r = remap where
remap m = mealy $ \s -> g <$> stepMealy (l s) m where
g (Emit c m') = Emit (r c) (remap m')
g Halt = Halt

instance strongMealy :: (Monad f) => Strong (MealyT f) where
instance strongMealy :: (Functor f) => Strong (MealyT f) where
first m = mealy $ \s -> let b = fst s
d = snd s
g (Emit c f') = Emit (Tuple c d) (first f')
Expand Down Expand Up @@ -331,8 +331,8 @@ instance monadZero :: (Monad f) => MonadZero (MealyT f s)

instance monadPlus :: (Monad f) => MonadPlus (MealyT f s)

instance monadEffectMealy :: (Monad f, MonadEffect f) => MonadEffect (MealyT f s) where
instance monadEffectMealy :: MonadEffect f => MonadEffect (MealyT f s) where
liftEffect = wrapEffect <<< liftEffect

instance lazyMealy :: (Monad f) => Lazy (MealyT f s a) where
instance lazyMealy :: Lazy (MealyT f s a) where
defer f = mealy \s -> runMealyT (f unit) s