{-# LANGUAGE CPP                  #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.PGF.CmdLine
-- Copyright   :  (c) 2015 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 PGF backend.
--
-----------------------------------------------------------------------------

module Diagrams.Backend.PGF.CmdLine
  ( -- * General form of @main@
    -- $mainwith

    mainWith

    -- * Supported forms of @main@

  , defaultMain
  , mainWithSurf
  , onlineMain
  , onlineMainWithSurf
  , multiMain

  , module Diagrams.Backend.PGF
  ) where

import           Data.ByteString.Builder
import           Options.Applicative          as OP

import           System.IO                    (stdout)

import           Diagrams.Backend.CmdLine
import           Diagrams.Prelude             hiding (height, interval, output,
                                               width)

import           Diagrams.Backend.PGF
import           Diagrams.Backend.PGF.Surface

-- pgf specific stuff

data PGFCmdLineOpts = PGFCmdLineOpts
  { PGFCmdLineOpts -> Bool
_cmdStandalone :: Bool
  , PGFCmdLineOpts -> Bool
_cmdReadable   :: Bool
  }

makeLenses ''PGFCmdLineOpts

instance Parseable PGFCmdLineOpts where
  parser :: Parser PGFCmdLineOpts
parser = Bool -> Bool -> PGFCmdLineOpts
PGFCmdLineOpts
        (Bool -> Bool -> PGFCmdLineOpts)
-> Parser Bool -> Parser (Bool -> PGFCmdLineOpts)
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
"standalone"
           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
'a'
           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
"Produce standalone .tex output"
            )
        Parser (Bool -> PGFCmdLineOpts)
-> Parser Bool -> Parser PGFCmdLineOpts
forall (f :: * -> *) a b. Applicative f => 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
"readable"
           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
'r'
           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
"Indent lines"
            )

-- not sure if this is of any use
instance ToResult d => ToResult (OnlineTex d) where
  type Args (OnlineTex d) = (Surface, Args d)
  type ResultOf (OnlineTex d) = IO (ResultOf d)

  toResult :: OnlineTex d -> Args (OnlineTex d) -> ResultOf (OnlineTex d)
toResult OnlineTex d
d (surf, args) = (d -> Args d -> ResultOf d) -> Args d -> d -> ResultOf d
forall a b c. (a -> b -> c) -> b -> a -> c
flip d -> Args d -> ResultOf d
forall d. ToResult d => d -> Args d -> ResultOf d
toResult Args d
args (d -> ResultOf d) -> IO d -> IO (ResultOf d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Surface -> OnlineTex d -> IO d
forall a. Surface -> OnlineTex a -> IO a
surfOnlineTexIO Surface
surf OnlineTex d
d

-- $mainwith
-- The 'mainWith' method unifies all of the other forms of @main@ and is
-- now the recommended way to build a command-line diagrams program.  It
-- works as a direct replacement for 'defaultMain' or 'multiMain' as well
-- as allowing more general arguments.  For example, given a function that
-- produces a diagram when given an @Int@ and a @'Colour' Double@, 'mainWith'
-- will produce a program that looks for additional number and color arguments.
--
-- > ... definitions ...
-- > f :: Int -> Colour Double -> Diagram PGF
-- > f i c = ...
-- >
-- > main = mainWith f
--
-- We can run this program as follows:
--
-- > $ ghc --make mydiagram
-- >
-- > # output image.tex built by `f 20 red`
-- > $ ./MyDiagram -o image.tex -w 200 20 red


-- | This is the simplest way to render diagrams, and is intended to
--   be used like so:
--
-- > ... definitions ...
-- >
-- > main = defaultMain myDiagram
--
--   Compiling this file will result in an executable which takes
--   various command-line options for setting the size, output file,
--   and so on, and renders @myDiagram@ with the specified options.
--
--   Pass @--help@ to the generated executable to see all available
--   options. Currently it looks something like
--
-- @
-- mydiagram
--
-- Usage: mydiagram [-?|--help] [-w|--width WIDTH] [-h|--height HEIGHT]
--                  [-o|--output OUTPUT] [-f|--format FORMAT] [-a|--standalone]
--                  [-r|--readable] [-l|--loop] [-s|--src ARG]
--                  [-i|--interval INTERVAL]
--   Command-line diagram generation.
--
-- Available options:
--   -?,--help                Show this help text
--   -w,--width WIDTH         Desired WIDTH of the output image
--   -h,--height HEIGHT       Desired HEIGHT of the output image
--   -o,--output OUTPUT       OUTPUT file
--   -f,--format FORMAT       l for LaTeX, c for ConTeXt, p for plain
--                            TeX (default: LaTeX)
--   -a,--standalone          Produce standalone .tex output
--   -r,--readable            Indent lines
--   -l,--loop                Run in a self-recompiling loop
--   -s,--src ARG             Source file to watch
--   -i,--interval INTERVAL   When running in a loop, check for changes every
--                            INTERVAL seconds.
-- @
--
--   For example, a common scenario is
--
-- @
-- $ ghc --make mydiagram
--
--   # output image.tex with a width of 400bp (and auto-determined height)
--   # (bp = big point = 1px at 72dpi)
-- $ ./mydiagram -o image.tex -w 400
-- @

defaultMain :: Diagram PGF -> IO ()
defaultMain :: Diagram PGF -> IO ()
defaultMain = Diagram PGF -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

-- | Allows you to pick a surface the diagram will be rendered with.
-- (This
mainWithSurf :: Surface -> Diagram PGF -> IO ()
mainWithSurf :: Surface -> Diagram PGF -> IO ()
mainWithSurf = ((Surface, QDiagram PGF V2 Double Any) -> IO ())
-> Surface -> QDiagram PGF V2 Double Any -> IO ()
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Surface, QDiagram PGF V2 Double Any) -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

-- For online diagrams.

-- | Same as @defaultMain@ but takes an online pgf diagram.
onlineMain :: OnlineTex (Diagram PGF) -> IO ()
onlineMain :: OnlineTex (Diagram PGF) -> IO ()
onlineMain = OnlineTex (Diagram PGF) -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

-- | Same as @mainWithSurf@ but takes an online pgf diagram.
onlineMainWithSurf :: Surface -> OnlineTex (Diagram PGF) -> IO ()
onlineMainWithSurf :: Surface -> OnlineTex (Diagram PGF) -> IO ()
onlineMainWithSurf = ((Surface, OnlineTex (QDiagram PGF V2 Double Any)) -> IO ())
-> Surface -> OnlineTex (QDiagram PGF V2 Double Any) -> IO ()
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Surface, OnlineTex (QDiagram PGF V2 Double Any)) -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

