{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Diagrams.Backend.SVG.CmdLine
(
mainWith
, defaultMain
, multiMain
, SVG
, B
) where
import Diagrams.Backend.CmdLine
import Diagrams.Backend.SVG
import Diagrams.Prelude hiding (height, interval, output,
width)
import Options.Applicative
import Data.List.Split
defaultMain :: SVGFloat n => QDiagram SVG V2 n Any -> IO ()
defaultMain :: QDiagram SVG V2 n Any -> IO ()
defaultMain = QDiagram SVG V2 n Any -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith
newtype PrettyOpt = PrettyOpt {PrettyOpt -> Bool
isPretty :: Bool}
prettyOpt :: Parser PrettyOpt
prettyOpt :: Parser PrettyOpt
prettyOpt = Bool -> PrettyOpt
PrettyOpt (Bool -> PrettyOpt) -> Parser Bool -> Parser PrettyOpt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"pretty"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Pretty print the SVG output")
instance Parseable PrettyOpt where
parser :: Parser PrettyOpt
parser = Parser PrettyOpt
prettyOpt
instance SVGFloat n => Mainable (QDiagram SVG V2 n Any) where
type MainOpts (QDiagram SVG V2 n Any) = (DiagramOpts, DiagramLoopOpts, PrettyOpt)
mainRender :: MainOpts (QDiagram SVG V2 n Any) -> QDiagram SVG V2 n Any -> IO ()
mainRender (opts, loopOpts, pretty) QDiagram SVG V2 n Any
d = do
DiagramOpts -> PrettyOpt -> QDiagram SVG V2 n Any -> IO ()
forall n.
SVGFloat n =>
DiagramOpts -> PrettyOpt -> QDiagram SVG V2 n Any -> IO ()
chooseRender DiagramOpts
opts PrettyOpt
pretty QDiagram SVG V2 n Any
d
DiagramLoopOpts -> IO ()
defaultLoopRender DiagramLoopOpts
loopOpts
chooseRender :: SVGFloat n => DiagramOpts -> PrettyOpt -> QDiagram SVG V2 n Any -> IO ()
chooseRender :: DiagramOpts -> PrettyOpt -> QDiagram SVG V2 n Any -> IO ()
chooseRender DiagramOpts
opts PrettyOpt
pretty QDiagram SVG V2 n Any
d =
case String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." (DiagramOpts
optsDiagramOpts -> Getting String DiagramOpts String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DiagramOpts String
Lens' DiagramOpts String
output) of
[String
""] -> String -> IO ()
putStrLn String
"No output file given."
[String]
ps | [String] -> String
forall a. [a] -> a
last [String]
ps String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"svg"] -> do
let szSpec :: SizeSpec V2 n
szSpec = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> n) -> SizeSpec V2 Int -> SizeSpec V2 n
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 (DiagramOpts
optsDiagramOpts
-> Getting (Maybe Int) DiagramOpts (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) DiagramOpts (Maybe Int)
Lens' DiagramOpts (Maybe Int)
width) (DiagramOpts
optsDiagramOpts
-> Getting (Maybe Int) DiagramOpts (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) DiagramOpts (Maybe Int)
Lens' DiagramOpts (Maybe Int)
height)
if PrettyOpt -> Bool
isPretty PrettyOpt
pretty
then String -> SizeSpec V2 n -> QDiagram SVG V2 n Any -> IO ()
forall n.
SVGFloat n =>
String -> SizeSpec V2 n -> QDiagram SVG V2 n Any -> IO ()
renderPretty (DiagramOpts
optsDiagramOpts -> Getting String DiagramOpts String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DiagramOpts String
Lens' DiagramOpts String
output) SizeSpec V2 n
szSpec QDiagram SVG V2 n Any
d
else String -> SizeSpec V2 n -> QDiagram SVG V2 n Any -> IO ()
forall n.
SVGFloat n =>
String -> SizeSpec V2 n -> QDiagram SVG V2 n Any -> IO ()
renderSVG (DiagramOpts
optsDiagramOpts -> Getting String DiagramOpts String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DiagramOpts String
Lens' DiagramOpts String
output) SizeSpec V2 n
szSpec QDiagram SVG V2 n Any
d
| Bool
otherwise -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Unknown file type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. [a] -> a
last [String]
ps
multiMain :: SVGFloat n => [(String, QDiagram SVG V2 n Any)] -> IO ()
multiMain :: [(String, QDiagram SVG V2 n Any)] -> IO ()
multiMain = [(String, QDiagram SVG V2 n Any)] -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith
instance SVGFloat n => Mainable [(String,QDiagram SVG V2 n Any)] where
type MainOpts [(String,QDiagram SVG V2 n Any)]
= (MainOpts (QDiagram SVG V2 n Any), DiagramMultiOpts)
mainRender :: MainOpts [(String, QDiagram SVG V2 n Any)]
-> [(String, QDiagram SVG V2 n Any)] -> IO ()
mainRender = MainOpts [(String, QDiagram SVG V2 n Any)]
-> [(String, QDiagram SVG V2 n Any)] -> IO ()
forall d.
Mainable d =>
(MainOpts d, DiagramMultiOpts) -> [(String, d)] -> IO ()
defaultMultiMainRender