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

import Control.Applicative
import Control.Monad

import Graphics.Gloss.Data.Picture (text)

import Graphics.WorldTurtle.Internal.Sequence

{- | 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 -> SequenceCommand a
seqW :: SequenceCommand a
  }

instance Functor WorldCommand where
  fmap :: (a -> b) -> WorldCommand a -> WorldCommand b
fmap a -> b
f (WorldCommand SequenceCommand a
a) = SequenceCommand b -> WorldCommand b
forall a. SequenceCommand a -> WorldCommand a
WorldCommand (SequenceCommand b -> WorldCommand b)
-> SequenceCommand b -> WorldCommand b
forall a b. (a -> b) -> a -> b
$! (a -> b) -> SequenceCommand a -> SequenceCommand b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f SequenceCommand a
a

instance Applicative WorldCommand where
  pure :: a -> WorldCommand a
pure a
a = SequenceCommand a -> WorldCommand a
forall a. SequenceCommand a -> WorldCommand a
WorldCommand (SequenceCommand a -> WorldCommand a)
-> SequenceCommand a -> WorldCommand a
forall a b. (a -> b) -> a -> b
$ a -> SequenceCommand 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 SequenceCommand a
a) (WorldCommand SequenceCommand b
b) = SequenceCommand c -> WorldCommand c
forall a. SequenceCommand a -> WorldCommand a
WorldCommand (SequenceCommand c -> WorldCommand c)
-> SequenceCommand c -> WorldCommand c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c)
-> SequenceCommand a -> SequenceCommand b -> SequenceCommand c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f SequenceCommand a
a SequenceCommand b
b

instance Monad WorldCommand where
  (WorldCommand SequenceCommand a
a) >>= :: WorldCommand a -> (a -> WorldCommand b) -> WorldCommand b
>>= a -> WorldCommand b
f = SequenceCommand b -> WorldCommand b
forall a. SequenceCommand a -> WorldCommand a
WorldCommand (SequenceCommand b -> WorldCommand b)
-> SequenceCommand b -> WorldCommand b
forall a b. (a -> b) -> a -> b
$! SequenceCommand a
a SequenceCommand a -> (a -> SequenceCommand b) -> SequenceCommand b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
s -> WorldCommand b -> SequenceCommand b
forall a. WorldCommand a -> SequenceCommand a
seqW (WorldCommand b -> SequenceCommand b)
-> WorldCommand b -> SequenceCommand b
forall a b. (a -> b) -> a -> b
$! a -> WorldCommand b
f a
s

instance Alternative WorldCommand where
  empty :: WorldCommand a
empty = SequenceCommand a -> WorldCommand a
forall a. SequenceCommand a -> WorldCommand a
WorldCommand SequenceCommand a
forall (f :: * -> *) a. Alternative f => f a
empty
  <|> :: WorldCommand a -> WorldCommand a -> WorldCommand a
(<|>) (WorldCommand SequenceCommand a
a) (WorldCommand SequenceCommand a
b) = 
    SequenceCommand a -> WorldCommand a
forall a. SequenceCommand a -> WorldCommand a
WorldCommand (SequenceCommand a -> WorldCommand a)
-> SequenceCommand a -> WorldCommand a
forall a b. (a -> b) -> a -> b
$! SequenceCommand a -> SequenceCommand a -> SequenceCommand a
forall a.
SequenceCommand a -> SequenceCommand a -> SequenceCommand a
alternateSequence SequenceCommand a
a SequenceCommand a
b

instance Semigroup a => Semigroup (WorldCommand a) where
  (WorldCommand SequenceCommand a
a) <> :: WorldCommand a -> WorldCommand a -> WorldCommand a
<> (WorldCommand SequenceCommand a
b) = 
    SequenceCommand a -> WorldCommand a
forall a. SequenceCommand a -> WorldCommand a
WorldCommand (SequenceCommand a -> WorldCommand a)
-> SequenceCommand a -> WorldCommand a
forall a b. (a -> b) -> a -> b
$! SequenceCommand a -> SequenceCommand a -> SequenceCommand a
forall a.
Semigroup a =>
SequenceCommand a -> SequenceCommand a -> SequenceCommand a
combineSequence SequenceCommand a
a SequenceCommand a
b

instance MonadPlus WorldCommand

instance MonadFail WorldCommand where
  fail :: String -> WorldCommand a
fail String
t = SequenceCommand a -> WorldCommand a
forall a. SequenceCommand a -> WorldCommand a
WorldCommand (SequenceCommand a -> WorldCommand a)
-> SequenceCommand a -> WorldCommand a
forall a b. (a -> b) -> a -> b
$! Picture -> SequenceCommand ()
addPicture (String -> Picture
text String
t) SequenceCommand () -> SequenceCommand a -> SequenceCommand a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> SequenceCommand a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
t


{-| 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 -> WorldCommand a
seqT :: Turtle -> WorldCommand a
  }

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

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

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

instance MonadFail TurtleCommand where
  fail :: String -> TurtleCommand a
fail String
t = (Turtle -> WorldCommand a) -> TurtleCommand a
forall a. (Turtle -> WorldCommand a) -> TurtleCommand a
TurtleCommand ((Turtle -> WorldCommand a) -> TurtleCommand a)
-> (Turtle -> WorldCommand a) -> TurtleCommand a
forall a b. (a -> b) -> a -> b
$ \ Turtle
_ -> String -> WorldCommand a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
t

-- | `run` takes a `TurtleCommand` and a `Turtle` to execute the command on. 

--  The result of the computation is returned wrapped in a `WorldCommand`.

--

--  For example, to create  a turtle and get its @x@ `position` one might 

--  write:

--

--  >  myCommand :: Turtle -> WorldCommand Float

--  >  myCommand t = do

--  >    (x, _) <- run position t

--  >    return x

--

--  Or to create a command that accepts a turtle and draws a right angle:

--

--  > myCommand :: Turtle -> WorldCommand ()

--  > myCommand = run $ forward 10 >> right 90 >> forward 10

run :: TurtleCommand a -- ^ Command to execute

    -> Turtle -- ^ Turtle to apply the command upon.

    -> WorldCommand a -- ^ Result as a `WorldCommand`

run :: TurtleCommand a -> Turtle -> WorldCommand a
run = TurtleCommand a -> Turtle -> WorldCommand a
forall a. TurtleCommand a -> Turtle -> WorldCommand a
seqT

seqToT :: (Turtle -> SequenceCommand a) -> TurtleCommand a
seqToT :: (Turtle -> SequenceCommand a) -> TurtleCommand a
seqToT Turtle -> SequenceCommand a
f = (Turtle -> WorldCommand a) -> TurtleCommand a
forall a. (Turtle -> WorldCommand a) -> TurtleCommand a
TurtleCommand ((Turtle -> WorldCommand a) -> TurtleCommand a)
-> (Turtle -> WorldCommand a) -> TurtleCommand a
forall a b. (a -> b) -> a -> b
$ \ Turtle
t -> SequenceCommand a -> WorldCommand a
forall a. SequenceCommand a -> WorldCommand a
WorldCommand (SequenceCommand a -> WorldCommand a)
-> SequenceCommand a -> WorldCommand a
forall a b. (a -> b) -> a -> b
$! Turtle -> SequenceCommand a
f Turtle
t