{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeFamilies       #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.Canvas.CmdLine
-- Copyright   :  (c) 2011-2014 Diagrams team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Convenient creation of command-line-driven executables for
-- rendering diagrams using the Canvas backend.
--
--
-- * 'defaultMain' creates an executable which can render a single
--   diagram at various options.
--
-- * 'multiMain' is like 'defaultMain' but allows for a list of
--   diagrams from which the user can choose one to render.
--
-- * 'mainWith' is a generic form that does all of the above but with
--   a slightly scarier type.  See "Diagrams.Backend.CmdLine".  This
--   form can also take a function type that has a suitable final result
--   (any of arguments to the above types) and 'Parseable' arguments.
--
-- If you want to generate diagrams programmatically---/i.e./ if you
-- want to do anything more complex than what the below functions
-- provide---you have several options.
--
-- * Use a function with 'mainWith'.  This may require making
--   'Parseable' instances for custom argument types.
--
-- * Make a new 'Mainable' instance.  This may require a newtype
--   wrapper on your diagram type to avoid the existing instances.
--   This gives you more control over argument parsing, intervening
--   steps, and diagram creation.
--
-- * Build option records and pass them along with a diagram to 'mainRender'
--   from "Diagrams.Backend.CmdLine".
--
-- For a tutorial on command-line diagram creation see
-- <https://diagrams.github.io/doc/cmdline.html>.
--
-----------------------------------------------------------------------------

module Diagrams.Backend.Canvas.CmdLine
       (
        -- * General form of @main@
        --  $mainWith
        mainWith

        -- * Supported froms of @main@
       , defaultMain
       , multiMain
       , Canvas
       , B
       ) where

import           Diagrams.Backend.Canvas
import           Diagrams.Backend.CmdLine hiding (height, width)
import           Diagrams.Prelude         hiding (height, option, value, width)
import qualified Graphics.Blank           as BC

import           Data.Data
import           Options.Applicative

data DiaOpts = DiaOpts
  { DiaOpts -> Maybe Int
_width  :: Maybe Int -- ^ Final output width of diagram.
  , DiaOpts -> Maybe Int
_height :: Maybe Int -- ^ Final height of diagram.
  , DiaOpts -> Int
_port   :: Int       -- ^ Port on which to start web server.
  } deriving (Int -> DiaOpts -> ShowS
[DiaOpts] -> ShowS
DiaOpts -> String
(Int -> DiaOpts -> ShowS)
-> (DiaOpts -> String) -> ([DiaOpts] -> ShowS) -> Show DiaOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiaOpts -> ShowS
showsPrec :: Int -> DiaOpts -> ShowS
$cshow :: DiaOpts -> String
show :: DiaOpts -> String
$cshowList :: [DiaOpts] -> ShowS
showList :: [DiaOpts] -> ShowS
Show, Typeable DiaOpts
Typeable DiaOpts =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DiaOpts -> c DiaOpts)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DiaOpts)
-> (DiaOpts -> Constr)
-> (DiaOpts -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DiaOpts))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DiaOpts))
-> ((forall b. Data b => b -> b) -> DiaOpts -> DiaOpts)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DiaOpts -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DiaOpts -> r)
-> (forall u. (forall d. Data d => d -> u) -> DiaOpts -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DiaOpts -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts)
-> Data DiaOpts
DiaOpts -> Constr
DiaOpts -> DataType
(forall b. Data b => b -> b) -> DiaOpts -> DiaOpts
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DiaOpts -> u
forall u. (forall d. Data d => d -> u) -> DiaOpts -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DiaOpts -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DiaOpts -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DiaOpts
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DiaOpts -> c DiaOpts
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DiaOpts)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DiaOpts)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DiaOpts -> c DiaOpts
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DiaOpts -> c DiaOpts
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DiaOpts
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DiaOpts
$ctoConstr :: DiaOpts -> Constr
toConstr :: DiaOpts -> Constr
$cdataTypeOf :: DiaOpts -> DataType
dataTypeOf :: DiaOpts -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DiaOpts)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DiaOpts)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DiaOpts)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DiaOpts)
$cgmapT :: (forall b. Data b => b -> b) -> DiaOpts -> DiaOpts
gmapT :: (forall b. Data b => b -> b) -> DiaOpts -> DiaOpts
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DiaOpts -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DiaOpts -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DiaOpts -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DiaOpts -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DiaOpts -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> DiaOpts -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DiaOpts -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DiaOpts -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DiaOpts -> m DiaOpts
Data, Typeable)

makeLenses ''DiaOpts

diaOpts :: Parser DiaOpts
diaOpts :: Parser DiaOpts
diaOpts = Maybe Int -> Maybe Int -> Int -> DiaOpts
DiaOpts
  (Maybe Int -> Maybe Int -> Int -> DiaOpts)
