{-# 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

{-| A `TurtleCommand` represents an instruction to execute. 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 `(>>)`.

    Here is an example of how to write a function that when given a
    @size@ and a @turtle@, will return a new `TurtleCommand` which
    will draw a square with a length and breadth of @size@ using @turtle@.

   @
      drawSquare :: Float -> Turtle -> TurtleCommand ()
      drawSquare size t = replicateM_ 4 $ forward size t >> right 90 t
   @

   This draws a square by doing the following in order:
   
   [@(1/4)@]: 

          * Move forward by @size@ amount. 

          * Turn right by @90@ degrees

     [@(2/4)@]:

          * Move forward by @size@ amount. 

          * Turn right by @90@ degrees

     [@(3/4)@]:

          * Move forward by @size@ amount. 

          * Turn right by @90@ degrees

     [@(4/4)@]:

          * Move forward by @size@ amount. 

          * Turn right by @90@ degrees
-}
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