-- Mainable instances

instance TypeableFloat n => Mainable (QDiagram PGF V2 n Any) where
  type MainOpts (QDiagram PGF V2 n Any) =
    (DiagramOpts, DiagramLoopOpts, PGFCmdLineOpts, TexFormat)
  mainRender :: MainOpts (QDiagram PGF V2 n Any) -> QDiagram PGF V2 n Any -> IO ()
mainRender (diaOpts, loopOpts, pgfOpts, format) QDiagram PGF V2 n Any
d = do
    DiagramOpts
-> PGFCmdLineOpts -> Surface -> QDiagram PGF V2 n Any -> IO ()
forall n.
TypeableFloat n =>
DiagramOpts
-> PGFCmdLineOpts -> Surface -> QDiagram PGF V2 n Any -> IO ()
chooseRender DiagramOpts
diaOpts PGFCmdLineOpts
pgfOpts (TexFormat -> Surface
formatToSurf TexFormat
format) QDiagram PGF V2 n Any
d
    DiagramLoopOpts -> IO ()
defaultLoopRender DiagramLoopOpts
loopOpts

instance TypeableFloat n => Mainable (Surface, QDiagram PGF V2 n Any) where
  type MainOpts (Surface, QDiagram PGF V2 n Any) =
    (DiagramOpts, DiagramLoopOpts, PGFCmdLineOpts)
  mainRender :: MainOpts (Surface, QDiagram PGF V2 n Any)
-> (Surface, QDiagram PGF V2 n Any) -> IO ()
mainRender (diaOpts, loopOpts, pgfOpts) (Surface
surf,QDiagram PGF V2 n Any
d) = do
    DiagramOpts
-> PGFCmdLineOpts -> Surface -> QDiagram PGF V2 n Any -> IO ()
forall n.
TypeableFloat n =>
DiagramOpts
-> PGFCmdLineOpts -> Surface -> QDiagram PGF V2 n Any -> IO ()
chooseRender DiagramOpts
diaOpts PGFCmdLineOpts
pgfOpts Surface
surf QDiagram PGF V2 n Any
d
    DiagramLoopOpts -> IO ()
defaultLoopRender DiagramLoopOpts
loopOpts