-> Parser (Maybe Int) -> Parser (Maybe Int -> Int -> DiaOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Int -> Parser (Maybe Int))
-> (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int
-> Parser (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto)
      (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"width" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'w'
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"WIDTH"
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Desired WIDTH of the output image")
  Parser (Maybe Int -> Int -> DiaOpts)
-> Parser (Maybe Int) -> Parser (Int -> DiaOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Int -> Parser (Maybe Int))
-> (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int
-> Parser (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto)
      (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"height" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'h'
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HEIGHT"
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Desired HEIGHT of the output image")
  Parser (Int -> DiaOpts) -> Parser Int -> Parser DiaOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto
      (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"port" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
3000
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PORT"
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Port on which to satrt the web server (default 3000)")

instance Parseable DiaOpts where
  parser :: Parser DiaOpts
parser = Parser DiaOpts
diaOpts

defaultMain :: QDiagram Canvas V2 Double Any -> IO ()
defaultMain :: QDiagram Canvas V2 Double Any -> IO ()
defaultMain = QDiagram Canvas V2 Double Any -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

instance Mainable (QDiagram Canvas V2 Double Any) where
  type MainOpts (QDiagram Canvas V2 Double Any) = DiaOpts

  mainRender :: MainOpts (QDiagram Canvas V2 Double Any)
-> QDiagram Canvas V2 Double Any -> IO ()
mainRender = MainOpts (QDiagram Canvas V2 Double Any)
-> QDiagram Canvas V2 Double Any -> IO ()
DiaOpts -> QDiagram Canvas V2 Double Any -> IO ()
canvasRender

canvasRender :: DiaOpts -> QDiagram Canvas V2 Double Any -> IO ()
canvasRender :: DiaOpts -> QDiagram Canvas V2 Double Any -> IO ()
canvasRender DiaOpts
opts QDiagram Canvas V2 Double Any
d = Options -> (DeviceContext -> IO ()) -> IO ()
BC.blankCanvas (Int -> Options
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DiaOpts
optsDiaOpts -> Getting Int DiaOpts Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int DiaOpts Int
Lens' DiaOpts Int
port)) (DiaOpts -> QDiagram Canvas V2 Double Any -> DeviceContext -> IO ()
canvasDia DiaOpts
opts QDiagram Canvas V2 Double Any
d)

canvasDia :: DiaOpts -> QDiagram Canvas V2 Double Any -> BC.DeviceContext -> IO ()
canvasDia :: DiaOpts -> QDiagram Canvas V2 Double Any -> DeviceContext -> IO ()
canvasDia DiaOpts
opts QDiagram Canvas V2 Double Any
d DeviceContext
context =
  DeviceContext -> Canvas () -> IO ()
forall a. DeviceContext -> Canvas a -> IO a
BC.send DeviceContext
context (Canvas () -> IO ()) -> Canvas () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Canvas
-> Options Canvas V2 Double
-> QDiagram Canvas V2 Double Any
-> Result Canvas V2 Double
forall b (v :: * -> *) n m.
(Backend b v n, HasLinearMap v, Metric v, Typeable n,
 OrderedField n, Monoid' m) =>
b -> Options b v n -> QDiagram b v n m -> Result b v n
renderDia
      Canvas
Canvas
      (SizeSpec V2 Double -> Options Canvas V2 Double
CanvasOptions
        (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> SizeSpec V2 Int -> SizeSpec V2 Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int -> Maybe Int -> SizeSpec V2 Int
forall n. Num n => Maybe n -> Maybe n -> SizeSpec V2 n
mkSizeSpec2D
          (DiaOpts
optsDiaOpts -> Getting (Maybe Int) DiaOpts (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) DiaOpts (Maybe Int)
Lens' DiaOpts (Maybe Int)
width)
          (DiaOpts
optsDiaOpts -> Getting (Maybe Int) DiaOpts (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) DiaOpts (Maybe Int)
Lens' DiaOpts (Maybe Int)
height)))
    QDiagram Canvas V2 Double Any
d

multiMain :: [(String, QDiagram Canvas V2 Double Any)] -> IO ()
multiMain :: [(String, QDiagram Canvas V2 Double Any)] -> IO ()
multiMain = [(String, QDiagram Canvas V2 Double Any)] -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

instance Mainable [(String, QDiagram Canvas V2 Double Any)] where
  type MainOpts [(String, QDiagram Canvas V2 Double Any)] =
    (MainOpts (QDiagram Canvas V2 Double Any), DiagramMultiOpts)

  mainRender :: MainOpts [(String, QDiagram Canvas V2 Double Any)]
-> [(String, QDiagram Canvas V2 Double Any)] -> IO ()
mainRender = (MainOpts (QDiagram Canvas V2 Double Any), DiagramMultiOpts)
-> [(String, QDiagram Canvas V2 Double Any)] -> IO ()
MainOpts [(String, QDiagram Canvas V2 Double Any)]
-> [(String, QDiagram Canvas V2 Double Any)] -> IO ()
forall d.
Mainable d =>
(MainOpts d, DiagramMultiOpts) -> [(String, d)] -> IO ()
defaultMultiMainRender