{-# LANGUAGE CPP #-}

-- | This module provides a monadic interface to build 'TPath' values.
--   It does so using 'PathBuilder's. The construction of a 'PathBuilder'
--   is equivalent to the construction of a 'TPath' by hand, but with
--   a sometimes more convenient syntax.
--
--   For example, this path corresponds to a triangle:
--
-- > trianglePath :: TPath
-- > trianglePath = bpath (pointAtXY (-1) 0) $ do
-- >    line $ pointAtXY 1 0
-- >    line $ pointAtXY 0 1
-- >    pcycle
--
--   The equivalent syntax created by hand would be:
--
-- > trianglePath :: TPath
-- > trianglePath = Cycle $ Start (pointAtXY (-1) 0) ->- pointAtXY 1 0 ->- pointAtXY 0 1
--
--   The 'Cycle' constructor at the beginning may seem unintuitive, since we are building
--   the path from left to right. In the 'PathBuilder' monad, the instructions are always
--   written in order.
--
module Text.LaTeX.Packages.TikZ.PathBuilder (
   -- * Path builder
   PathBuilder
 , bpath
   -- * Builder functions
 , line
 , pcycle
 , rectangle
 , circle
 , ellipse
 , node
 , grid
   ) where

import Text.LaTeX.Base.Syntax (LaTeX)
import Text.LaTeX.Packages.TikZ.Syntax
import Control.Monad.Trans.State

newtype PathState = PS { PathState -> TPath
currentPath :: TPath }

-- | Use a /path builder/ to construct a value of type 'TPath'.
--   Use 'bpath' for this purpose.
newtype PathBuilder a = PB { forall a. PathBuilder a -> State PathState a
pathBuilder :: State PathState a }

-- Instances

instance Functor PathBuilder where
 fmap :: forall a b. (a -> b) -> PathBuilder a -> PathBuilder b
fmap a -> b
f (PB State PathState a
st) = State PathState b -> PathBuilder b
forall a. State PathState a -> PathBuilder a
PB (State PathState b -> PathBuilder b)
-> State PathState b -> PathBuilder b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> State PathState a -> State PathState b
forall a b.
(a -> b)
-> StateT PathState Identity a -> StateT PathState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f State PathState a
st

instance Applicative PathBuilder where
 pure :: forall a. a -> PathBuilder a
pure = State PathState a -> PathBuilder a
forall a. State PathState a -> PathBuilder a
PB (State PathState a -> PathBuilder a)
-> (a -> State PathState a) -> a -> PathBuilder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> State PathState a
forall a. a -> StateT PathState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
 (PB State PathState (a -> b)
f) <*> :: forall a b. PathBuilder (a -> b) -> PathBuilder a -> PathBuilder b
<*> (PB State PathState a
x) = State PathState b -> PathBuilder b
forall a. State PathState a -> PathBuilder a
PB (State PathState b -> PathBuilder b)
-> State PathState b -> PathBuilder b
forall a b. (a -> b) -> a -> b
$ State PathState (a -> b)
f State PathState (a -> b) -> State PathState a -> State PathState b
forall a b.
StateT PathState Identity (a -> b)
-> StateT PathState Identity a -> StateT PathState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> State PathState a
x

instance Monad PathBuilder where
 return :: forall a. a -> PathBuilder a
return = a -> PathBuilder a
forall a. a -> PathBuilder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
 (PB State PathState a
x) >>= :: forall a b. PathBuilder a -> (a -> PathBuilder b) -> PathBuilder b
>>= a -> PathBuilder b
f = State PathState b -> PathBuilder b
forall a. State PathState a -> PathBuilder a
PB (State PathState b -> PathBuilder b)
-> State PathState b -> PathBuilder b
forall a b. (a -> b) -> a -> b
$ State PathState a
x State PathState a -> (a -> State PathState b) -> State PathState b
forall a b.
StateT PathState Identity a
-> (a -> StateT PathState Identity b)
-> StateT PathState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PathBuilder b -> State PathState b
forall a. PathBuilder a -> State PathState a
pathBuilder (PathBuilder b -> State PathState b)
-> (a -> PathBuilder b) -> a -> State PathState b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PathBuilder b
f

--

applyToPath :: (TPath -> TPath) -> PathBuilder ()
applyToPath :: (TPath -> TPath) -> PathBuilder ()
applyToPath TPath -> TPath
f = State PathState () -> PathBuilder ()
forall a. State PathState a -> PathBuilder a
PB (State PathState () -> PathBuilder ())
-> State PathState () -> PathBuilder ()
forall a b. (a -> b) -> a -> b
$ (PathState -> PathState) -> State PathState ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((PathState -> PathState) -> State PathState ())
-> (PathState -> PathState) -> State PathState ()
forall a b. (a -> b) -> a -> b
$ \PathState
ps -> PathState
ps { currentPath = f (currentPath ps) }

pcycle :: PathBuilder ()
pcycle :: PathBuilder ()
pcycle = (TPath -> TPath) -> PathBuilder ()
applyToPath TPath -> TPath
Cycle

-- | Line from the current point to the given one.
line :: TPoint -> PathBuilder ()
line :: TPoint -> PathBuilder ()
line TPoint
p = (TPath -> TPath) -> PathBuilder ()
applyToPath (TPath -> TPoint -> TPath
`Line` TPoint
p)

-- | Rectangle with the current point as one cornder and the given point
--   as the opposite corner.
rectangle :: TPoint -> PathBuilder ()
rectangle :: TPoint -> PathBuilder ()
rectangle TPoint
p = (TPath -> TPath) -> PathBuilder ()
applyToPath (TPath -> TPoint -> TPath
`Rectangle` TPoint
p)

-- | Circle with the given radius centered at the current point.
circle :: Double -> PathBuilder ()
circle :: Double -> PathBuilder ()
circle Double
r = (TPath -> TPath) -> PathBuilder ()
applyToPath (TPath -> Double -> TPath
`Circle` Double
r)

-- | Ellipse with width and height described by the arguments and centered
--   at the current point.
ellipse :: Double -- ^ Half width of the ellipse.
        -> Double -- ^ Half height of the ellipse.
        -> PathBuilder ()
ellipse :: Double -> Double -> PathBuilder ()
ellipse Double
r1 Double
r2 = (TPath -> TPath) -> PathBuilder ()
applyToPath ((TPath -> TPath) -> PathBuilder ())
-> (TPath -> TPath) -> PathBuilder ()
forall a b. (a -> b) -> a -> b
$ \TPath
x -> TPath -> Double -> Double -> TPath
Ellipse TPath
x Double
r1 Double
r2

grid :: [GridOption] -> TPoint -> PathBuilder ()
grid :: [GridOption] -> TPoint -> PathBuilder ()
grid [GridOption]
xs TPoint
p = (TPath -> TPath) -> PathBuilder ()
applyToPath ((TPath -> TPath) -> PathBuilder ())
-> (TPath -> TPath) -> PathBuilder ()
forall a b. (a -> b) -> a -> b
$ \TPath
x -> TPath -> [GridOption] -> TPoint -> TPath
Grid TPath
x [GridOption]
xs TPoint
p

-- | Text centered at the current point.
node :: LaTeX -> PathBuilder ()
node :: LaTeX -> PathBuilder ()
node LaTeX
l = (TPath -> TPath) -> PathBuilder ()
applyToPath ((TPath -> TPath) -> PathBuilder ())
-> (TPath -> TPath) -> PathBuilder ()
forall a b. (a -> b) -> a -> b
$ \TPath
x -> TPath -> LaTeX -> TPath
Node TPath
x LaTeX
l

-- | Build a path using a /starting point/ and a 'PathBuilder'.
bpath :: TPoint -> PathBuilder a -> TPath
bpath :: forall a. TPoint -> PathBuilder a -> TPath
bpath TPoint
p PathBuilder a
pb = PathState -> TPath
currentPath (PathState -> TPath) -> PathState -> TPath
forall a b. (a -> b) -> a -> b
$ State PathState a -> PathState -> PathState
forall s a. State s a -> s -> s
execState (PathBuilder a -> State PathState a
forall a. PathBuilder a -> State PathState a
pathBuilder PathBuilder a
pb) (TPath -> PathState
PS (TPath -> PathState) -> TPath -> PathState
forall a b. (a -> b) -> a -> b
$ TPoint -> TPath
Start TPoint
p)