{- Ploterific.Plot.Types
Gregory W. Schwartz

Collects the types used in the program
-}

{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}

module Ploterific.Plot.Types where

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

-- Local


-- Basic
newtype Color = Color { Color -> Text
unColor :: T.Text } deriving (ReadPrec [Color]
ReadPrec Color
Int -> ReadS Color
ReadS [Color]
(Int -> ReadS Color)
-> ReadS [Color]
-> ReadPrec Color
-> ReadPrec [Color]
-> Read Color
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Color]
$creadListPrec :: ReadPrec [Color]
readPrec :: ReadPrec Color
$creadPrec :: ReadPrec Color
readList :: ReadS [Color]
$creadList :: ReadS [Color]
readsPrec :: Int -> ReadS Color
$creadsPrec :: Int -> ReadS Color
Read, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show)
newtype Feature = Feature { Feature -> Text
unFeature :: T.Text } deriving (ReadPrec [Feature]
ReadPrec Feature
Int -> ReadS Feature
ReadS [Feature]
(Int -> ReadS Feature)
-> ReadS [Feature]
-> ReadPrec Feature
-> ReadPrec [Feature]
-> Read Feature
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Feature]
$creadListPrec :: ReadPrec [Feature]
readPrec :: ReadPrec Feature
$creadPrec :: ReadPrec Feature
readList :: ReadS [Feature]
$creadList :: ReadS [Feature]
readsPrec :: Int -> ReadS Feature
$creadsPrec :: Int -> ReadS Feature
Read, Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
(Int -> Feature -> ShowS)
-> (Feature -> String) -> ([Feature] -> ShowS) -> Show Feature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feature] -> ShowS
$cshowList :: [Feature] -> ShowS
show :: Feature -> String
$cshow :: Feature -> String
showsPrec :: Int -> Feature -> ShowS
$cshowsPrec :: Int -> Feature -> ShowS
Show)
newtype Facet = Facet { Facet -> Text
unFacet :: T.Text } deriving (ReadPrec [Facet]
ReadPrec Facet
Int -> ReadS Facet
ReadS [Facet]
(Int -> ReadS Facet)
-> ReadS [Facet]
-> ReadPrec Facet
-> ReadPrec [Facet]
-> Read Facet
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Facet]
$creadListPrec :: ReadPrec [Facet]
readPrec :: ReadPrec Facet
$creadPrec :: ReadPrec Facet
readList :: ReadS [Facet]
$creadList :: ReadS [Facet]
readsPrec :: Int -> ReadS Facet
$creadsPrec :: Int -> ReadS Facet
Read, Int -> Facet -> ShowS
[Facet] -> ShowS
Facet -> String
(Int -> Facet -> ShowS)
-> (Facet -> String) -> ([Facet] -> ShowS) -> Show Facet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Facet] -> ShowS
$cshowList :: [Facet] -> ShowS
show :: Facet -> String
$cshow :: Facet -> String
showsPrec :: Int -> Facet -> ShowS
$cshowsPrec :: Int -> Facet -> ShowS
Show)
newtype FacetNum = FacetNum { FacetNum -> Int
unFacetNum :: Int } deriving (ReadPrec [FacetNum]
ReadPrec FacetNum
Int -> ReadS FacetNum
ReadS [FacetNum]
(Int -> ReadS FacetNum)
-> ReadS [FacetNum]
-> ReadPrec FacetNum
-> ReadPrec [FacetNum]
-> Read FacetNum
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FacetNum]
$creadListPrec :: ReadPrec [FacetNum]
readPrec :: ReadPrec FacetNum
$creadPrec :: ReadPrec FacetNum
readList :: ReadS [FacetNum]
$creadList :: ReadS [FacetNum]
readsPrec :: Int -> ReadS FacetNum
$creadsPrec :: Int -> ReadS FacetNum
Read, Int -> FacetNum -> ShowS
[FacetNum] -> ShowS
FacetNum -> String
(Int -> FacetNum -> ShowS)
-> (FacetNum -> String) -> ([FacetNum] -> ShowS) -> Show FacetNum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FacetNum] -> ShowS
$cshowList :: [FacetNum] -> ShowS
show :: FacetNum -> String
$cshow :: FacetNum -> String
showsPrec :: Int -> FacetNum -> ShowS
$cshowsPrec :: Int -> FacetNum -> ShowS
Show)
newtype Delimiter = Delimiter { Delimiter -> Char
unDelimiter :: Char } deriving (ReadPrec [Delimiter]
ReadPrec Delimiter
Int -> ReadS Delimiter
ReadS [Delimiter]
(Int -> ReadS Delimiter)
-> ReadS [Delimiter]
-> ReadPrec Delimiter
-> ReadPrec [Delimiter]
-> Read Delimiter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Delimiter]
$creadListPrec :: ReadPrec [Delimiter]
readPrec :: ReadPrec Delimiter
$creadPrec :: ReadPrec Delimiter
readList :: ReadS [Delimiter]
$creadList :: ReadS [Delimiter]
readsPrec :: Int -> ReadS Delimiter
$creadsPrec :: Int -> ReadS Delimiter
Read, Int -> Delimiter -> ShowS
[Delimiter] -> ShowS
Delimiter -> String
(Int -> Delimiter -> ShowS)
-> (Delimiter -> String)
-> ([Delimiter] -> ShowS)
-> Show Delimiter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delimiter] -> ShowS
$cshowList :: [Delimiter] -> ShowS
show :: Delimiter -> String
$cshow :: Delimiter -> String
showsPrec :: Int -> Delimiter -> ShowS
$cshowsPrec :: Int -> Delimiter -> ShowS
Show)
newtype Input = Input { Input -> String
unInput :: String } deriving (ReadPrec [Input]
ReadPrec Input
Int -> ReadS Input
ReadS [Input]
(Int -> ReadS Input)
-> ReadS [Input]
-> ReadPrec Input
-> ReadPrec [Input]
-> Read Input
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Input]
$creadListPrec :: ReadPrec [Input]
readPrec :: ReadPrec Input
$creadPrec :: ReadPrec Input
readList :: ReadS [Input]
$creadList :: ReadS [Input]
readsPrec :: Int -> ReadS Input
$creadsPrec :: Int -> ReadS Input
Read, Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> String
$cshow :: Input -> String
showsPrec :: Int -> Input -> ShowS
$cshowsPrec :: Int -> Input -> ShowS
Show)
newtype Output = Output { Output -> String
unOutput :: String } deriving (ReadPrec [Output]
ReadPrec Output
Int -> ReadS Output
ReadS [Output]
(Int -> ReadS Output)
-> ReadS [Output]
-> ReadPrec Output
-> ReadPrec [Output]
-> Read Output
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Output]
$creadListPrec :: ReadPrec [Output]
readPrec :: ReadPrec Output
$creadPrec :: ReadPrec Output
readList :: ReadS [Output]
$creadList :: ReadS [Output]
readsPrec :: Int -> ReadS Output
$creadsPrec :: Int -> ReadS Output
Read, Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
(Int -> Output -> ShowS)
-> (Output -> String) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> String
$cshow :: Output -> String
showsPrec :: Int -> Output -> ShowS
$cshowsPrec :: Int -> Output -> ShowS
Show)
newtype Height = Height { Height -> Double
unHeight :: Double } deriving (ReadPrec [Height]
ReadPrec Height
Int -> ReadS Height
ReadS [Height]
(Int -> ReadS Height)
-> ReadS [Height]
-> ReadPrec Height
-> ReadPrec [Height]
-> Read Height
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Height]
$creadListPrec :: ReadPrec [Height]
readPrec :: ReadPrec Height
$creadPrec :: ReadPrec Height
readList :: ReadS [Height]
$creadList :: ReadS [Height]
readsPrec :: Int -> ReadS Height
$creadsPrec :: Int -> ReadS Height
Read, Int -> Height -> ShowS
[Height] -> ShowS
Height -> String
(Int -> Height -> ShowS)
-> (Height -> String) -> ([Height] -> ShowS) -> Show Height
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Height] -> ShowS
$cshowList :: [Height] -> ShowS
show :: Height -> String
$cshow :: Height -> String
showsPrec :: Int -> Height -> ShowS
$cshowsPrec :: Int -> Height -> ShowS
Show)
newtype Width = Width { Width -> Double
unWidth :: Double } deriving (ReadPrec [Width]
ReadPrec Width
Int -> ReadS Width
ReadS [Width]
(Int -> ReadS Width)
-> ReadS [Width]
-> ReadPrec Width
-> ReadPrec [Width]
-> Read Width
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Width]
$creadListPrec :: ReadPrec [Width]
readPrec :: ReadPrec Width
$creadPrec :: ReadPrec Width
readList :: ReadS [Width]
$creadList :: ReadS [Width]
readsPrec :: Int -> ReadS Width
$creadsPrec :: Int -> ReadS Width
Read, Int -> Width -> ShowS
[Width] -> ShowS
Width -> String
(Int -> Width -> ShowS)
-> (Width -> String) -> ([Width] -> ShowS) -> Show Width
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Width] -> ShowS
$cshowList :: [Width] -> ShowS
show :: Width -> String
$cshow :: Width -> String
showsPrec :: Int -> Width -> ShowS
$cshowsPrec :: Int -> Width -> ShowS
Show)
newtype ColorLabel = ColorLabel { ColorLabel -> Text
unColorLabel :: T.Text } deriving (ReadPrec [ColorLabel]
ReadPrec ColorLabel
Int -> ReadS ColorLabel
ReadS [ColorLabel]
(Int -> ReadS ColorLabel)
-> ReadS [ColorLabel]
-> ReadPrec ColorLabel
-> ReadPrec [ColorLabel]
-> Read ColorLabel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColorLabel]
$creadListPrec :: ReadPrec [ColorLabel]
readPrec :: ReadPrec ColorLabel
$creadPrec :: ReadPrec ColorLabel
readList :: ReadS [ColorLabel]
$creadList :: ReadS [ColorLabel]
readsPrec :: Int -> ReadS ColorLabel
$creadsPrec :: Int -> ReadS ColorLabel
Read, Int -> ColorLabel -> ShowS
[ColorLabel] -> ShowS
ColorLabel -> String
(Int -> ColorLabel -> ShowS)
-> (ColorLabel -> String)
-> ([ColorLabel] -> ShowS)
-> Show ColorLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorLabel] -> ShowS
$cshowList :: [ColorLabel] -> ShowS
show :: ColorLabel -> String
$cshow :: ColorLabel -> String
showsPrec :: Int -> ColorLabel -> ShowS
$cshowsPrec :: Int -> ColorLabel -> ShowS
Show)
newtype DefaultTheme = DefaultTheme { DefaultTheme -> Bool
unDefaultTheme :: Bool } deriving (ReadPrec [DefaultTheme]
ReadPrec DefaultTheme
Int -> ReadS DefaultTheme
ReadS [DefaultTheme]
(Int -> ReadS DefaultTheme)
-> ReadS [DefaultTheme]
-> ReadPrec DefaultTheme
-> ReadPrec [DefaultTheme]
-> Read DefaultTheme
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DefaultTheme]
$creadListPrec :: ReadPrec [DefaultTheme]
readPrec :: ReadPrec DefaultTheme
$creadPrec :: ReadPrec DefaultTheme
readList :: ReadS [DefaultTheme]
$creadList :: ReadS [DefaultTheme]
readsPrec :: Int -> ReadS DefaultTheme
$creadsPrec :: Int -> ReadS DefaultTheme
Read, Int -> DefaultTheme -> ShowS
[DefaultTheme] -> ShowS
DefaultTheme -> String
(Int -> DefaultTheme -> ShowS)
-> (DefaultTheme -> String)
-> ([DefaultTheme] -> ShowS)
-> Show DefaultTheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultTheme] -> ShowS
$cshowList :: [DefaultTheme] -> ShowS
show :: DefaultTheme -> String
$cshow :: DefaultTheme -> String
showsPrec :: Int -> DefaultTheme -> ShowS
$cshowsPrec :: Int -> DefaultTheme -> ShowS
Show)

-- Advanced
data Opts = Opts { Opts -> Maybe Color
_color :: Maybe Color
                 , Opts -> [Feature]
_features :: [Feature]
                 , Opts -> Maybe Facet
_facet :: Maybe Facet
                 , Opts -> Maybe FacetNum
_facetNum :: Maybe FacetNum
                 , Opts -> Delimiter
_delimiter :: Delimiter
                 , Opts -> Maybe Input
_input :: Maybe Input
                 , Opts -> Maybe Output
_output :: Maybe Output
                 , Opts -> Mark
_mark :: VL.Mark
                 , Opts -> Maybe Height
_height :: Maybe Height
                 , Opts -> Maybe Width
_width :: Maybe Width
                 , Opts -> DefaultTheme
_defaultTheme :: DefaultTheme
                 }

deriving instance Read VL.Mark
deriving instance Eq VL.Measurement