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

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

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.Html5.CmdLine
-- Copyright   :  (c) 2015 Jeffrey Rosenbluth
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Convenient creation of command-line-driven executables for
-- rendering diagrams using the Html5 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
-- <http://projects.haskell.org/diagrams/doc/cmdline.html>.
--
-----------------------------------------------------------------------------

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

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

import           Diagrams.Prelude          hiding (width, height, option, (<>), value, output)
import           Diagrams.Backend.CmdLine 
import           Diagrams.Backend.Html5

import           Data.List.Split           (splitOn)

defaultMain :: QDiagram Html5 V2 Double Any -> IO ()
defaultMain :: QDiagram Html5 V2 Double Any -> IO ()
defaultMain = forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith
    
instance Mainable (QDiagram Html5 V2 Double Any) where
  type MainOpts (QDiagram Html5 V2 Double Any) = DiagramOpts
  mainRender :: MainOpts (QDiagram Html5 V2 Double Any)
-> QDiagram Html5 V2 Double Any -> IO ()
mainRender = DiagramOpts -> QDiagram Html5 V2 Double Any -> IO ()
html5Render

html5Render :: DiagramOpts -> QDiagram Html5 V2 Double Any -> IO ()
html5Render :: DiagramOpts -> QDiagram Html5 V2 Double Any -> IO ()
html5Render DiagramOpts
opts QDiagram Html5 V2 Double Any
d =
  case forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." (DiagramOpts
optsforall s a. s -> Getting a s a -> a
^.Lens' DiagramOpts String
output) of
    [String
""] -> String -> IO ()
putStrLn String
"No output file given."
    [String]
ps | forall a. [a] -> a
last [String]
ps forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"html"] -> do
           let szSpec :: SizeSpec V2 Double
szSpec = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Num n => Maybe n -> Maybe n -> SizeSpec V2 n
mkSizeSpec2D (DiagramOpts
optsforall s a. s -> Getting a s a -> a
^.Lens' DiagramOpts (Maybe Int)
width) (DiagramOpts
optsforall s a. s -> Getting a s a -> a
^.Lens' DiagramOpts (Maybe Int)
height)
           String
-> SizeSpec V2 Double -> QDiagram Html5 V2 Double Any -> IO ()
renderHtml5 (DiagramOpts
optsforall s a. s -> Getting a s a -> a
^.Lens' DiagramOpts String
output) SizeSpec V2 Double
szSpec QDiagram Html5 V2 Double Any
d
       | Bool
otherwise -> String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Unknown file type: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> a
last [String]
ps

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

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

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