-- Online diagrams
instance TypeableFloat n => Mainable (OnlineTex (QDiagram PGF V2 n Any)) where
  type MainOpts (OnlineTex (QDiagram PGF V2 n Any))
    = (DiagramOpts, DiagramLoopOpts, PGFCmdLineOpts, TexFormat)
  mainRender :: MainOpts (OnlineTex (QDiagram PGF V2 n Any))
-> OnlineTex (QDiagram PGF V2 n Any) -> IO ()
mainRender (diaOpts, loopOpts, pgfOpts, format) OnlineTex (QDiagram PGF V2 n Any)
d = do
    DiagramOpts
-> PGFCmdLineOpts
-> Surface
-> OnlineTex (QDiagram PGF V2 n Any)
-> IO ()
forall n.
TypeableFloat n =>
DiagramOpts
-> PGFCmdLineOpts
-> Surface
-> OnlineTex (QDiagram PGF V2 n Any)
-> IO ()
chooseOnlineRender DiagramOpts
diaOpts PGFCmdLineOpts
pgfOpts (TexFormat -> Surface
formatToSurf TexFormat
format) OnlineTex (QDiagram PGF V2 n Any)
d
    DiagramLoopOpts -> IO ()
defaultLoopRender DiagramLoopOpts
loopOpts

instance TypeableFloat n => Mainable (Surface, OnlineTex (QDiagram PGF V2 n Any)) where
  type MainOpts (Surface, OnlineTex (QDiagram PGF V2 n Any))
    = (DiagramOpts, DiagramLoopOpts, PGFCmdLineOpts)
  mainRender :: MainOpts (Surface, OnlineTex (QDiagram PGF V2 n Any))
-> (Surface, OnlineTex (QDiagram PGF V2 n Any)) -> IO ()
mainRender (diaOpts, loopOpts, pgfOpts) (Surface
surf, OnlineTex (QDiagram PGF V2 n Any)
d) = do
    DiagramOpts
-> PGFCmdLineOpts
-> Surface
-> OnlineTex (QDiagram PGF V2 n Any)
-> IO ()
forall n.
TypeableFloat n =>
DiagramOpts
-> PGFCmdLineOpts
-> Surface
-> OnlineTex (QDiagram PGF V2 n Any)
-> IO ()
chooseOnlineRender DiagramOpts
diaOpts PGFCmdLineOpts
pgfOpts Surface
surf OnlineTex (QDiagram PGF V2 n Any)
d
    DiagramLoopOpts -> IO ()
defaultLoopRender DiagramLoopOpts
loopOpts

formatToSurf :: TexFormat -> Surface
formatToSurf :: TexFormat -> Surface
formatToSurf TexFormat
format = case TexFormat
format of
  TexFormat
LaTeX    -> Surface
latexSurface
  TexFormat
ConTeXt  -> Surface
contextSurface
  TexFormat
PlainTeX -> Surface
plaintexSurface

cmdLineOpts :: TypeableFloat n
   => DiagramOpts -> Surface -> PGFCmdLineOpts -> Options PGF V2 n
cmdLineOpts :: DiagramOpts -> Surface -> PGFCmdLineOpts -> Options PGF V2 n
cmdLineOpts DiagramOpts
opts Surface
surf PGFCmdLineOpts
pgf
  = Options PGF V2 n
forall a. Default a => a
def Options PGF V2 n
-> (Options PGF V2 n -> Options PGF V2 n) -> Options PGF V2 n
forall a b. a -> (a -> b) -> b
& (Surface -> Identity Surface)
-> Options PGF V2 n -> Identity (Options PGF V2 n)
forall n. Lens' (Options PGF V2 n) Surface
surface    ((Surface -> Identity Surface)
 -> Options PGF V2 n -> Identity (Options PGF V2 n))
-> Surface -> Options PGF V2 n -> Options PGF V2 n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Surface
surf
        Options PGF V2 n
-> (Options PGF V2 n -> Options PGF V2 n) -> Options PGF V2 n
forall a b. a -> (a -> b) -> b
& (SizeSpec V2 n -> Identity (SizeSpec V2 n))
-> Options PGF V2 n -> Identity (Options PGF V2 n)
forall n. Lens' (Options PGF V2 n) (SizeSpec V2 n)
sizeSpec   ((SizeSpec V2 n -> Identity (SizeSpec V2 n))
 -> Options PGF V2 n -> Identity (Options PGF V2 n))
-> SizeSpec V2 n -> Options PGF V2 n -> Options PGF V2 n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SizeSpec V2 n
sz
        Options PGF V2 n
