{-# OPTIONS_HADDOCK hide #-}
module Graphics.WorldTurtle.Internal.Commands
  ( SeqC
  , TurtleCommand (..)
  , WorldCommand (..)
  ) where

import Control.Applicative
import Control.Monad

import Graphics.Gloss.Data.Picture (text)

import Graphics.WorldTurtle.Internal.Sequence

type SeqC a = SequenceCommand (AlmostVal ()) a

{-| A `TurtleCommand` represents an instruction to execute on a turtle.
    It could be as simple as "draw a line" or more complicated like 
    "draw 300 circles."

    `TurtleCommand`s can be executed in order by combining them using
    the monadic operator `(>>)`.

    For example, to draw an equilateral triangle 
    using [do notation](https://en.wikibooks.org/wiki/Haskell/do_notation):

    > drawTriangle :: TurtleCommand ()
    > drawTriangle = do
    >   setHeading east
    >   forward 100
    >   left 120
    >   forward 100
    >   left 120
    >   forward 100

    Which would produce:

    ![draw triangle gif](docs/images/drawtriangle.gif)
-}
newtype TurtleCommand a = TurtleCommand 
  { 
    TurtleCommand a -> Turtle -> SeqC a
seqT :: Turtle -> SeqC a
  }

instance Functor TurtleCommand where
  fmap :: (a -> b) -> TurtleCommand a -> TurtleCommand b
fmap a -> b
f (TurtleCommand Turtle -> SeqC a
a) = (Turtle -> SeqC b) -> TurtleCommand b
forall a. (Turtle -> SeqC a) -> TurtleCommand a
TurtleCommand ((Turtle -> SeqC b) -> TurtleCommand b)
-> (Turtle -> SeqC b) -> TurtleCommand b
forall a b. (a -> b) -> a -> b
$ \ Turtle
t -> (a -> b) -> SeqC a -> SeqC b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Turtle -> SeqC a
a Turtle
t)

instance Applicative TurtleCommand where
  pure :: a -> TurtleCommand a
pure a
a = (Turtle -> SeqC a) -> TurtleCommand a
forall a. (Turtle -> SeqC a) -> TurtleCommand a
TurtleCommand ((Turtle -> SeqC a) -> TurtleCommand a)
-> (Turtle -> SeqC a) -> TurtleCommand a
forall a b. (a -> b) -> a -> b
$ \ Turtle
_ -> 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 Turtle -> SeqC a
a) (TurtleCommand Turtle -> SeqC b
b) = 
    (Turtle -> SeqC c) -> TurtleCommand c
