{- Ploterific.Program.Options
Gregory W. Schwartz

Options for the command line program.
-}

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators     #-}
{-# LANGUAGE StandaloneDeriving #-}

module Ploterific.Program.Options where

-- Remote
import Options.Generic
import qualified Data.Text as T
import qualified Graphics.Vega.VegaLite as VL

-- Local
import Ploterific.Plot.Types

-- | Command line arguments
data Options
    = Options { Options
-> Maybe String
   <?> "([STDIN] | PATH) The path for the input data in tabular format, with row observations and column features."
input :: Maybe String <?> "([STDIN] | PATH) The path for the input data in tabular format, with row observations and column features."
              , Options -> Maybe String <?> "([STDOUT] | PATH) HTML output path."
output :: Maybe String <?> "([STDOUT] | PATH) HTML output path."
              , Options
-> [String]
   <?> "(COLUMN) A list of columns to use in the plot in the format --feature col1 --feature col2 etc. for axes X, Y, etc. To force a measurement, add `:` followed by `N`, `O`, `Q`, or `T` for nominal, ordinal, quantitiative, or temporal measurements, respectively. Full list of measurements located at https://vega.github.io/vega-lite/docs/type.html."
feature :: [String] <?> "(COLUMN) A list of columns to use in the plot in the format --feature col1 --feature col2 etc. for axes X, Y, etc. To force a measurement, add `:` followed by `N`, `O`, `Q`, or `T` for nominal, ordinal, quantitiative, or temporal measurements, respectively. Full list of measurements located at https://vega.github.io/vega-lite/docs/type.html."
              , Options
-> Maybe String
   <?> "(NOTHING | COLUMN) The column containing a feature to use to facet a plot into a Trellis plot. Add measurement according to --feature if needed."
facet :: Maybe String <?> "(NOTHING | COLUMN) The column containing a feature to use to facet a plot into a Trellis plot. Add measurement according to --feature if needed."
              , Options
-> Maybe Int
   <?> "(NOTHING | INT) The number of columns for the Trellis plot from --facet."
facetNum :: Maybe Int <?> "(NOTHING | INT) The number of columns for the Trellis plot from --facet."
              , Options
-> Maybe String
   <?> "(NOTHING | COLUMN) The column containing a feature to use for colors. Add measurement according to --feature if needed."
color :: Maybe String <?> "(NOTHING | COLUMN) The column containing a feature to use for colors. Add measurement according to --feature if needed."
              , Options
-> String
   <?> "(MARK) The mark type for the plot. Common types are Circle, Bar, Boxplot, and Line. See https://hackage.haskell.org/package/hvega-0.11.0.1/docs/Graphics-Vega-VegaLite.html#t:Mark for a list."
mark :: String <?> "(MARK) The mark type for the plot. Common types are Circle, Bar, Boxplot, and Line. See https://hackage.haskell.org/package/hvega-0.11.0.1/docs/Graphics-Vega-VegaLite.html#t:Mark for a list."
              , Options
-> Maybe Char <?> "([,] | CHAR) The delimiter for the table."
delimiter :: Maybe Char <?> "([,] | CHAR) The delimiter for the table."
              , Options
-> Maybe Double <?> "(Nothing | DOUBLE) The height of the plot."
height :: Maybe Double <?> "(Nothing | DOUBLE) The height of the plot."
              , Options
-> Maybe Double <?> "(Nothing | Double) The width of the plot."
width :: Maybe Double <?> "(Nothing | Double) The width of the plot."
              , Options
-> Bool <?> "Whether to use the default theme of vega-lite."
defaultTheme :: Bool <?> "Whether to use the default theme of vega-lite."
              } deriving ((forall x. Options -> Rep Options x)
-> (forall x. Rep Options x -> Options) -> Generic Options
forall x. Rep Options x -> Options
forall x. Options -> Rep Options x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Options x -> Options
$cfrom :: forall x. Options -> Rep Options x
Generic)

modifiers :: Modifiers
modifiers :: Modifiers
modifiers = Modifiers
lispCaseModifiers { shortNameModifier :: String -> Maybe Char
shortNameModifier = String -> Maybe Char
short }
  where
    short :: String -> Maybe Char
short String
"input"         = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'i'
    short String
"output"        = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'o'
    short String
"feature"       = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'f'
    short String
"facet"         = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
't'
    short String
"facetNum"      = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'n'
    short String
"color"         = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'c'
    short String
"mark"          = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'm'
    short String
"delimiter"     = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'd'
    short String
"height"        = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'H'
    short String
"width"         = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'W'
    short String
"defaultTheme"  = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'D'
    short String
x               = String -> Maybe Char
firstLetter String
x

instance ParseRecord Options where
    parseRecord :: Parser Options
parseRecord = Modifiers -> Parser Options
forall a.
(Generic a, GenericParseRecord (Rep a)) =>
Modifiers -> Parser a
parseRecordWithModifiers Modifiers
modifiers