-> (Options PGF V2 n -> Options PGF V2 n) -> Options PGF V2 n
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool)
-> Options PGF V2 n -> Identity (Options PGF V2 n)
forall n. Lens' (Options PGF V2 n) Bool
readable   ((Bool -> Identity Bool)
 -> Options PGF V2 n -> Identity (Options PGF V2 n))
-> Bool -> Options PGF V2 n -> Options PGF V2 n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PGFCmdLineOpts
pgfPGFCmdLineOpts -> Getting Bool PGFCmdLineOpts Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool PGFCmdLineOpts Bool
Lens' PGFCmdLineOpts Bool
cmdReadable
        Options PGF V2 n
-> (Options PGF V2 n -> Options PGF V2 n) -> Options PGF V2 n
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool)
-> Options PGF V2 n -> Identity (Options PGF V2 n)
forall n. Lens' (Options PGF V2 n) Bool
standalone ((Bool -> Identity Bool)
 -> Options PGF V2 n -> Identity (Options PGF V2 n))
-> Bool -> Options PGF V2 n -> Options PGF V2 n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PGFCmdLineOpts
pgfPGFCmdLineOpts -> Getting Bool PGFCmdLineOpts Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool PGFCmdLineOpts Bool
Lens' PGFCmdLineOpts Bool
cmdStandalone
  where
    sz :: SizeSpec V2 n
sz = 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)

chooseRender :: TypeableFloat n
  => DiagramOpts -> PGFCmdLineOpts -> Surface -> QDiagram PGF V2 n Any -> IO ()
chooseRender :: DiagramOpts
-> PGFCmdLineOpts -> Surface -> QDiagram PGF V2 n Any -> IO ()
chooseRender DiagramOpts
diaOpts PGFCmdLineOpts
pgfOpts Surface
surf QDiagram PGF V2 n Any
d =
  case DiagramOpts
diaOptsDiagramOpts -> Getting String DiagramOpts String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DiagramOpts String
Lens' DiagramOpts String
output of
    String
