{-# OPTIONS_HADDOCK hide #-}
module Graphics.WorldTurtle.Internal.Commands
( SeqC
, TurtleCommand (..)
) where
import Control.Applicative
import Control.Monad
import Graphics.Gloss.Data.Picture (text)
import Graphics.WorldTurtle.Internal.Sequence
type SeqC a = SequenceCommand (AlmostVal ()) a
newtype TurtleCommand a = TurtleCommand
{
TurtleCommand a -> SeqC a
seqT :: SeqC a
}
instance Functor TurtleCommand where
fmap :: (a -> b) -> TurtleCommand a -> TurtleCommand b
fmap a -> b
f (TurtleCommand SeqC a
a) = SeqC b -> TurtleCommand b
forall a. SeqC a -> TurtleCommand a
TurtleCommand (SeqC b -> TurtleCommand b) -> SeqC b -> TurtleCommand b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> SeqC a -> SeqC b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f SeqC a
a
instance Applicative TurtleCommand where
pure :: a -> TurtleCommand a
pure a
a = SeqC a -> TurtleCommand a
forall a. SeqC a -> TurtleCommand a
TurtleCommand (SeqC a -> TurtleCommand a) -> SeqC a -> TurtleCommand a
forall a b. (a -> b) -> a -> b
$ a -> SeqC a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
liftA2 :: (a -> b -> c)
-> TurtleCommand a -> TurtleCommand b -> TurtleCommand c
liftA2 a -> b -> c
f (TurtleCommand SeqC a
a) (TurtleCommand SeqC b
b) = SeqC c -> TurtleCommand c
forall a. SeqC a -> TurtleCommand a
TurtleCommand (SeqC c -> TurtleCommand c) -> SeqC c -> TurtleCommand c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> SeqC a -> SeqC b -> SeqC c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f SeqC a
a SeqC b
b
instance Monad TurtleCommand where
(TurtleCommand SeqC a
a) >>= :: TurtleCommand a -> (a -> TurtleCommand b) -> TurtleCommand b
>>= a -> TurtleCommand b
f = SeqC b -> TurtleCommand b
forall a. SeqC a -> TurtleCommand a
TurtleCommand (SeqC b -> TurtleCommand b) -> SeqC b -> TurtleCommand b
forall a b. (a -> b) -> a -> b
$ SeqC a
a SeqC a -> (a -> SeqC b) -> SeqC b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
s -> TurtleCommand b -> SeqC b
forall a. TurtleCommand a -> SeqC a
seqT (a -> TurtleCommand b
f a
s)
instance Alternative TurtleCommand where
empty :: TurtleCommand a
empty = SeqC a -> TurtleCommand a
forall a. SeqC a -> TurtleCommand a
TurtleCommand SeqC a
forall b a. SequenceCommand b a
failSequence
<|> :: TurtleCommand a -> TurtleCommand a -> TurtleCommand a
(<|>) (TurtleCommand SeqC a
a) (TurtleCommand SeqC a
b) =
SeqC a -> TurtleCommand a
forall a. SeqC a -> TurtleCommand a
TurtleCommand (SeqC a -> TurtleCommand a) -> SeqC a -> TurtleCommand a
forall a b. (a -> b) -> a -> b
$ SeqC a -> SeqC a -> SeqC a
forall b a.
SequenceCommand b a -> SequenceCommand b a -> SequenceCommand b a
alternateSequence SeqC a
a SeqC a
b
instance Semigroup a => Semigroup (TurtleCommand a) where
(TurtleCommand SeqC a
a) <> :: TurtleCommand a -> TurtleCommand a -> TurtleCommand a
<> (TurtleCommand SeqC a
b) =
SeqC a -> TurtleCommand a
forall a. SeqC a -> TurtleCommand a
TurtleCommand (SeqC a -> TurtleCommand a) -> SeqC a -> TurtleCommand a
forall a b. (a -> b) -> a -> b
$ SeqC a -> SeqC a -> SeqC a
forall a b.
Semigroup a =>
SequenceCommand b a -> SequenceCommand b a -> SequenceCommand b a
combineSequence SeqC a
a SeqC a
b
instance MonadPlus TurtleCommand
instance MonadFail TurtleCommand where
fail :: String -> TurtleCommand a
fail String
t = SeqC a -> TurtleCommand a
forall a. SeqC a -> TurtleCommand a
TurtleCommand (SeqC a -> TurtleCommand a) -> SeqC a -> TurtleCommand a
forall a b. (a -> b) -> a -> b
$ do
Picture -> SequenceCommand (AlmostVal ()) ()
forall b. Picture -> SequenceCommand b ()
addPicture (Picture -> SequenceCommand (AlmostVal ()) ())
-> Picture -> SequenceCommand (AlmostVal ()) ()
forall a b. (a -> b) -> a -> b
$ String -> Picture
text String
t
SeqC a
forall b a. SequenceCommand b a
failSequence