    {-# LANGUAGE CPP                       #-}
    {-# LANGUAGE ConstrainedClassMethods   #-}
    {-# LANGUAGE DeriveDataTypeable        #-}
    {-# LANGUAGE FlexibleContexts          #-}
    {-# LANGUAGE FlexibleInstances         #-}
    {-# LANGUAGE NoMonomorphismRestriction #-}
    {-# LANGUAGE RankNTypes                #-}
    {-# LANGUAGE TemplateHaskell           #-}
    {-# LANGUAGE TypeFamilies              #-}
    {-# LANGUAGE UndecidableInstances      #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Backend.CmdLine
    -- Copyright   :  (c) 2013 Diagrams team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Convenient creation of command-line-driven executables for rendering
    -- diagrams.  This module provides a general framework and default
    -- behaviors for parsing command-line arguments, records for diagram
    -- creation options in various forms, and classes and instances for a
    -- unified entry point to command-line-driven diagram creation
    -- executables.
    --
    -- For a tutorial on command-line diagram creation see
    -- <https://diagrams.github.io/doc/cmdline.html>.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Backend.CmdLine
      (

        -- * Options

        -- ** Standard options
        DiagramOpts(..)
      , diagramOpts
      , width
      , height
      , output

        -- ** Multi-diagram options
      , DiagramMultiOpts(..)
      , diagramMultiOpts
      , selection
      , list

        -- ** Animation options
      , DiagramAnimOpts(..)
      , diagramAnimOpts
      , fpu

        -- ** Loop options
      , DiagramLoopOpts(..)
      , diagramLoopOpts
      , loop
      , src

        -- * Parsing
      , Parseable(..)
      , readHexColor

        -- * Command-line programs (@Mainable@)
        -- ** Arguments, rendering, and entry point
      , Mainable(..)

        -- ** General currying
      , ToResult(..)

        -- ** helper functions for implementing @mainRender@
      , defaultAnimMainRender
      , defaultMultiMainRender
      , defaultLoopRender
      ) where

    import           Control.Lens              (Lens', makeLenses, (&), (.~), (^.))
    import           Diagrams.Animation
    import           Diagrams.Attributes
    import           Diagrams.Core             hiding (output)
    import           Diagrams.Util

    import           Options.Applicative
    import           Options.Applicative.Types (readerAsk)

    import           Control.Monad             (forM_, forever, unless, when)

    -- MonadFail comes from Prelude in base-4.13 and up
    #if !MIN_VERSION_base(4,13,0)
    import           Control.Monad.Fail        (MonadFail)
    #endif

    import           Data.Active               hiding (interval)
    import           Data.Char                 (isDigit)
    import           Data.Colour
    import           Data.Colour.Names
    import           Data.Colour.SRGB
    import           Data.Data
    import           Data.Functor.Identity
    import           Data.IORef
    import           Data.Kind                 (Type)
    import           Data.List                 (delete)
    import           Data.Maybe                (fromMaybe)
    import           Data.Monoid
    import           Numeric

    import           Control.Concurrent        (threadDelay)
    import           System.Directory          (canonicalizePath)
    import           System.Environment        (getArgs, getProgName)
    import           System.Exit               (ExitCode (..))
    import           System.FilePath           (addExtension, dropExtension,
                                                replaceExtension, splitExtension,
                                                takeDirectory, takeFileName, (</>))
    import           System.FSNotify           (defaultConfig,
                                                eventTime, watchDir,
                                                withManagerConf, confWatchMode, WatchMode(..))
    import           System.FSNotify.Devel     (existsEvents)
    import           System.Info               (os)
    import           System.IO                 (hFlush, stdout)
    import           System.Process            (readProcessWithExitCode)

    import           Text.Printf

    -- | Standard options most diagrams are likely to have.
    data DiagramOpts = DiagramOpts
      { DiagramOpts -> Maybe Int
    _width  :: Maybe Int -- ^ Final output width of diagram.
      , DiagramOpts -> Maybe Int
    _height :: Maybe Int -- ^ Final output height of diagram.
      , DiagramOpts -> String
    _output :: FilePath  -- ^ Output file path, format is typically chosen by extension.
      }
      deriving (Int -> DiagramOpts -> ShowS
    [DiagramOpts] -> ShowS
    DiagramOpts -> String
    (Int -> DiagramOpts -> ShowS)
    -> (DiagramOpts -> String)
    -> ([DiagramOpts] -> ShowS)
    -> Show DiagramOpts
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DiagramOpts -> ShowS
    showsPrec :: Int -> DiagramOpts -> ShowS
    $cshow :: DiagramOpts -> String
    show :: DiagramOpts -> String
    $cshowList :: [DiagramOpts] -> ShowS
    showList :: [DiagramOpts] -> ShowS
    Show, Typeable DiagramOpts
    Typeable DiagramOpts =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> DiagramOpts -> c DiagramOpts)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c DiagramOpts)
    -> (DiagramOpts -> Constr)
    -> (DiagramOpts -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c DiagramOpts))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e))
        -> Maybe (c DiagramOpts))
    -> ((forall b. Data b => b -> b) -> DiagramOpts -> DiagramOpts)
    -> (forall r r'.
        (r -> r' -> r)
        -> r -> (forall d. Data d => d -> r') -> DiagramOpts -> r)
    -> (forall r r'.
        (r' -> r -> r)
        -> r -> (forall d. Data d => d -> r') -> DiagramOpts -> r)
    -> (forall u. (forall d. Data d => d -> u) -> DiagramOpts -> [u])
    -> (forall u.
        Int -> (forall d. Data d => d -> u) -> DiagramOpts -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts)
    -> Data DiagramOpts
    DiagramOpts -> Constr
    DiagramOpts -> DataType
    (forall b. Data b => b -> b) -> DiagramOpts -> DiagramOpts
    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) -> DiagramOpts -> u
    forall u. (forall d. Data d => d -> u) -> DiagramOpts -> [u]
    forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramOpts -> r
    forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramOpts -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DiagramOpts
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DiagramOpts -> c DiagramOpts
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DiagramOpts)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DiagramOpts)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DiagramOpts -> c DiagramOpts
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DiagramOpts -> c DiagramOpts
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DiagramOpts
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DiagramOpts
    $ctoConstr :: DiagramOpts -> Constr
    toConstr :: DiagramOpts -> Constr
    $cdataTypeOf :: DiagramOpts -> DataType
    dataTypeOf :: DiagramOpts -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DiagramOpts)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DiagramOpts)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DiagramOpts)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DiagramOpts)
    $cgmapT :: (forall b. Data b => b -> b) -> DiagramOpts -> DiagramOpts
    gmapT :: (forall b. Data b => b -> b) -> DiagramOpts -> DiagramOpts
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramOpts -> r
    gmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramOpts -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramOpts -> r
    gmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramOpts -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> DiagramOpts -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> DiagramOpts -> [u]
    $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DiagramOpts -> u
    gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DiagramOpts -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DiagramOpts -> m DiagramOpts
    Data, Typeable)

    makeLenses ''DiagramOpts

    -- | Extra options for a program that can offer a choice
    --   between multiple diagrams.
    data DiagramMultiOpts = DiagramMultiOpts
      { DiagramMultiOpts -> Maybe String
    _selection :: Maybe String -- ^ Selected diagram to render.
      , DiagramMultiOpts -> Bool
    _list      :: Bool         -- ^ Flag to indicate that a list of available diagrams should
                                   --   be printed to standard out.
      }
      deriving (Int -> DiagramMultiOpts -> ShowS
    [DiagramMultiOpts] -> ShowS
    DiagramMultiOpts -> String
    (Int -> DiagramMultiOpts -> ShowS)
    -> (DiagramMultiOpts -> String)
    -> ([DiagramMultiOpts] -> ShowS)
    -> Show DiagramMultiOpts
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DiagramMultiOpts -> ShowS
    showsPrec :: Int -> DiagramMultiOpts -> ShowS
    $cshow :: DiagramMultiOpts -> String
    show :: DiagramMultiOpts -> String
    $cshowList :: [DiagramMultiOpts] -> ShowS
    showList :: [DiagramMultiOpts] -> ShowS
    Show, Typeable DiagramMultiOpts
    Typeable DiagramMultiOpts =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> DiagramMultiOpts -> c DiagramMultiOpts)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c DiagramMultiOpts)
    -> (DiagramMultiOpts -> Constr)
    -> (DiagramMultiOpts -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c DiagramMultiOpts))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e))
        -> Maybe (c DiagramMultiOpts))
    -> ((forall b. Data b => b -> b)
        -> DiagramMultiOpts -> DiagramMultiOpts)
    -> (forall r r'.
        (r -> r' -> r)
        -> r -> (forall d. Data d => d -> r') -> DiagramMultiOpts -> r)
    -> (forall r r'.
        (r' -> r -> r)
        -> r -> (forall d. Data d => d -> r') -> DiagramMultiOpts -> r)
    -> (forall u.
        (forall d. Data d => d -> u) -> DiagramMultiOpts -> [u])
    -> (forall u.
        Int -> (forall d. Data d => d -> u) -> DiagramMultiOpts -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d)
        -> DiagramMultiOpts -> m DiagramMultiOpts)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d)
        -> DiagramMultiOpts -> m DiagramMultiOpts)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d)
        -> DiagramMultiOpts -> m DiagramMultiOpts)
    -> Data DiagramMultiOpts
    DiagramMultiOpts -> Constr
    DiagramMultiOpts -> DataType
    (forall b. Data b => b -> b)
    -> DiagramMultiOpts -> DiagramMultiOpts
    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) -> DiagramMultiOpts -> u
    forall u. (forall d. Data d => d -> u) -> DiagramMultiOpts -> [u]
    forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramMultiOpts -> r
    forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramMultiOpts -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DiagramMultiOpts -> m DiagramMultiOpts
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DiagramMultiOpts -> m DiagramMultiOpts
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DiagramMultiOpts
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DiagramMultiOpts -> c DiagramMultiOpts
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DiagramMultiOpts)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DiagramMultiOpts)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DiagramMultiOpts -> c DiagramMultiOpts
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DiagramMultiOpts -> c DiagramMultiOpts
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DiagramMultiOpts
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DiagramMultiOpts
    $ctoConstr :: DiagramMultiOpts -> Constr
    toConstr :: DiagramMultiOpts -> Constr
    $cdataTypeOf :: DiagramMultiOpts -> DataType
    dataTypeOf :: DiagramMultiOpts -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DiagramMultiOpts)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DiagramMultiOpts)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DiagramMultiOpts)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DiagramMultiOpts)
    $cgmapT :: (forall b. Data b => b -> b)
    -> DiagramMultiOpts -> DiagramMultiOpts
    gmapT :: (forall b. Data b => b -> b)
    -> DiagramMultiOpts -> DiagramMultiOpts
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramMultiOpts -> r
    gmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramMultiOpts -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramMultiOpts -> r
    gmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramMultiOpts -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> DiagramMultiOpts -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> DiagramMultiOpts -> [u]
    $cgmapQi :: forall u.
    Int -> (forall d. Data d => d -> u) -> DiagramMultiOpts -> u
    gmapQi :: forall u.
    Int -> (forall d. Data d => d -> u) -> DiagramMultiOpts -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DiagramMultiOpts -> m DiagramMultiOpts
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DiagramMultiOpts -> m DiagramMultiOpts
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DiagramMultiOpts -> m DiagramMultiOpts
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DiagramMultiOpts -> m DiagramMultiOpts
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DiagramMultiOpts -> m DiagramMultiOpts
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DiagramMultiOpts -> m DiagramMultiOpts
    Data, Typeable)

    makeLenses ''DiagramMultiOpts

    -- | Extra options for animations.
    data DiagramAnimOpts = DiagramAnimOpts
      { DiagramAnimOpts -> Double
    _fpu :: Double -- ^ Number of frames per unit time to generate for the animation.
      }
      deriving (Int -> DiagramAnimOpts -> ShowS
    [DiagramAnimOpts] -> ShowS
    DiagramAnimOpts -> String
    (Int -> DiagramAnimOpts -> ShowS)
    -> (DiagramAnimOpts -> String)
    -> ([DiagramAnimOpts] -> ShowS)
    -> Show DiagramAnimOpts
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DiagramAnimOpts -> ShowS
    showsPrec :: Int -> DiagramAnimOpts -> ShowS
    $cshow :: DiagramAnimOpts -> String
    show :: DiagramAnimOpts -> String
    $cshowList :: [DiagramAnimOpts] -> ShowS
    showList :: [DiagramAnimOpts] -> ShowS
    Show, Typeable DiagramAnimOpts
    Typeable DiagramAnimOpts =>
    (forall (c :: * -> *).
     (forall d b. Data d => c (d -> b) -> d -> c b)
     -> (forall g. g -> c g) -> DiagramAnimOpts -> c DiagramAnimOpts)
    -> (forall (c :: * -> *).
        (forall b r. Data b => c (b -> r) -> c r)
        -> (forall r. r -> c r) -> Constr -> c DiagramAnimOpts)
    -> (DiagramAnimOpts -> Constr)
    -> (DiagramAnimOpts -> DataType)
    -> (forall (t :: * -> *) (c :: * -> *).
        Typeable t =>
        (forall d. Data d => c (t d)) -> Maybe (c DiagramAnimOpts))
    -> (forall (t :: * -> * -> *) (c :: * -> *).
        Typeable t =>
        (forall d e. (Data d, Data e) => c (t d e))
        -> Maybe (c DiagramAnimOpts))
    -> ((forall b. Data b => b -> b)
        -> DiagramAnimOpts -> DiagramAnimOpts)
    -> (forall r r'.
        (r -> r' -> r)
        -> r -> (forall d. Data d => d -> r') -> DiagramAnimOpts -> r)
    -> (forall r r'.
        (r' -> r -> r)
        -> r -> (forall d. Data d => d -> r') -> DiagramAnimOpts -> r)
    -> (forall u.
        (forall d. Data d => d -> u) -> DiagramAnimOpts -> [u])
    -> (forall u.
        Int -> (forall d. Data d => d -> u) -> DiagramAnimOpts -> u)
    -> (forall (m :: * -> *).
        Monad m =>
        (forall d. Data d => d -> m d)
        -> DiagramAnimOpts -> m DiagramAnimOpts)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d)
        -> DiagramAnimOpts -> m DiagramAnimOpts)
    -> (forall (m :: * -> *).
        MonadPlus m =>
        (forall d. Data d => d -> m d)
        -> DiagramAnimOpts -> m DiagramAnimOpts)
    -> Data DiagramAnimOpts
    DiagramAnimOpts -> Constr
    DiagramAnimOpts -> DataType
    (forall b. Data b => b -> b) -> DiagramAnimOpts -> DiagramAnimOpts
    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) -> DiagramAnimOpts -> u
    forall u. (forall d. Data d => d -> u) -> DiagramAnimOpts -> [u]
    forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramAnimOpts -> r
    forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramAnimOpts -> r
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DiagramAnimOpts -> m DiagramAnimOpts
    forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DiagramAnimOpts -> m DiagramAnimOpts
    forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DiagramAnimOpts
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DiagramAnimOpts -> c DiagramAnimOpts
    forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DiagramAnimOpts)
    forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DiagramAnimOpts)
    $cgfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DiagramAnimOpts -> c DiagramAnimOpts
    gfoldl :: forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DiagramAnimOpts -> c DiagramAnimOpts
    $cgunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DiagramAnimOpts
    gunfold :: forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DiagramAnimOpts
    $ctoConstr :: DiagramAnimOpts -> Constr
    toConstr :: DiagramAnimOpts -> Constr
    $cdataTypeOf :: DiagramAnimOpts -> DataType
    dataTypeOf :: DiagramAnimOpts -> DataType
    $cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DiagramAnimOpts)
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DiagramAnimOpts)
    $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DiagramAnimOpts)
    dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DiagramAnimOpts)
    $cgmapT :: (forall b. Data b => b -> b) -> DiagramAnimOpts -> DiagramAnimOpts
    gmapT :: (forall b. Data b => b -> b) -> DiagramAnimOpts -> DiagramAnimOpts
    $cgmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramAnimOpts -> r
    gmapQl :: forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramAnimOpts -> r
    $cgmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramAnimOpts -> r
    gmapQr :: forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DiagramAnimOpts -> r
    $cgmapQ :: forall u. (forall d. Data d => d -> u) -> DiagramAnimOpts -> [u]
    gmapQ :: forall u. (forall d. Data d => d -> u) -> DiagramAnimOpts -> [u]
    $cgmapQi :: forall u.
    Int -> (forall d. Data d => d -> u) -> DiagramAnimOpts -> u
    gmapQi :: forall u.
    Int -> (forall d. Data d => d -> u) -> DiagramAnimOpts -> u
    $cgmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DiagramAnimOpts -> m DiagramAnimOpts
    gmapM :: forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DiagramAnimOpts -> m DiagramAnimOpts
    $cgmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DiagramAnimOpts -> m DiagramAnimOpts
    gmapMp :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DiagramAnimOpts -> m DiagramAnimOpts
    $cgmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DiagramAnimOpts -> m DiagramAnimOpts
    gmapMo :: forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DiagramAnimOpts -> m DiagramAnimOpts
    Data, Typeable)

    makeLenses ''DiagramAnimOpts

    -- | Extra options for command-line looping.
    data DiagramLoopOpts = DiagramLoopOpts
      { DiagramLoopOpts -> Bool
    _loop     :: Bool            -- ^ Flag to indicate that the program should loop creation.
      , DiagramLoopOpts -> Maybe String
    _src      :: Maybe FilePath  -- ^ File path for the source file to recompile.
      }

    makeLenses ''DiagramLoopOpts

    -- | Command line parser for 'DiagramOpts'.
    --   Width is option @--width@ or @-w@.
    --   Height is option @--height@ or @-h@ (note we change help to be @-?@ due to this).
    --   Output is option @--output@ or @-o@.
    diagramOpts :: Parser DiagramOpts
    diagramOpts :: Parser DiagramOpts
    diagramOpts = Maybe Int -> Maybe Int -> String -> DiagramOpts
    DiagramOpts
      (Maybe Int -> Maybe Int -> String -> DiagramOpts)
    -> Parser (Maybe Int)
    -> Parser (Maybe Int -> String -> DiagramOpts)
    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 -> String -> DiagramOpts)
    -> Parser (Maybe Int) -> Parser (String -> DiagramOpts)
    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 (String -> DiagramOpts)
    -> Parser String -> Parser DiagramOpts
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mod OptionFields String -> Parser String
    forall s. IsString s => Mod OptionFields s -> Parser s
    strOption
          ( String -> Mod OptionFields String
    forall (f :: * -> *) a. HasName f => String -> Mod f a
    long String
    "output" Mod OptionFields String
    -> Mod OptionFields String -> Mod OptionFields String
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod OptionFields String
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'o'
         Mod OptionFields String
    -> Mod OptionFields String -> Mod OptionFields String
    forall a. Semigroup a => a -> a -> a
    <> String -> Mod OptionFields String
    forall (f :: * -> *) a. HasValue f => a -> Mod f a
    value String
    ""
         Mod OptionFields String
    -> Mod OptionFields String -> Mod OptionFields String
    forall a. Semigroup a => a -> a -> a
    <> String -> Mod OptionFields String
    forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
    metavar String
    "OUTPUT"
         Mod OptionFields String
    -> Mod OptionFields String -> Mod OptionFields String
    forall a. Semigroup a => a -> a -> a
    <> String -> Mod OptionFields String
    forall (f :: * -> *) a. String -> Mod f a
    help String
    "OUTPUT file")

    -- | Command line parser for 'DiagramMultiOpts'.
    --   Selection is option @--selection@ or @-S@.
    --   List is @--list@ or @-L@.
    diagramMultiOpts :: Parser DiagramMultiOpts
    diagramMultiOpts :: Parser DiagramMultiOpts
    diagramMultiOpts = Maybe String -> Bool -> DiagramMultiOpts
    DiagramMultiOpts
      (Maybe String -> Bool -> DiagramMultiOpts)
    -> Parser (Maybe String) -> Parser (Bool -> DiagramMultiOpts)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Parser String -> Parser (Maybe String)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Parser String -> Parser (Maybe String))
    -> (Mod OptionFields String -> Parser String)
    -> Mod OptionFields String
    -> Parser (Maybe String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Mod OptionFields String -> Parser String
    forall s. IsString s => Mod OptionFields s -> Parser s
    strOption)
          ( String -> Mod OptionFields String
    forall (f :: * -> *) a. HasName f => String -> Mod f a
    long String
    "selection" Mod OptionFields String
    -> Mod OptionFields String -> Mod OptionFields String
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod OptionFields String
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'S'
         Mod OptionFields String
    -> Mod OptionFields String -> Mod OptionFields String
    forall a. Semigroup a => a -> a -> a
    <> String -> Mod OptionFields String
    forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
    metavar String
    "NAME"
         Mod OptionFields String
    -> Mod OptionFields String -> Mod OptionFields String
    forall a. Semigroup a => a -> a -> a
    <> String -> Mod OptionFields String
    forall (f :: * -> *) a. String -> Mod f a
    help String
    "NAME of the diagram to render")
      Parser (Bool -> DiagramMultiOpts)
    -> Parser Bool -> Parser DiagramMultiOpts
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    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
    "list" 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
    'L'
         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
    "List all available diagrams")

    -- | Command line parser for 'DiagramAnimOpts'
    --   Frames per unit is @--fpu@ or @-f@.
    diagramAnimOpts :: Parser DiagramAnimOpts
    diagramAnimOpts :: Parser DiagramAnimOpts
    diagramAnimOpts = Double -> DiagramAnimOpts
    DiagramAnimOpts
      (Double -> DiagramAnimOpts)
    -> Parser Double -> Parser DiagramAnimOpts
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReadM Double -> Mod OptionFields Double -> Parser Double
    forall a. ReadM a -> Mod OptionFields a -> Parser a
    option ReadM Double
    forall a. Read a => ReadM a
    auto
          ( String -> Mod OptionFields Double
    forall (f :: * -> *) a. HasName f => String -> Mod f a
    long String
    "fpu" Mod OptionFields Double
    -> Mod OptionFields Double -> Mod OptionFields Double
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod OptionFields Double
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'f'
         Mod OptionFields Double
    -> Mod OptionFields Double -> Mod OptionFields Double
    forall a. Semigroup a => a -> a -> a
    <> Double -> Mod OptionFields Double
    forall (f :: * -> *) a. HasValue f => a -> Mod f a
    value Double
    30.0
         Mod OptionFields Double
    -> Mod OptionFields Double -> Mod OptionFields Double
    forall a. Semigroup a => a -> a -> a
    <> String -> Mod OptionFields Double
    forall (f :: * -> *) a. String -> Mod f a
    help String
    "Frames per unit time (for animations)")

    -- | CommandLine parser for 'DiagramLoopOpts'
    --   Loop is @--loop@ or @-l@.
    --   Source is @--src@ or @-s@.
    diagramLoopOpts :: Parser DiagramLoopOpts
    diagramLoopOpts :: Parser DiagramLoopOpts
    diagramLoopOpts = Bool -> Maybe String -> DiagramLoopOpts
    DiagramLoopOpts
      (Bool -> Maybe String -> DiagramLoopOpts)
    -> Parser Bool -> Parser (Maybe String -> DiagramLoopOpts)
    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
    "loop" 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
    'l' 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
    "Run in a self-recompiling loop")
      Parser (Maybe String -> DiagramLoopOpts)
    -> Parser (Maybe String) -> Parser DiagramLoopOpts
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Parser String -> Parser (Maybe String)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Parser String -> Parser (Maybe String))
    -> (Mod OptionFields String -> Parser String)
    -> Mod OptionFields String
    -> Parser (Maybe String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Mod OptionFields String -> Parser String
    forall s. IsString s => Mod OptionFields s -> Parser s
    strOption)
          ( String -> Mod OptionFields String
    forall (f :: * -> *) a. HasName f => String -> Mod f a
    long String
    "src" Mod OptionFields String
    -> Mod OptionFields String -> Mod OptionFields String
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod OptionFields String
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    's'
         Mod OptionFields String
    -> Mod OptionFields String -> Mod OptionFields String
    forall a. Semigroup a => a -> a -> a
    <> String -> Mod OptionFields String
    forall (f :: * -> *) a. String -> Mod f a
    help String
    "Source file to watch")

    -- | A hidden \"helper\" option which always fails.
    --   Taken from Options.Applicative.Extra but without the
    --   short option 'h'.  We want the 'h' for Height.
    helper' :: Parser (a -> a)
    helper' :: forall a. Parser (a -> a)
    helper' = ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a.
    ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
    abortOption ParseError
    param (Mod OptionFields (a -> a) -> Parser (a -> a))
    -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a b. (a -> b) -> a -> b
    $ [Mod OptionFields (a -> a)] -> Mod OptionFields (a -> a)
    forall a. Monoid a => [a] -> a
    mconcat
      [ String -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. HasName f => String -> Mod f a
    long String
    "help"
      , Char -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    '?'
      , String -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. String -> Mod f a
    help String
    "Show this help text"
      ]
      where
    #if MIN_VERSION_optparse_applicative(0,16,0)
        param :: ParseError
    param = Maybe String -> ParseError
    ShowHelpText Maybe String
    forall a. Maybe a
    Nothing
    #else
        param = ShowHelpText
    #endif

    -- | Apply a parser to the command line that includes the standard
    --   program description and help behavior.  Results in parsed commands
    --   or fails with a help message.
    defaultOpts :: Parser a -> IO a
    defaultOpts :: forall a. Parser a -> IO a
    defaultOpts Parser a
    optsParser = do
      String
    prog <- IO String
    getProgName
      let p :: ParserInfo a
    p = Parser a -> InfoMod a -> ParserInfo a
    forall a. Parser a -> InfoMod a -> ParserInfo a
    info (Parser (a -> a)
    forall a. Parser (a -> a)
    helper' Parser (a -> a) -> Parser a -> Parser a
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser a
    optsParser)
                  ( InfoMod a
    forall a. InfoMod a
    fullDesc
                 InfoMod a -> InfoMod a -> InfoMod a
    forall a. Semigroup a => a -> a -> a
    <> String -> InfoMod a
    forall a. String -> InfoMod a
    progDesc String
    "Command-line diagram generation."
                 InfoMod a -> InfoMod a -> InfoMod a
    forall a. Semigroup a => a -> a -> a
    <> String -> InfoMod a
    forall a. String -> InfoMod a
    header String
    prog)
      ParserInfo a -> IO a
    forall a. ParserInfo a -> IO a
    execParser ParserInfo a
    p

    -- | Parseable instances give a command line parser for a type.  If a custom
    --   parser for a common type is wanted a newtype wrapper could be used to make
    --   a new 'Parseable' instance.  Notice that we do /not/ want as many
    --   instances as 'Read' because we want to limit ourselves to things that make
    --   sense to parse from the command line.
    class Parseable a where
      parser :: Parser a

    -- The following instance would overlap with the product instance for
    -- Parseable.  We can't tell if one wants to parse (a,b) as one argument or a
    -- as one argument and b as another.  Since this is the command line we almost
    -- certainly want the latter.  So we need to have less Read instances.
    --
    -- instance Read a => Parseable a where
    --    parser = argument auto mempty

    -- | Parse 'Int' according to its 'Read' instance.
    instance Parseable Int where
      parser :: Parser Int
    parser = ReadM Int -> Mod ArgumentFields Int -> Parser Int
    forall a. ReadM a -> Mod ArgumentFields a -> Parser a
    argument ReadM Int
    forall a. Read a => ReadM a
    auto Mod ArgumentFields Int
    forall a. Monoid a => a
    mempty

    -- | Parse 'Double' according to its 'Read' instance.
    instance Parseable Double where
      parser :: Parser Double
    parser = ReadM Double -> Mod ArgumentFields Double -> Parser Double
    forall a. ReadM a -> Mod ArgumentFields a -> Parser a
    argument ReadM Double
    forall a. Read a => ReadM a
    auto Mod ArgumentFields Double
    forall a. Monoid a => a
    mempty

    -- | Parse a string by just accepting the given string.
    instance Parseable String where
      parser :: Parser String
    parser = ReadM String -> Mod ArgumentFields String -> Parser String
    forall a. ReadM a -> Mod ArgumentFields a -> Parser a
    argument ReadM String
    forall s. IsString s => ReadM s
    str Mod ArgumentFields String
    forall a. Monoid a => a
    mempty

    -- | Parse 'DiagramOpts' using the 'diagramOpts' parser.
    instance Parseable DiagramOpts where
      parser :: Parser DiagramOpts
    parser = Parser DiagramOpts
    diagramOpts

    -- | Parse 'DiagramMultiOpts' using the 'diagramMultiOpts' parser.
    instance Parseable DiagramMultiOpts where
      parser :: Parser DiagramMultiOpts
    parser = Parser DiagramMultiOpts
    diagramMultiOpts

    -- | Parse 'DiagramAnimOpts' using the 'diagramAnimOpts' parser.
    instance Parseable DiagramAnimOpts where
      parser :: Parser DiagramAnimOpts
    parser = Parser DiagramAnimOpts
    diagramAnimOpts

    -- | Parse 'DiagramLoopOpts' using the 'diagramLoopOpts' parser.
    instance Parseable DiagramLoopOpts where
      parser :: Parser DiagramLoopOpts
    parser = Parser DiagramLoopOpts
    diagramLoopOpts

    -- | Parse @'Colour' Double@ as either a named color from "Data.Colour.Names"
    --   or a hexadecimal color.
    instance Parseable (Colour Double) where
      parser :: Parser (Colour Double)
    parser = ReadM (Colour Double)
    -> Mod ArgumentFields (Colour Double) -> Parser (Colour Double)
    forall a. ReadM a -> Mod ArgumentFields a -> Parser a
    argument (ReadM (Colour Double)
    rc ReadM (Colour Double)
    -> ReadM (Colour Double) -> ReadM (Colour Double)
    forall a. ReadM a -> ReadM a -> ReadM a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ReadM (Colour Double)
    rh) Mod ArgumentFields (Colour Double)
    forall a. Monoid a => a
    mempty
        where
          rh, rc :: ReadM (Colour Double)
          rh :: ReadM (Colour Double)
    rh = (Double, Double, Double, Double) -> Colour Double
    forall {b} {d}. (Ord b, Floating b) => (b, b, b, d) -> Colour b
    f ((Double, Double, Double, Double) -> Colour Double)
    -> (AlphaColour Double -> (Double, Double, Double, Double))
    -> AlphaColour Double
    -> Colour Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AlphaColour Double -> (Double, Double, Double, Double)
    forall c. Color c => c -> (Double, Double, Double, Double)
    colorToSRGBA (AlphaColour Double -> Colour Double)
    -> ReadM (AlphaColour Double) -> ReadM (Colour Double)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ReadM String
    readerAsk ReadM String
    -> (String -> ReadM (AlphaColour Double))
    -> ReadM (AlphaColour Double)
    forall a b. ReadM a -> (a -> ReadM b) -> ReadM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ReadM (AlphaColour Double)
    forall (m :: * -> *).
    (Applicative m, MonadFail m) =>
    String -> m (AlphaColour Double)
    readHexColor)
          rc :: ReadM (Colour Double)
    rc = ReadM String
    readerAsk ReadM String
    -> (String -> ReadM (Colour Double)) -> ReadM (Colour Double)
    forall a b. ReadM a -> (a -> ReadM b) -> ReadM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ReadM (Colour Double)
    forall (m :: * -> *) a.
    (MonadFail m, Monad m, Ord a, Floating a) =>
    String -> m (Colour a)
    readColourName
          f :: (b, b, b, d) -> Colour b
    f (b
    r,b
    g,b
    b,d
    _) = b -> b -> b -> Colour b
    forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
    sRGB b
    r b
    g b
    b -- TODO: this seems unfortunate.  Should the alpha
                                   -- value be applied to the r g b values?

    -- | Parse @'AlphaColour' Double@ as either a named color from "Data.Colour.Names"
    --   or a hexadecimal color.
    instance Parseable (AlphaColour Double) where
      parser :: Parser (AlphaColour Double)
    parser = ReadM (AlphaColour Double)
    -> Mod ArgumentFields (AlphaColour Double)
    -> Parser (AlphaColour Double)
    forall a. ReadM a -> Mod ArgumentFields a -> Parser a
    argument (ReadM (AlphaColour Double)
    forall {a}. (Ord a, Floating a) => ReadM (AlphaColour a)
    rc ReadM (AlphaColour Double)
    -> ReadM (AlphaColour Double) -> ReadM (AlphaColour Double)
    forall a. ReadM a -> ReadM a -> ReadM a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ReadM (AlphaColour Double)
    rh) Mod ArgumentFields (AlphaColour Double)
    forall a. Monoid a => a
    mempty
        where
          rh :: ReadM (AlphaColour Double)
    rh = ReadM String
    readerAsk ReadM String
    -> (String -> ReadM (AlphaColour Double))
    -> ReadM (AlphaColour Double)
    forall a b. ReadM a -> (a -> ReadM b) -> ReadM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ReadM (AlphaColour Double)
    forall (m :: * -> *).
    (Applicative m, MonadFail m) =>
    String -> m (AlphaColour Double)
    readHexColor
          rc :: ReadM (AlphaColour a)
    rc = Colour a -> AlphaColour a
    forall a. Num a => Colour a -> AlphaColour a
    opaque (Colour a -> AlphaColour a)
    -> ReadM (Colour a) -> ReadM (AlphaColour a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ReadM String
    readerAsk ReadM String -> (String -> ReadM (Colour a)) -> ReadM (Colour a)
    forall a b. ReadM a -> (a -> ReadM b) -> ReadM b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ReadM (Colour a)
    forall (m :: * -> *) a.
    (MonadFail m, Monad m, Ord a, Floating a) =>
    String -> m (Colour a)
    readColourName)

    -- Addapted from the Clay.Color module of the clay package

    -- | Parses a hexadecimal color.  The string can start with @\"0x\"@ or @\"#\"@
    --   or just be a string of hexadecimal values.  If four or three digits are
    --   given each digit is repeated to form a full 24 or 32 bit color.  For
    --   example, @\"0xfc4\"@ is the same as @\"0xffcc44\"@.  When eight or six
    --   digits are given each pair of digits is a color or alpha channel with the
    --   order being red, green, blue, alpha.
    readHexColor :: (Applicative m, MonadFail m) => String -> m (AlphaColour Double)
    readHexColor :: forall (m :: * -> *).
    (Applicative m, MonadFail m) =>
    String -> m (AlphaColour Double)
    readHexColor String
    cs = case String
    cs of
      (Char
    '0':Char
    'x':String
    hs) -> String -> m (AlphaColour Double)
    handle String
    hs
      (Char
    '#':String
    hs)     -> String -> m (AlphaColour Double)
    handle String
    hs
      String
    hs           -> String -> m (AlphaColour Double)
    handle String
    hs
      where
        handle :: String -> m (AlphaColour Double)
    handle String
    hs | String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    hs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    8 Bool -> Bool -> Bool
    && (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isHexDigit String
    hs
          = case String
    hs of
            [Char
    a,Char
    b,Char
    c,Char
    d,Char
    e,Char
    f,Char
    g,Char
    h] -> Colour Double -> Double -> AlphaColour Double
    forall a. Num a => Colour a -> a -> AlphaColour a
    withOpacity (Colour Double -> Double -> AlphaColour Double)
    -> m (Colour Double) -> m (Double -> AlphaColour Double)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Double -> Double -> Double -> Colour Double
    forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
    sRGB (Double -> Double -> Double -> Colour Double)
    -> m Double -> m (Double -> Double -> Colour Double)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    a Char
    b m (Double -> Double -> Colour Double)
    -> m Double -> m (Double -> Colour Double)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    c Char
    d m (Double -> Colour Double) -> m Double -> m (Colour Double)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    e Char
    f) m (Double -> AlphaColour Double)
    -> m Double -> m (AlphaColour Double)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    g Char
    h
            [Char
    a,Char
    b,Char
    c,Char
    d,Char
    e,Char
    f    ] -> Colour Double -> AlphaColour Double
    forall a. Num a => Colour a -> AlphaColour a
    opaque      (Colour Double -> AlphaColour Double)
    -> m (Colour Double) -> m (AlphaColour Double)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Double -> Double -> Double -> Colour Double
    forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
    sRGB (Double -> Double -> Double -> Colour Double)
    -> m Double -> m (Double -> Double -> Colour Double)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    a Char
    b m (Double -> Double -> Colour Double)
    -> m Double -> m (Double -> Colour Double)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    c Char
    d m (Double -> Colour Double) -> m Double -> m (Colour Double)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    e Char
    f)
            [Char
    a,Char
    b,Char
    c,Char
    d        ] -> Colour Double -> Double -> AlphaColour Double
    forall a. Num a => Colour a -> a -> AlphaColour a
    withOpacity (Colour Double -> Double -> AlphaColour Double)
    -> m (Colour Double) -> m (Double -> AlphaColour Double)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Double -> Double -> Double -> Colour Double
    forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
    sRGB (Double -> Double -> Double -> Colour Double)
    -> m Double -> m (Double -> Double -> Colour Double)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    a Char
    a m (Double -> Double -> Colour Double)
    -> m Double -> m (Double -> Colour Double)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    b Char
    b m (Double -> Colour Double) -> m Double -> m (Colour Double)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    c Char
    c) m (Double -> AlphaColour Double)
    -> m Double -> m (AlphaColour Double)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    d Char
    d
            [Char
    a,Char
    b,Char
    c          ] -> Colour Double -> AlphaColour Double
    forall a. Num a => Colour a -> AlphaColour a
    opaque      (Colour Double -> AlphaColour Double)
    -> m (Colour Double) -> m (AlphaColour Double)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Double -> Double -> Double -> Colour Double
    forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
    sRGB (Double -> Double -> Double -> Colour Double)
    -> m Double -> m (Double -> Double -> Colour Double)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    a Char
    a m (Double -> Double -> Colour Double)
    -> m Double -> m (Double -> Colour Double)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    b Char
    b m (Double -> Colour Double) -> m Double -> m (Colour Double)
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Char -> Char -> m Double
    forall {f :: * -> *} {b}.
    (Fractional b, Eq b, MonadFail f) =>
    Char -> Char -> f b
    hex Char
    c Char
    c)
            String
    _                 -> String -> m (AlphaColour Double)
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m (AlphaColour Double))
    -> String -> m (AlphaColour Double)
    forall a b. (a -> b) -> a -> b
    $ String
    "could not parse as a colour" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    cs
        handle String
    _ = String -> m (AlphaColour Double)
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m (AlphaColour Double))
    -> String -> m (AlphaColour Double)
    forall a b. (a -> b) -> a -> b
    $ String
    "could not parse as a colour: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    cs

        isHexDigit :: Char -> Bool
    isHexDigit Char
    c = Char -> Bool
    isDigit Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "abcdef"

        hex :: Char -> Char -> f b
    hex Char
    a Char
    b = (b -> b -> b
    forall a. Fractional a => a -> a -> a
    / b
    255) (b -> b) -> f b -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> case ReadS b
    forall a. (Eq a, Num a) => ReadS a
    readHex [Char
    a,Char
    b] of
                    [(b
    h,String
    "")] -> b -> f b
    forall a. a -> f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    h
                    [(b, String)]
    _        -> String -> f b
    forall a. String -> f a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> f b) -> String -> f b
    forall a b. (a -> b) -> a -> b
    $ String
    "could not parse as a hex value" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char
    a,Char
    b]

    -- | This instance is needed to signal the end of a chain of
    --   nested tuples, it always just results in the unit value
    --   without consuming anything.
    instance Parseable () where
      parser :: Parser ()
    parser = () -> Parser ()
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    -- | Allow 'Parseable' things to be combined.
    instance (Parseable a, Parseable b) => Parseable (a,b) where
      parser :: Parser (a, b)
    parser = (,) (a -> b -> (a, b)) -> Parser a -> Parser (b -> (a, b))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser a
    forall a. Parseable a => Parser a
    parser Parser (b -> (a, b)) -> Parser b -> Parser (a, b)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser b
    forall a. Parseable a => Parser a
    parser

    -- | Triples of Parsebales should also be Parseable.
    instance (Parseable a, Parseable b, Parseable c) => Parseable (a, b, c) where
      parser :: Parser (a, b, c)
    parser = (,,) (a -> b -> c -> (a, b, c))
    -> Parser a -> Parser (b -> c -> (a, b, c))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser a
    forall a. Parseable a => Parser a
    parser Parser (b -> c -> (a, b, c)) -> Parser b -> Parser (c -> (a, b, c))
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser b
    forall a. Parseable a => Parser a
    parser Parser (c -> (a, b, c)) -> Parser c -> Parser (a, b, c)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser c
    forall a. Parseable a => Parser a
    parser

    instance (Parseable a, Parseable b, Parseable c, Parseable d) => Parseable (a, b, c, d) where
      parser :: Parser (a, b, c, d)
    parser = (,,,) (a -> b -> c -> d -> (a, b, c, d))
    -> Parser a -> Parser (b -> c -> d -> (a, b, c, d))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser a
    forall a. Parseable a => Parser a
    parser Parser (b -> c -> d -> (a, b, c, d))
    -> Parser b -> Parser (c -> d -> (a, b, c, d))
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser b
    forall a. Parseable a => Parser a
    parser Parser (c -> d -> (a, b, c, d))
    -> Parser c -> Parser (d -> (a, b, c, d))
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser c
    forall a. Parseable a => Parser a
    parser Parser (d -> (a, b, c, d)) -> Parser d -> Parser (a, b, c, d)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser d
    forall a. Parseable a => Parser a
    parser

    -- | This class allows us to abstract over functions that take some arguments
    --   and produce a final value.  When some @d@ is an instance of
    --   'ToResult' we get a type @'Args' d@ that is a type of /all/ the arguments
    --   at once, and a type @'ResultOf' d@ that is the type of the final result from
    --   some base case instance.
    class ToResult d where
      type Args d :: Type
      type ResultOf d :: Type

      toResult :: d -> Args d -> ResultOf d

    -- | A diagram can always produce a diagram when given @()@ as an argument.
    --   This is our base case.
    instance ToResult (QDiagram b v n Any) where
      type Args (QDiagram b v n Any) = ()
      type ResultOf (QDiagram b v n Any) = QDiagram b v n Any

      toResult :: QDiagram b v n Any
    -> Args (QDiagram b v n Any) -> ResultOf (QDiagram b v n Any)
    toResult QDiagram b v n Any
    d Args (QDiagram b v n Any)
    _ = QDiagram b v n Any
    ResultOf (QDiagram b v n Any)
    d

    -- | A list of diagrams can produce pages.
    instance ToResult [QDiagram b v n Any] where
      type Args [QDiagram b v n Any] = ()
      type ResultOf [QDiagram b v n Any] = [QDiagram b v n Any]

      toResult :: [QDiagram b v n Any]
    -> Args [QDiagram b v n Any] -> ResultOf [QDiagram b v n Any]
    toResult [QDiagram b v n Any]
    ds Args [QDiagram b v n Any]
    _ = [QDiagram b v n Any]
    ResultOf [QDiagram b v n Any]
    ds

    -- | A list of named diagrams can give the multi-diagram interface.
    instance ToResult [(String, QDiagram b v n Any)] where
      type Args [(String,QDiagram b v n Any)] = ()
      type ResultOf [(String,QDiagram b v n Any)] = [(String,QDiagram b v n Any)]

      toResult :: [(String, QDiagram b v n Any)]
    -> Args [(String, QDiagram b v n Any)]
    -> ResultOf [(String, QDiagram b v n Any)]
    toResult [(String, QDiagram b v n Any)]
    ds Args [(String, QDiagram b v n Any)]
    _ = [(String, QDiagram b v n Any)]
    ResultOf [(String, QDiagram b v n Any)]
    ds

    -- | An animation is another suitable base case.
    instance ToResult (Animation b v n) where
      type Args (Animation b v n) = ()
      type ResultOf (Animation b v n) = Animation b v n

      toResult :: Animation b v n
    -> Args (Animation b v n) -> ResultOf (Animation b v n)
    toResult Animation b v n
    a Args (Animation b v n)
    _ = Animation b v n
    ResultOf (Animation b v n)
    a

    -- | Diagrams that require IO to build are a base case.
    instance ToResult d => ToResult (IO d) where
      type Args (IO d) = Args d
      type ResultOf (IO d) = IO (ResultOf d)

      toResult :: IO d -> Args (IO d) -> ResultOf (IO d)
    toResult IO d
    d Args (IO d)
    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 (IO d)
    args (d -> ResultOf d) -> IO d -> IO (ResultOf d)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO d
    d

    -- | An instance for a function that, given some 'a', can produce a 'd' that is
    --   also an instance of 'ToResult'.  For this to work we need both the
    --   argument 'a' and all the arguments that 'd' will need.  Producing the
    --   result is simply applying the argument to the producer and passing the
    --   remaining arguments to the produced producer.

    --   The previous paragraph stands as a witness to the fact that Haskell code
    --   is clearer and easier to understand then paragraphs in English written by
    --   me.
    instance ToResult d => ToResult (a -> d) where
      type Args (a -> d) = (a, Args d)
      type ResultOf (a -> d) = ResultOf d

      toResult :: (a -> d) -> Args (a -> d) -> ResultOf (a -> d)
    toResult a -> d
    f (a
    a,Args d
    args) = d -> Args d -> ResultOf d
    forall d. ToResult d => d -> Args d -> ResultOf d
    toResult (a -> d
    f a
    a) Args d
    args

    -- | This class represents the various ways we want to support diagram creation
    --   from the command line.  It has the right instances to select between creating
    --   single static diagrams, multiple static diagrams, static animations, and
    --   functions that produce diagrams as long as the arguments are 'Parseable'.
    --
    --   Backends are expected to create @Mainable@ instances for the types that are
    --   suitable for generating output in the backend's format.  For instance,
    --   Postscript can handle single diagrams, pages of diagrams, animations as
    --   separate files, and association lists.  This implies instances for
    --   @Diagram Postscript R2@, @[Diagram Postscript R2]@, @Animation Postscript R2@,
    --   and @[(String,Diagram Postscript R2)]@.  We can consider these as the base
    --   cases for the function instance.
    --
    --   The associated type 'MainOpts' describes the options which need to be parsed
    --   from the command-line and passed to @mainRender@.
    class Mainable d where
      -- | Associated type that describes the options which need to be parsed
      -- from the command-line and passed to @mainRender@.
      type MainOpts d :: Type

      -- | This method invokes the command-line parser resulting in an options
      -- value or ending the program with an error or help message.
      -- Typically the default instance will work.  If a different help message
      -- or parsing behavior is desired a new implementation is appropriate.
      mainArgs :: Parseable (MainOpts d) => proxy d -> IO (MainOpts d)
      mainArgs proxy d
    _ = Parser (MainOpts d) -> IO (MainOpts d)
    forall a. Parser a -> IO a
    defaultOpts Parser (MainOpts d)
    forall a. Parseable a => Parser a
    parser

      -- | Backend specific work of rendering with the given options and mainable
      -- value is done here.  All backend instances should implement this method.
      mainRender :: MainOpts d -> d -> IO ()

      -- | Main entry point for command-line diagram creation.  This is the method
      -- that users will call from their program @main@.  For instance an expected
      -- user program would take the following form.
      --
      -- @
      -- import Diagrams.Prelude
      -- import Diagrams.Backend.TheBestBackend.CmdLine
      --
      -- d :: Diagram B R2
      -- d = ...
      --
      -- main = mainWith d
      -- @
      --
      -- Most backends should be able to use the default implementation.  A different
      -- implementation should be used to handle more complex interactions with the user.
      mainWith :: Parseable (MainOpts d) => d -> IO ()
      mainWith d
    d = do
        MainOpts d
    opts <- Identity d -> IO (MainOpts d)
    forall d (proxy :: * -> *).
    (Mainable d, Parseable (MainOpts d)) =>
    proxy d -> IO (MainOpts d)
    forall (proxy :: * -> *).
    Parseable (MainOpts d) =>
    proxy d -> IO (MainOpts d)
    mainArgs (d -> Identity d
    forall a. a -> Identity a
    Identity d
    d)
        MainOpts d -> d -> IO ()
    forall d. Mainable d => MainOpts d -> d -> IO ()
    mainRender MainOpts d
    opts d
    d

    -- | This instance allows functions resulting in something that is 'Mainable' to
    --   be 'Mainable'.  It takes a parse of collected arguments and applies them to
    --   the given function producing the 'Mainable' result.
    instance (ToResult d, Mainable (ResultOf d))
            => Mainable (a -> d) where
      type MainOpts (a -> d) = (MainOpts (ResultOf (a -> d)), Args (a -> d))

      mainRender :: MainOpts (a -> d) -> (a -> d) -> IO ()
    mainRender (MainOpts (ResultOf d)
    opts, (a, Args d)
    a) a -> d
    f  = MainOpts (ResultOf d) -> ResultOf d -> IO ()
    forall d. Mainable d => MainOpts d -> d -> IO ()
    mainRender MainOpts (ResultOf d)
    opts ((a -> d) -> Args (a -> d) -> ResultOf (a -> d)
    forall d. ToResult d => d -> Args d -> ResultOf d
    toResult a -> d
    f (a, Args d)
    Args (a -> d)
    a)
    -- TODO: why can't we get away with: instance (Parseable (Args (a -> d)), Mainable (ResultOf d)) => ...
    --       Doesn't `Args (a -> d)` imply `ToResult (a -> d)` which implies `ToResult d` ?

    -- | With this instance we can perform IO to produce something
    --   'Mainable' before rendering.
    instance Mainable d => Mainable (IO d) where
      type MainOpts (IO d) = MainOpts d

      mainRender :: MainOpts (IO d) -> IO d -> IO ()
    mainRender MainOpts (IO d)
    opts IO d
    dio = IO d
    dio IO d -> (d -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MainOpts d -> d -> IO ()
    forall d. Mainable d => MainOpts d -> d -> IO ()
    mainRender MainOpts d
    MainOpts (IO d)
    opts

    -- | @defaultMultiMainRender@ is an implementation of 'mainRender' where
    --   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@.
    --
    --   Typically a backend can write its @[(String,QDiagram b v n Any)]@ instance as
    --
    --   @
    --   instance Mainable [(String,QDiagram b v n Any)] where
    --       type MainOpts [(String,QDiagram b v n Any)] = (DiagramOpts, DiagramMultiOpts)
    --       mainRender = defaultMultiMainRender
    --   @
    --
    --   We do not provide this instance in general so that backends can choose to
    --   opt-in to this form or provide a different instance that makes more sense.
    defaultMultiMainRender :: Mainable d => (MainOpts d, DiagramMultiOpts) -> [(String, d)] -> IO ()
    defaultMultiMainRender :: forall d.
    Mainable d =>
    (MainOpts d, DiagramMultiOpts) -> [(String, d)] -> IO ()
    defaultMultiMainRender (MainOpts d
    opts,DiagramMultiOpts
    multi) [(String, d)]
    ds =
      if DiagramMultiOpts
    multiDiagramMultiOpts -> Getting Bool DiagramMultiOpts Bool -> Bool
    forall s a. s -> Getting a s a -> a
    ^.Getting Bool DiagramMultiOpts Bool
    Lens' DiagramMultiOpts Bool
    list
        then [String] -> IO ()
    showDiaList (((String, d) -> String) -> [(String, d)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, d) -> String
    forall a b. (a, b) -> a
    fst [(String, d)]
    ds)
        else case DiagramMultiOpts
    multiDiagramMultiOpts
    -> Getting (Maybe String) DiagramMultiOpts (Maybe String)
    -> Maybe String
    forall s a. s -> Getting a s a -> a
    ^.Getting (Maybe String) DiagramMultiOpts (Maybe String)
    Lens' DiagramMultiOpts (Maybe String)
    selection of
               Maybe String
    Nothing  -> String -> IO ()
    putStrLn String
    "No diagram selected." IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [String] -> IO ()
    showDiaList (((String, d) -> String) -> [(String, d)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, d) -> String
    forall a b. (a, b) -> a
    fst [(String, d)]
    ds)
               Just String
    sel -> case String -> [(String, d)] -> Maybe d
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    sel [(String, d)]
    ds of
                             Maybe d
    Nothing -> String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Unknown diagram: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    sel
                             Just d
    d  -> MainOpts d -> d -> IO ()
    forall d. Mainable d => MainOpts d -> d -> IO ()
    mainRender MainOpts d
    opts d
    d

    -- | Display the list of diagrams available for rendering.
    showDiaList :: [String] -> IO ()
    showDiaList :: [String] -> IO ()
    showDiaList [String]
    ds = do
      String -> IO ()
    putStrLn String
    "Available diagrams:"
      String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "  " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords [String]
    ds

    -- | @defaultAnimMainRender@ is an implementation of 'mainRender' which renders
    --   an animation as numbered frames, named by extending the given output file
    --   name by consecutive integers.  For example if the given output file name is
    --   @foo\/blah.ext@, the frames will be saved in @foo\/blah001.ext@,
    --   @foo\/blah002.ext@, and so on (the number of padding digits used depends on
    --   the total number of frames).  It is up to the user to take these images and
    --   stitch them together into an actual animation format (using, /e.g./
    --   @ffmpeg@).
    --
    --   Of course, this is a rather crude method of rendering animations;
    --   more sophisticated methods will likely be added in the future.
    --
    --   The @fpu@ option from 'DiagramAnimOpts' can be used to control how many frames will
    --   be output for each second (unit time) of animation.
    --
    --   This function requires a lens into the structure that the particular backend
    --   uses for it's diagram base case.  If @MainOpts (QDiagram b v n Any) ~ DiagramOpts@
    --   then this lens will simply be 'output'.  For a backend supporting looping
    --   it will most likely be @_1 . output@.  This lens is required because the
    --   implementation works by modifying the output field and running the base @mainRender@.
    --   Typically a backend can write its @Animation B V@ instance as
    --
    --   @
    --   instance Mainable (Animation B V) where
    --       type MainOpts (Animation B V) = (DiagramOpts, DiagramAnimOpts)
    --       mainRender = defaultAnimMainRender output
    --   @
    --
    --   We do not provide this instance in general so that backends can choose to
    --   opt-in to this form or provide a different instance that makes more sense.

    defaultAnimMainRender ::
        (opts -> QDiagram b v n Any -> IO ())
        -> Lens' opts FilePath -- ^ A lens into the output path.
        -> (opts, DiagramAnimOpts)
        -> Animation b v n
        -> IO ()
    defaultAnimMainRender :: forall opts b (v :: * -> *) n.
    (opts -> QDiagram b v n Any -> IO ())
    -> Lens' opts String
    -> (opts, DiagramAnimOpts)
    -> Animation b v n
    -> IO ()
    defaultAnimMainRender opts -> QDiagram b v n Any -> IO ()
    renderF Lens' opts String
    out (opts
    opts,DiagramAnimOpts
    animOpts) Animation b v n
    anim = do
      let frames :: [QDiagram b v n Any]
    frames  = Rational -> Animation b v n -> [QDiagram b v n Any]
    forall a. Rational -> Active a -> [a]
    simulate (Double -> Rational
    forall a. Real a => a -> Rational
    toRational (Double -> Rational) -> Double -> Rational
    forall a b. (a -> b) -> a -> b
    $ DiagramAnimOpts
    animOptsDiagramAnimOpts -> Getting Double DiagramAnimOpts Double -> Double
    forall s a. s -> Getting a s a -> a
    ^.Getting Double DiagramAnimOpts Double
    Iso' DiagramAnimOpts Double
    fpu) Animation b v n
    anim
          nDigits :: Int
    nDigits = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int)
    -> ([QDiagram b v n Any] -> String) -> [QDiagram b v n Any] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> String)
    -> ([QDiagram b v n Any] -> Int) -> [QDiagram b v n Any] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [QDiagram b v n Any] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([QDiagram b v n Any] -> Int) -> [QDiagram b v n Any] -> Int
    forall a b. (a -> b) -> a -> b
    $ [QDiagram b v n Any]
    frames
      [(Integer, QDiagram b v n Any)]
    -> ((Integer, QDiagram b v n Any) -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([Integer]
    -> [QDiagram b v n Any] -> [(Integer, QDiagram b v n Any)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer
    1..] [QDiagram b v n Any]
    frames) (((Integer, QDiagram b v n Any) -> IO ()) -> IO ())
    -> ((Integer, QDiagram b v n Any) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Integer
    i,QDiagram b v n Any
    d) -> opts -> QDiagram b v n Any -> IO ()
    renderF (Lens' opts String -> Int -> Integer -> opts -> opts
    forall s. Lens' s String -> Int -> Integer -> s -> s
    indexize (String -> f String) -> opts -> f opts
    Lens' opts String
    out Int
    nDigits Integer
    i opts
    opts) QDiagram b v n Any
    d

    -- | @indexize d n@ adds the integer index @n@ to the end of the
    --   output file name, padding with zeros if necessary so that it uses
    --   at least @d@ digits.
    indexize :: Lens' s FilePath -> Int -> Integer -> s -> s
    indexize :: forall s. Lens' s String -> Int -> Integer -> s -> s
    indexize Lens' s String
    out Int
    nDigits Integer
    i s
    opts = s
    opts s -> (s -> s) -> s
    forall a b. a -> (a -> b) -> b
    & (String -> Identity String) -> s -> Identity s
    Lens' s String
    out ((String -> Identity String) -> s -> Identity s)
    -> String -> s -> s
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ String
    output'
      where fmt :: String
    fmt         = String
    "%0" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    nDigits String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "d"
            output' :: String
    output'     = String -> ShowS
    addExtension (String
    base String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> Integer -> String
    forall r. PrintfType r => String -> r
    printf String
    fmt Integer
    i) String
    ext
            (String
    base, String
    ext) = String -> (String, String)
    splitExtension (s
    optss -> Getting String s String -> String
    forall s a. s -> Getting a s a -> a
    ^.Getting String s String
    Lens' s String
    out)

    putStrF :: String -> IO ()
    putStrF :: String -> IO ()
    putStrF String
    s = String -> IO ()
    putStr String
    s IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hFlush Handle
    stdout

    defaultLoopRender :: DiagramLoopOpts -> IO ()
    defaultLoopRender :: DiagramLoopOpts -> IO ()
    defaultLoopRender DiagramLoopOpts
    opts = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DiagramLoopOpts
    opts DiagramLoopOpts -> Getting Bool DiagramLoopOpts Bool -> Bool
    forall s a. s -> Getting a s a -> a
    ^. Getting Bool DiagramLoopOpts Bool
    Lens' DiagramLoopOpts Bool
    loop) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      String -> IO ()
    putStrLn String
    "Looping turned on"
      String
    prog <- IO String
    getProgName
      [String]
    args <- IO [String]
    getArgs

      String
    srcPath <- case DiagramLoopOpts
    opts DiagramLoopOpts
    -> Getting (Maybe String) DiagramLoopOpts (Maybe String)
    -> Maybe String
    forall s a. s -> Getting a s a -> a
    ^. Getting (Maybe String) DiagramLoopOpts (Maybe String)
    Lens' DiagramLoopOpts (Maybe String)
    src of
        Just String
    path -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    path
        Maybe String
    Nothing   -> String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe (ShowS
    forall a. HasCallStack => String -> a
    error String
    nosrc) (Maybe String -> String) -> IO (Maybe String) -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Maybe String)
    findHsFile String
    prog
          where
            nosrc :: String
    nosrc = String
    "Unable to find Haskell source file.\n"
                 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "Specify source file with '-s' or '--src'"
      String
    srcPath' <- String -> IO String
    canonicalizePath String
    srcPath

      Maybe String
    sandbox     <- [String] -> IO (Maybe String)
    findSandbox []
      [String]
    sandboxArgs <- case Maybe String
    sandbox of
        Maybe String
    Nothing -> [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        Just String
    sb -> do
          String -> IO ()
    putStrLn (String
    "Using sandbox " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    takeDirectory String
    sb)
          [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String
    "-package-db", String
    sb]

      let args' :: [String]
    args'       = String -> [String] -> [String]
    forall a. Eq a => a -> [a] -> [a]
    delete String
    "-l" ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String] -> [String]
    forall a. Eq a => a -> [a] -> [a]
    delete String
    "--loop" ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    args
          newProg :: String
    newProg     = String -> ShowS
    newProgName (ShowS
    takeFileName String
    srcPath) String
    prog
          timeOfDay :: Event -> String
    timeOfDay   = Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    8 ShowS -> (Event -> String) -> Event -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    11 ShowS -> (Event -> String) -> Event -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> String
    forall a. Show a => a -> String
    show (UTCTime -> String) -> (Event -> UTCTime) -> Event -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Event -> UTCTime
    eventTime

      WatchConfig -> (WatchManager -> IO ()) -> IO ()
    forall a. WatchConfig -> (WatchManager -> IO a) -> IO a
    withManagerConf WatchConfig
    defaultConfig ((WatchManager -> IO ()) -> IO ())
    -> (WatchManager -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        \WatchManager
    mgr -> do
          IORef Bool
    lock <- Bool -> IO (IORef Bool)
    forall a. a -> IO (IORef a)
    newIORef Bool
    False

          IO ()
    _ <- WatchManager -> String -> ActionPredicate -> Action -> IO (IO ())
    watchDir WatchManager
    mgr (ShowS
    takeDirectory String
    srcPath') ((String -> Bool) -> ActionPredicate
    existsEvents (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    srcPath'))
            (Action -> IO (IO ())) -> Action -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ \Event
    ev -> do
              Bool
    running <- IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef Bool
    lock ((,) Bool
    True)
              Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    running (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                String -> IO ()
    putStrF (String
    "Modified " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Event -> String
    timeOfDay Event
    ev String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " ... ")
                ExitCode
    exitCode <- String -> String -> [String] -> IO ExitCode
    recompile String
    srcPath' String
    newProg [String]
    sandboxArgs
                -- Call the new program without the looping option
                String -> [String] -> ExitCode -> IO ()
    run String
    newProg [String]
    args' ExitCode
    exitCode
                IORef Bool -> Bool -> IO ()
    forall a. IORef a -> a -> IO ()
    atomicWriteIORef IORef Bool
    lock Bool
    False

          String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Watching source file " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    srcPath
          String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Compiling target: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    newProg
          String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Program args: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords [String]
    args'
          IO () -> IO ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever (IO () -> IO ()) -> (Int -> IO ()) -> Int -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> IO ()
    threadDelay (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ case String
    os of
             -- https://ghc.haskell.org/trac/ghc/ticket/7325
            String
    "darwin" -> Int
    2000000000
            String
    _        -> Int
    forall a. Bounded a => a
    maxBound

    recompile :: FilePath -> FilePath -> [String] -> IO ExitCode
    recompile :: String -> String -> [String] -> IO ExitCode
    recompile String
    srcFile String
    outFile [String]
    args = do
      let ghcArgs :: [String]
    ghcArgs = [String
    "--make", String
    srcFile, String
    "-o", String
    outFile] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    args
      String -> IO ()
    putStrF String
    "compiling ... "
      (ExitCode
    exit, String
    _, String
    stderr) <- String -> [String] -> String -> IO (ExitCode, String, String)
    readProcessWithExitCode String
    "ghc" [String]
    ghcArgs String
    ""
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ExitCode
    exit ExitCode -> ExitCode -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ExitCode
    ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    putStrLn (Char
    '\n'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    stderr)
      ExitCode -> IO ExitCode
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ExitCode
    exit

    -- | On Windows, the next compilation must have a different output
    --   than the currently running program.
    newProgName :: FilePath -> String -> String
    newProgName :: String -> ShowS
    newProgName String
    srcFile String
    oldName = case String
    os of
      String
    "mingw32" ->
          if String
    oldName String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> ShowS
    replaceExtension String
    srcFile String
    "exe"
            then String -> ShowS
    replaceExtension String
    srcFile String
    ".1.exe"
            else String -> ShowS
    replaceExtension String
    srcFile String
    "exe"
      String
    _ -> ShowS
    dropExtension String
    srcFile

    -- | Run the given program with specified arguments, if and only if
    --   the previous command returned ExitSuccess.
    run :: String -> [String] -> ExitCode -> IO ()
    run :: String -> [String] -> ExitCode -> IO ()
    run String
    prog [String]
    args ExitCode
    ExitSuccess = do
      let path :: String
    path = String
    "." String -> ShowS
    </> String
    prog
      String -> IO ()
    putStrF String
    "running ... "
      (ExitCode
    exit, String
    stdOut, String
    stdErr) <- String -> [String] -> String -> IO (ExitCode, String, String)
    readProcessWithExitCode String
    path [String]
    args String
    ""
      case ExitCode
    exit of
        ExitCode
    ExitSuccess   -> String -> IO ()
    putStrLn String
    "done."
        ExitFailure Int
    r -> do
          String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    prog String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " failed with exit code " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    r
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    stdOut) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    putStrLn String
    "stdout:" IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> IO ()
    putStrLn String
    stdOut
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    stdErr) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    putStrLn String
    "stderr:" IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> IO ()
    putStrLn String
    stdErr
    run String
    _ [String]
    _ ExitCode
    _ = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()