""  -> Handle -> Builder -> IO ()
hPutBuilder Handle
stdout (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ PGF -> Options PGF V2 n -> QDiagram PGF V2 n Any -> Result PGF V2 n
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 PGF
PGF Options PGF V2 n
opts QDiagram PGF V2 n Any
d
    String
out -> String -> Options PGF V2 n -> QDiagram PGF V2 n Any -> IO ()
forall n m.
(TypeableFloat n, Monoid' m) =>
String -> Options PGF V2 n -> QDiagram PGF V2 n m -> IO ()
renderPGF' String
out Options PGF V2 n
opts QDiagram PGF V2 n Any
d
  where
    opts :: Options PGF V2 n
opts = DiagramOpts -> Surface -> PGFCmdLineOpts -> Options PGF V2 n
forall n.
TypeableFloat n =>
DiagramOpts -> Surface -> PGFCmdLineOpts -> Options PGF V2 n
cmdLineOpts DiagramOpts
diaOpts Surface
surf PGFCmdLineOpts
pgfOpts

chooseOnlineRender :: TypeableFloat n
  => DiagramOpts -> PGFCmdLineOpts -> Surface -> OnlineTex (QDiagram PGF V2 n Any) -> IO ()
chooseOnlineRender :: DiagramOpts
-> PGFCmdLineOpts
-> Surface
-> OnlineTex (QDiagram PGF V2 n Any)
-> IO ()
chooseOnlineRender DiagramOpts
diaOpts PGFCmdLineOpts
pgfOpts Surface
surf OnlineTex (QDiagram PGF V2 n Any)
d =
    case DiagramOpts
diaOptsDiagramOpts -> Getting String DiagramOpts String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DiagramOpts String
Lens' DiagramOpts String
output of
      String
""  -> Surface
-> OnlineTex (QDiagram PGF V2 n Any) -> IO (QDiagram PGF V2 n Any)
forall a. Surface -> OnlineTex a -> IO a
surfOnlineTexIO Surface
surf OnlineTex (QDiagram PGF V2 n Any)
d IO (QDiagram PGF V2 n Any)
-> (QDiagram PGF V2 n Any -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> Builder -> IO ()
hPutBuilder Handle
stdout (Builder -> IO ())
-> (QDiagram PGF V2 n Any -> Builder)
-> QDiagram PGF V2 n Any
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Options PGF V2 n -> QDiagram PGF V2 n Any -> Result PGF V2 n
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 PGF
PGF Options PGF V2 n
opts
      String
out -> String
-> Options PGF V2 n -> OnlineTex (QDiagram PGF V2 n Any) -> IO ()
forall n m.
(TypeableFloat n, Monoid' m) =>
String
-> Options PGF V2 n -> OnlineTex (QDiagram PGF V2 n m) -> IO ()
renderOnlinePGF' String
out Options PGF V2 n
opts OnlineTex (QDiagram PGF V2 n Any)
d
  where
    opts :: Options PGF V2 n
opts = DiagramOpts -> Surface -> PGFCmdLineOpts -> Options PGF V2 n
forall n.
TypeableFloat n =>
DiagramOpts -> Surface -> PGFCmdLineOpts -> Options PGF V2 n
cmdLineOpts DiagramOpts
diaOpts Surface
surf PGFCmdLineOpts
pgfOpts


-- | @multiMain@ is like 'defaultMain', except instead of a single
--   diagram it takes a list of diagrams paired with names as input.
--   The generated executable then takes a @--selection@ option
--   specifying the name of the diagram that should be rendered.  The
--   list of available diagrams may also be printed by passing the
--   option @--list@.
--
--   Example usage:
--
-- @
-- $ ghc --make MultiTest
-- [1 of 1] Compiling Main             ( MultiTest.hs, MultiTest.o )
-- Linking MultiTest ...
-- $ ./MultiTest --list
-- Available diagrams:
--   foo bar
-- $ ./MultiTest --selection bar -o Bar.tex -w 200
-- @

multiMain :: [(String, Diagram PGF)] -> IO ()
multiMain :: [(String, Diagram PGF)] -> IO ()
multiMain = [(String, Diagram PGF)] -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

instance TypeableFloat n => Mainable [(String,QDiagram PGF V2 n Any)] where
  type MainOpts [(String,QDiagram PGF V2 n Any)]
      = (MainOpts (QDiagram PGF V2 n Any), DiagramMultiOpts)

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

instance Parseable TexFormat where
  parser :: Parser TexFormat
parser = ReadM TexFormat -> Mod OptionFields TexFormat -> Parser TexFormat
forall a. ReadM a -> Mod OptionFields a -> Parser a
OP.option ((String -> Either String TexFormat) -> ReadM TexFormat
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String TexFormat
parseFormat)
                      (Mod OptionFields TexFormat -> Parser TexFormat)
-> Mod OptionFields TexFormat -> Parser TexFormat
forall a b. (a -> b) -> a -> b
$ Char -> Mod OptionFields TexFormat
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short   Char
'f'
                     Mod OptionFields TexFormat
-> Mod OptionFields TexFormat -> Mod OptionFields TexFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TexFormat
forall (f :: * -> *) a. HasName f => String -> Mod f a
long    String
"format"
                     Mod OptionFields TexFormat
-> Mod OptionFields TexFormat -> Mod OptionFields TexFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TexFormat
forall (f :: * -> *) a. String -> Mod f a
help    String
"l for LaTeX, c for ConTeXt, p for plain TeX"
                     Mod OptionFields TexFormat
-> Mod OptionFields TexFormat -> Mod OptionFields TexFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TexFormat
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FORMAT"
                     Mod OptionFields TexFormat
-> Mod OptionFields TexFormat -> Mod OptionFields TexFormat
forall a. Semigroup a => a -> a -> a
<> TexFormat -> Mod OptionFields TexFormat
forall (f :: * -> *) a. HasValue f => a -> Mod f a
OP.value TexFormat
LaTeX
                     Mod OptionFields TexFormat
-> Mod OptionFields TexFormat -> Mod OptionFields TexFormat
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields TexFormat
forall a (f :: * -> *). Show a => Mod f a
showDefault

parseFormat :: String -> Either String TexFormat
parseFormat :: String -> Either String TexFormat
parseFormat (Char
'l':String
_) = TexFormat -> Either String TexFormat
forall a b. b -> Either a b
Right TexFormat
LaTeX
parseFormat (Char
'c':String
_) = TexFormat -> Either String TexFormat
forall a b. b -> Either a b
Right TexFormat
ConTeXt
parseFormat (Char
'p':String
_) = TexFormat -> Either String TexFormat
forall a b. b -> Either a b
Right TexFormat
PlainTeX
parseFormat (Char
't':String
_) = TexFormat -> Either String TexFormat
forall a b. b -> Either a b
Right TexFormat
PlainTeX
parseFormat String
x       = String -> Either String TexFormat
forall a b. a -> Either a b
Left (String -> Either String TexFormat)
-> String -> Either String TexFormat
forall a b. (a -> b) -> a -> b
$ String
"Unknown format" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x