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

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

-----------------------------------------------------------------------------
-- | Convenient creation of command-line-driven executables for
-- rendering diagrams to Braille.
--
-- * '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.
--
-- For a tutorial on command-line diagram creation see
-- <http://projects.haskell.org/diagrams/doc/cmdline.html>.
--
-----------------------------------------------------------------------------
module Diagrams.Backend.Braille.CmdLine (
    -- * General form of @main@
    -- $mainwith
    mainWith

    -- * Supported forms of @main@
  , defaultMain
  , multiMain

    -- * Backend tokens
  , Braille
  , B
  ) where

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

-- | 'mainWith' specialised to 'Diagram' 'Rasterific'.
defaultMain :: Diagram B -> IO ()
defaultMain :: Diagram B -> IO ()
defaultMain = Diagram B -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

instance TypeableFloat n => Mainable (QDiagram B V2 n Any) where
  type MainOpts (QDiagram B V2 n Any) = DiagramOpts

  mainRender :: MainOpts (QDiagram B V2 n Any) -> QDiagram B V2 n Any -> IO ()
mainRender MainOpts (QDiagram B V2 n Any)
opts QDiagram B V2 n Any
d = DiagramOpts -> QDiagram B V2 n Any -> IO ()
forall n.
TypeableFloat n =>
DiagramOpts -> QDiagram B V2 n Any -> IO ()
chooseRender MainOpts (QDiagram B V2 n Any)
DiagramOpts
opts QDiagram B V2 n Any
d

chooseRender :: TypeableFloat n => DiagramOpts -> QDiagram B V2 n Any -> IO () -- -> QDiagram Rasterific V2 n Any -> IO ()
chooseRender :: DiagramOpts -> QDiagram B V2 n Any -> IO ()
chooseRender DiagramOpts
opts QDiagram B V2 n Any
d | [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
path = [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ SizeSpec V2 n -> QDiagram B V2 n Any -> [Char]
forall n m.
(Typeable n, RealFloat n, Monoid m) =>
SizeSpec V2 n -> QDiagram B V2 n m -> [Char]
rasterBraille SizeSpec V2 n
sz QDiagram B V2 n Any
d
                    | Bool
otherwise = [Char] -> SizeSpec V2 n -> QDiagram B V2 n Any -> IO ()
forall n.
TypeableFloat n =>
[Char] -> SizeSpec V2 n -> QDiagram B V2 n Any -> IO ()
renderBraille [Char]
path SizeSpec V2 n
sz QDiagram B V2 n Any
d
  where
    path :: [Char]
path = DiagramOpts
optsDiagramOpts -> Getting [Char] DiagramOpts [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] DiagramOpts [Char]
Lens' DiagramOpts [Char]
output
    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)

-- | @multiMain@ 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@.
multiMain :: [(String, Diagram B)] -> IO ()
multiMain :: [([Char], Diagram B)] -> IO ()
multiMain = [([Char], Diagram B)] -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

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

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