forall a. (Turtle -> SeqC a) -> TurtleCommand a
TurtleCommand ((Turtle -> SeqC c) -> TurtleCommand c)
-> (Turtle -> SeqC c) -> TurtleCommand c
forall a b. (a -> b) -> a -> b
$ \ Turtle
t -> (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 (Turtle -> SeqC a
a Turtle
t) (Turtle -> SeqC b
b Turtle
t)

instance Monad TurtleCommand where
  (TurtleCommand Turtle -> SeqC a
a) >>= :: TurtleCommand a -> (a -> TurtleCommand b) -> TurtleCommand b
>>= a -> TurtleCommand b
f = (Turtle -> SeqC b) -> TurtleCommand b
forall a. (Turtle -> SeqC a) -> TurtleCommand a
TurtleCommand ((Turtle -> SeqC b) -> TurtleCommand b)
-> (Turtle -> SeqC b) -> TurtleCommand b
forall a b. (a -> b) -> a -> b
$ \ Turtle
t -> Turtle -> SeqC a
a Turtle
t SeqC a -> (a -> SeqC b) -> SeqC b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
s -> TurtleCommand b -> Turtle -> SeqC b
forall a. TurtleCommand a -> Turtle -> SeqC a
seqT (a -> TurtleCommand b
f a
s) Turtle
t

instance MonadFail TurtleCommand where
  fail :: String -> TurtleCommand a
fail String
t = (Turtle -> SeqC a) -> TurtleCommand a
forall a. (Turtle -> SeqC a) -> TurtleCommand a
TurtleCommand ((Turtle -> SeqC a) -> TurtleCommand a)
-> (Turtle -> SeqC a) -> TurtleCommand a
forall a b. (a -> b) -> a -> b
$ \ Turtle
_ -> 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

{- | A `WorldCommand` represents an instruction that affects the entire 
     animation canvas.
    
    This could be as simple as "make a turtle" or more complicated like 
    "run these 5 turtles in parallel."

    Like `TurtleCommand`s, `WorldCommand`s can be executed in order by 
    combining commands in order using the monadic operator `(>>)`.

    To execute a `TurtleCommand` in a `WorldCommand`, use either the 
    `Graphics.WorldTurtle.run` function or the 
    `Graphics.WorldTurtle.>/>` operator.

    For how to achieve parallel animations
    see "Graphics.WorldTurtle#parallel".
-}
newtype WorldCommand a = WorldCommand 
  { 
    WorldCommand a -> SeqC a
seqW :: SeqC a
  }

instance Functor WorldCommand where
  fmap :: (a -> b) -> WorldCommand a -> WorldCommand b
fmap a -> b
f (WorldCommand SeqC a
a) = SeqC b -> WorldCommand b
forall a. SeqC a -> WorldCommand a
WorldCommand (SeqC b -> WorldCommand b) -> SeqC b -> WorldCommand 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 WorldCommand where
  pure :: a -> WorldCommand a
pure a
a = SeqC a -> WorldCommand a
forall a. SeqC a -> WorldCommand a
WorldCommand (SeqC a -> WorldCommand a) -> SeqC a -> WorldCommand 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) -> WorldCommand a -> WorldCommand b -> WorldCommand c
liftA2 a -> b -> c
f (WorldCommand SeqC a
a) (WorldCommand SeqC b
b) = SeqC c -> WorldCommand c
forall a. SeqC a -> WorldCommand a
WorldCommand (SeqC c -> WorldCommand c) -> SeqC c -> WorldCommand 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 WorldCommand where
  (WorldCommand SeqC a
a) >>= :: WorldCommand a -> (a -> WorldCommand b) -> WorldCommand b
>>= a -> WorldCommand b
f = SeqC b -> WorldCommand b
forall a. SeqC a -> WorldCommand a
WorldCommand (SeqC b -> WorldCommand b) -> SeqC b -> WorldCommand 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 -> WorldCommand b -> SeqC b
forall a. WorldCommand a -> SeqC a
seqW (a -> WorldCommand b
f a
s)

instance Alternative WorldCommand where
  empty :: WorldCommand a
empty = SeqC a -> WorldCommand a
forall a. SeqC a -> WorldCommand a
WorldCommand SeqC a
forall b a. SequenceCommand b a
failSequence
  <|> :: WorldCommand a -> WorldCommand a -> WorldCommand a
(<|>) (WorldCommand SeqC a
a) (WorldCommand SeqC a
b) = SeqC a -> WorldCommand a
forall a. SeqC a -> WorldCommand a
WorldCommand (SeqC a -> WorldCommand a) -> SeqC a -> WorldCommand 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 (WorldCommand a) where
  (WorldCommand SeqC a
a) <> :: WorldCommand a -> WorldCommand a -> WorldCommand a
<> (WorldCommand SeqC a
b) = SeqC a -> WorldCommand a
forall a. SeqC a -> WorldCommand a
WorldCommand (SeqC a -> WorldCommand a) -> SeqC a -> WorldCommand 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 WorldCommand

instance MonadFail WorldCommand where
  fail :: String -> WorldCommand a
fail String
t = SeqC a -> WorldCommand a
forall a. SeqC a -> WorldCommand a
WorldCommand (SeqC a -> WorldCommand a) -> SeqC a -> WorldCommand 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