{- Ploterific.Plot.Plot
Gregory W. Schwartz

Collects the functions pertaining to the plotting of figures.
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}

module Ploterific.Plot.Plot
  ( plot
  , labelColorScale
  ) where

-- Remote
import Control.Monad.Reader (ReaderT (..), asks, liftIO)
import Data.Bool (bool)
import Data.Char (ord)
import Data.Colour.Palette.BrewerSet ( brewerSet, ColorCat (..) )
import Data.Colour.Palette.Harmony (colorRamp)
import Data.Colour.SRGB (sRGB24show)
import Data.Either (rights)
import Data.List (foldl')
import Data.Maybe (fromMaybe, isJust)
import GHC.Natural (intToNatural)
import qualified Control.Lens as L
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.ByteString.Char8 as B
import qualified Data.Csv.Streaming as CSVStream
import qualified Data.Csv as CSV
import qualified Data.Foldable as F
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Read as T
import qualified Graphics.Vega.VegaLite as VL
import qualified Graphics.Vega.VegaLite.Theme as VL

-- Local
import Ploterific.Plot.Types

-- | Split the measurement of a feature.
splitColMeasure :: T.Text -> Either T.Text (T.Text, VL.Measurement)
splitColMeasure :: Text -> Either Text (Text, Measurement)
splitColMeasure Text
feature = (Text, Text) -> Either Text (Text, Measurement)
splitOrNot ((Text, Text) -> Either Text (Text, Measurement))
-> (Text -> (Text, Text))
-> Text
-> Either Text (Text, Measurement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> (Text, Text)
T.breakOnEnd Text
":" (Text -> Either Text (Text, Measurement))
-> Text -> Either Text (Text, Measurement)
forall a b. (a -> b) -> a -> b
$ Text
feature
  where
    splitOrNot :: (Text, Text) -> Either Text (Text, Measurement)
splitOrNot (Text
"", Text
_) = Text -> Either Text (Text, Measurement)
forall a b. a -> Either a b
Left Text
feature
    splitOrNot (Text, Text)
x = (Text, Measurement) -> Either Text (Text, Measurement)
forall a b. b -> Either a b
Right ((Text, Measurement) -> Either Text (Text, Measurement))
-> (Text, Measurement) -> Either Text (Text, Measurement)
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> (Text, Measurement)
trueSplit (Text, Text)
x
    trueSplit :: (Text, Text) -> (Text, Measurement)
trueSplit = ASetter (Text, Measurement) (Text, Measurement) Text Text
-> (Text -> Text) -> (Text, Measurement) -> (Text, Measurement)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter (Text, Measurement) (Text, Measurement) Text Text
forall s t a b. Field1 s t a b => Lens s t a b
L._1 (Int -> Text -> Text
T.dropEnd Int
1) ((Text, Measurement) -> (Text, Measurement))
-> ((Text, Text) -> (Text, Measurement))
-> (Text, Text)
-> (Text, Measurement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (Text, Text) (Text, Measurement) Text Measurement
-> (Text -> Measurement) -> (Text, Text) -> (Text, Measurement)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter (Text, Text) (Text, Measurement) Text Measurement
forall s t a b. Field2 s t a b => Lens s t a b
L._2 Text -> Measurement
forall a. (Eq a, IsString a) => a -> Measurement
toMeasurement
    toMeasurement :: a -> Measurement
toMeasurement a
"N" = Measurement
VL.Nominal
    toMeasurement a
"O" = Measurement
VL.Ordinal
    toMeasurement a
"Q" = Measurement
VL.Quantitative
    toMeasurement a
"T" = Measurement
VL.Temporal

-- | Get the column name even with the measurement.
getColName :: T.Text -> T.Text
getColName :: Text -> Text
getColName = (Text -> Text)
-> ((Text, Measurement) -> Text)
-> Either Text (Text, Measurement)
-> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Text
forall a. a -> a
id (Text, Measurement) -> Text
forall a b. (a, b) -> a
fst (Either Text (Text, Measurement) -> Text)
-> (Text -> Either Text (Text, Measurement)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Text, Measurement)
splitColMeasure

-- | Get the measurement.
getColMeasurement :: T.Text -> Maybe VL.Measurement
getColMeasurement :: Text -> Maybe Measurement
getColMeasurement = (Text -> Maybe Measurement)
-> ((Text, Measurement) -> Maybe Measurement)
-> Either Text (Text, Measurement)
-> Maybe Measurement
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Measurement -> Text -> Maybe Measurement
forall a b. a -> b -> a
const Maybe Measurement
forall a. Maybe a
Nothing) (Measurement -> Maybe Measurement
forall a. a -> Maybe a
Just (Measurement -> Maybe Measurement)
-> ((Text, Measurement) -> Measurement)
-> (Text, Measurement)
-> Maybe Measurement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Measurement) -> Measurement
forall a b. (a, b) -> b
snd) (Either Text (Text, Measurement) -> Maybe Measurement)
-> (Text -> Either Text (Text, Measurement))
-> Text
-> Maybe Measurement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text (Text, Measurement)
splitColMeasure

-- | Parse rows of a CSV.
loadCsv :: Delimiter -> BL.ByteString -> [Map.Map T.Text T.Text]
loadCsv :: Delimiter -> ByteString -> [Map Text Text]
loadCsv (Delimiter Char
d) =
  ([Char] -> [Map Text Text])
-> ((Header, Records (Map Text Text)) -> [Map Text Text])
-> Either [Char] (Header, Records (Map Text Text))
-> [Map Text Text]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> [Map Text Text]
forall a. HasCallStack => [Char] -> a
error (Records (Map Text Text) -> [Map Text Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Records (Map Text Text) -> [Map Text Text])
-> ((Header, Records (Map Text Text)) -> Records (Map Text Text))
-> (Header, Records (Map Text Text))
-> [Map Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header, Records (Map Text Text)) -> Records (Map Text Text)
forall a b. (a, b) -> b
snd)
    (Either [Char] (Header, Records (Map Text Text))
 -> [Map Text Text])
-> (ByteString -> Either [Char] (Header, Records (Map Text Text)))
-> ByteString
-> [Map Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeOptions
-> ByteString -> Either [Char] (Header, Records (Map Text Text))
forall a.
FromNamedRecord a =>
DecodeOptions -> ByteString -> Either [Char] (Header, Records a)
CSVStream.decodeByNameWith ( DecodeOptions
CSV.defaultDecodeOptions
                                 { decDelimiter :: Word8
CSV.decDelimiter = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
d) }
                                 )


-- | Convert rows to data columns.
rowsToDataColumns :: Maybe Color
                  -> Maybe Facet
                  -> [Feature]
                  -> [Map.Map T.Text T.Text]
                  -> [VL.DataColumn]
                  -> VL.Data
rowsToDataColumns :: Maybe Color
-> Maybe Facet
-> [Feature]
-> [Map Text Text]
-> [DataColumn]
-> Data
rowsToDataColumns Maybe Color
color Maybe Facet
facet [Feature]
fs [Map Text Text]
rows =
  [Format] -> [DataColumn] -> Data
VL.dataFromColumns []
    ([DataColumn] -> Data)
-> ([DataColumn] -> [DataColumn]) -> [DataColumn] -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([DataColumn] -> [DataColumn])
-> (Color -> [DataColumn] -> [DataColumn])
-> Maybe Color
-> [DataColumn]
-> [DataColumn]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        [DataColumn] -> [DataColumn]
forall a. a -> a
id
        (\ (Color Text
x)
        -> Text -> DataValues -> [DataColumn] -> [DataColumn]
VL.dataColumn
            (Text -> Text
getColName Text
x)
            (([Map Text Text] -> DataValues)
-> Text -> [Map Text Text] -> DataValues
numOrString (Text -> [Map Text Text] -> DataValues
textToString Text
x) Text
x [Map Text Text]
rows)
        )
        Maybe Color
color
    ([DataColumn] -> [DataColumn])
-> ([DataColumn] -> [DataColumn]) -> [DataColumn] -> [DataColumn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([DataColumn] -> [DataColumn])
-> (Facet -> [DataColumn] -> [DataColumn])
-> Maybe Facet
-> [DataColumn]
-> [DataColumn]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        [DataColumn] -> [DataColumn]
forall a. a -> a
id
        (\ (Facet Text
x)
        -> Text -> DataValues -> [DataColumn] -> [DataColumn]
VL.dataColumn
            (Text -> Text
getColName Text
x)
            (([Map Text Text] -> DataValues)
-> Text -> [Map Text Text] -> DataValues
numOrString (Text -> [Map Text Text] -> DataValues
textToString Text
x) Text
x [Map Text Text]
rows)
        )
        Maybe Facet
facet
    ([DataColumn] -> [DataColumn])
-> ([DataColumn] -> [DataColumn]) -> [DataColumn] -> [DataColumn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([DataColumn] -> [DataColumn])
 -> Feature -> [DataColumn] -> [DataColumn])
-> ([DataColumn] -> [DataColumn])
-> [Feature]
-> [DataColumn]
-> [DataColumn]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
        (\ [DataColumn] -> [DataColumn]
acc (Feature Text
x)
        -> Text -> DataValues -> [DataColumn] -> [DataColumn]
VL.dataColumn
            (Text -> Text
getColName Text
x)
            (([Map Text Text] -> DataValues)
-> Text -> [Map Text Text] -> DataValues
numOrString (Text -> [Map Text Text] -> DataValues
textToNumbers Text
x) Text
x [Map Text Text]
rows)
         ([DataColumn] -> [DataColumn])
-> ([DataColumn] -> [DataColumn]) -> [DataColumn] -> [DataColumn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DataColumn] -> [DataColumn]
acc
        )
        [DataColumn] -> [DataColumn]
forall a. a -> a
id
        [Feature]
fs
  where
    numOrString :: ([Map.Map T.Text T.Text] -> VL.DataValues) -> T.Text -> ([Map.Map T.Text T.Text] -> VL.DataValues)
    numOrString :: ([Map Text Text] -> DataValues)
-> Text -> [Map Text Text] -> DataValues
numOrString [Map Text Text] -> DataValues
def Text
x =
      ([Map Text Text] -> DataValues)
-> (Measurement -> [Map Text Text] -> DataValues)
-> Maybe Measurement
-> [Map Text Text]
-> DataValues
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          [Map Text Text] -> DataValues
def
          (([Map Text Text] -> DataValues)
-> ([Map Text Text] -> DataValues)
-> Bool
-> [Map Text Text]
-> DataValues
forall a. a -> a -> Bool -> a
bool (Text -> [Map Text Text] -> DataValues
textToString Text
x) (Text -> [Map Text Text] -> DataValues
textToNumbers Text
x) (Bool -> [Map Text Text] -> DataValues)
-> (Measurement -> Bool)
-> Measurement
-> [Map Text Text]
-> DataValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Measurement -> Measurement -> Bool
forall a. Eq a => a -> a -> Bool
== Measurement
VL.Quantitative))
        (Maybe Measurement -> [Map Text Text] -> DataValues)
-> (Text -> Maybe Measurement)
-> Text
-> [Map Text Text]
-> DataValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Measurement
getColMeasurement
        (Text -> [Map Text Text] -> DataValues)
-> Text -> [Map Text Text] -> DataValues
forall a b. (a -> b) -> a -> b
$ Text
x
    textToNumbers :: Text -> [Map Text Text] -> DataValues
textToNumbers Text
x = [Double] -> DataValues
VL.Numbers
                    ([Double] -> DataValues)
-> ([Map Text Text] -> [Double]) -> [Map Text Text] -> DataValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Double, Text) -> Double) -> [(Double, Text)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, Text) -> Double
forall a b. (a, b) -> a
fst
                    ([(Double, Text)] -> [Double])
-> ([Map Text Text] -> [(Double, Text)])
-> [Map Text Text]
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either [Char] (Double, Text)] -> [(Double, Text)]
forall a b. [Either a b] -> [b]
rights
                    ([Either [Char] (Double, Text)] -> [(Double, Text)])
-> ([Map Text Text] -> [Either [Char] (Double, Text)])
-> [Map Text Text]
-> [(Double, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text Text -> Either [Char] (Double, Text))
-> [Map Text Text] -> [Either [Char] (Double, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( Either [Char] (Double, Text)
-> (Text -> Either [Char] (Double, Text))
-> Maybe Text
-> Either [Char] (Double, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                              ( [Char] -> Either [Char] (Double, Text)
forall a. HasCallStack => [Char] -> a
error
                              ([Char] -> Either [Char] (Double, Text))
-> [Char] -> Either [Char] (Double, Text)
forall a b. (a -> b) -> a -> b
$ [Char]
"Column not in table: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show (Text -> Text
getColName Text
x))
                              Text -> Either [Char] (Double, Text)
T.double
                           (Maybe Text -> Either [Char] (Double, Text))
-> (Map Text Text -> Maybe Text)
-> Map Text Text
-> Either [Char] (Double, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Text
getColName Text
x)
                           )
    textToString :: Text -> [Map Text Text] -> DataValues
textToString Text
x = [Text] -> DataValues
VL.Strings ([Text] -> DataValues)
-> ([Map Text Text] -> [Text]) -> [Map Text Text] -> DataValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text Text -> Text) -> [Map Text Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text)
-> (Map Text Text -> Maybe Text) -> Map Text Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Text
getColName Text
x))

-- | Get color encoding for color ramps.
labelColorScale :: [ColorLabel] -> VL.MarkChannel
labelColorScale :: [ColorLabel] -> MarkChannel
labelColorScale [ColorLabel]
cs = [ScaleProperty] -> MarkChannel
VL.MScale [ DomainLimits -> ScaleProperty
VL.SDomain ([Text] -> DomainLimits
VL.DStrings [Text]
labels)
                               , ScaleRange -> ScaleProperty
VL.SRange ([Text] -> ScaleRange
VL.RStrings [Text]
colors)
                               ]
  where
    labels :: [Text]
labels =
      Set Text -> [Text]
forall a. Set a -> [a]
Set.toAscList (Set Text -> [Text])
-> ([ColorLabel] -> Set Text) -> [ColorLabel] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text)
-> ([ColorLabel] -> [Text]) -> [ColorLabel] -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColorLabel -> Text) -> [ColorLabel] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ColorLabel -> Text
unColorLabel ([ColorLabel] -> [Text]) -> [ColorLabel] -> [Text]
forall a b. (a -> b) -> a -> b
$ [ColorLabel]
cs
    colors :: [Text]
colors =
      (Colour Double -> Text) -> [Colour Double] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> Text
T.pack ([Char] -> Text)
-> (Colour Double -> [Char]) -> Colour Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour Double -> [Char]
forall b. (RealFrac b, Floating b) => Colour b -> [Char]
sRGB24show) ([Colour Double] -> [Text])
-> (Int -> [Colour Double]) -> Int -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Colour Double] -> [Colour Double]
colorRamp ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
labels) ([Colour Double] -> [Colour Double])
-> (Int -> [Colour Double]) -> Int -> [Colour Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColorCat -> Int -> [Colour Double]
brewerSet ColorCat
Set1 (Int -> [Text]) -> Int -> [Text]
forall a b. (a -> b) -> a -> b
$ Int
9

-- | Get the encoding.
enc :: DefaultTheme
    -> Maybe (Color, [ColorLabel])
    -> [Feature]
    -> [VL.EncodingSpec]
    -> VL.PropertySpec
enc :: DefaultTheme
-> Maybe (Color, [ColorLabel])
-> [Feature]
-> [EncodingSpec]
-> Data
enc DefaultTheme
defaultTheme' Maybe (Color, [ColorLabel])
colorInfo [Feature]
fs =
  [EncodingSpec] -> Data
VL.encoding
    ([EncodingSpec] -> Data)
-> ([EncodingSpec] -> [EncodingSpec]) -> [EncodingSpec] -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([EncodingSpec] -> [EncodingSpec])
-> ((Color, [ColorLabel]) -> [EncodingSpec] -> [EncodingSpec])
-> Maybe (Color, [ColorLabel])
-> [EncodingSpec]
-> [EncodingSpec]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        [EncodingSpec] -> [EncodingSpec]
forall a. a -> a
id
        (\ (Color Text
c, [ColorLabel]
ls)
        -> [MarkChannel] -> [EncodingSpec] -> [EncodingSpec]
VL.color ( [Text -> MarkChannel
VL.MName (Text -> MarkChannel) -> (Text -> Text) -> Text -> MarkChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getColName (Text -> MarkChannel) -> Text -> MarkChannel
forall a b. (a -> b) -> a -> b
$ Text
c]
                   [MarkChannel] -> [MarkChannel] -> [MarkChannel]
forall a. Semigroup a => a -> a -> a
<> [MarkChannel] -> [MarkChannel] -> Bool -> [MarkChannel]
forall a. a -> a -> Bool -> a
bool [[ColorLabel] -> MarkChannel
labelColorScale [ColorLabel]
ls] [] (DefaultTheme -> Bool
unDefaultTheme DefaultTheme
defaultTheme')
                   [MarkChannel] -> [MarkChannel] -> [MarkChannel]
forall a. Semigroup a => a -> a -> a
<> [MarkChannel]
-> (Measurement -> [MarkChannel])
-> Maybe Measurement
-> [MarkChannel]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Measurement
x -> [Measurement -> MarkChannel
VL.MmType Measurement
x]) (Text -> Maybe Measurement
getColMeasurement Text
c)
                    )
        )
        Maybe (Color, [ColorLabel])
colorInfo
    ([EncodingSpec] -> [EncodingSpec])
-> ([EncodingSpec] -> [EncodingSpec])
-> [EncodingSpec]
-> [EncodingSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[TextChannel]] -> [EncodingSpec] -> [EncodingSpec]
VL.tooltips
        ( (Feature -> [TextChannel]) -> [Feature] -> [[TextChannel]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (Feature !Text
f)
               -> [ Text -> TextChannel
VL.TName (Text -> TextChannel) -> (Text -> Text) -> Text -> TextChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getColName (Text -> TextChannel) -> Text -> TextChannel
forall a b. (a -> b) -> a -> b
$ Text
f ]
                 [TextChannel] -> [TextChannel] -> [TextChannel]
forall a. Semigroup a => a -> a -> a
<> [TextChannel]
-> (Measurement -> [TextChannel])
-> Maybe Measurement
-> [TextChannel]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Measurement
x -> [Measurement -> TextChannel
VL.TmType Measurement
x]) (Text -> Maybe Measurement
getColMeasurement Text
f)
               )
          [Feature]
fs
       [[TextChannel]] -> [[TextChannel]] -> [[TextChannel]]
forall a. Semigroup a => a -> a -> a
<> [ [TextChannel]
-> ((Color, [ColorLabel]) -> [TextChannel])
-> Maybe (Color, [ColorLabel])
-> [TextChannel]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              []
              (\ (Color Text
c, [ColorLabel]
_)
              -> [Text -> TextChannel
VL.TName (Text -> TextChannel) -> (Text -> Text) -> Text -> TextChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getColName (Text -> TextChannel) -> Text -> TextChannel
forall a b. (a -> b) -> a -> b
$ Text
c]
              [TextChannel] -> [TextChannel] -> [TextChannel]
forall a. Semigroup a => a -> a -> a
<> [TextChannel]
-> (Measurement -> [TextChannel])
-> Maybe Measurement
-> [TextChannel]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Measurement
x -> [Measurement -> TextChannel
VL.TmType Measurement
x]) (Text -> Maybe Measurement
getColMeasurement Text
c)
              )
              Maybe (Color, [ColorLabel])
colorInfo
          ]
        )
    ([EncodingSpec] -> [EncodingSpec])
-> ([EncodingSpec] -> [EncodingSpec])
-> [EncodingSpec]
-> [EncodingSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([EncodingSpec] -> [EncodingSpec])
 -> (Position, Feature) -> [EncodingSpec] -> [EncodingSpec])
-> ([EncodingSpec] -> [EncodingSpec])
-> [(Position, Feature)]
-> [EncodingSpec]
-> [EncodingSpec]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
        (\ [EncodingSpec] -> [EncodingSpec]
acc (!Position
p, Feature !Text
f)
        -> Position -> [PositionChannel] -> [EncodingSpec] -> [EncodingSpec]
VL.position
            Position
p
            ( [Text -> PositionChannel
VL.PName (Text -> PositionChannel)
-> (Text -> Text) -> Text -> PositionChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getColName (Text -> PositionChannel) -> Text -> PositionChannel
forall a b. (a -> b) -> a -> b
$ Text
f]
             [PositionChannel] -> [PositionChannel] -> [PositionChannel]
forall a. Semigroup a => a -> a -> a
<> [PositionChannel]
-> (Measurement -> [PositionChannel])
-> Maybe Measurement
-> [PositionChannel]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Measurement
x -> [Measurement -> PositionChannel
VL.PmType Measurement
x]) (Text -> Maybe Measurement
getColMeasurement Text
f)
            )
         ([EncodingSpec] -> [EncodingSpec])
-> ([EncodingSpec] -> [EncodingSpec])
-> [EncodingSpec]
-> [EncodingSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EncodingSpec] -> [EncodingSpec]
acc
        )
        [EncodingSpec] -> [EncodingSpec]
forall a. a -> a
id
        ([Position] -> [Feature] -> [(Position, Feature)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Position]
pos [Feature]
fs)
  where
    pos :: [Position]
pos = [Position
VL.X, Position
VL.Y]

-- | Render plot.
plot :: ReaderT Opts IO ()
plot :: ReaderT Opts IO ()
plot = do
  IO ByteString
input' <- (Opts -> IO ByteString) -> ReaderT Opts IO (IO ByteString)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (IO ByteString
-> (Input -> IO ByteString) -> Maybe Input -> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ByteString
BL.getContents ([Char] -> IO ByteString
BL.readFile ([Char] -> IO ByteString)
-> (Input -> [Char]) -> Input -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> [Char]
unInput) (Maybe Input -> IO ByteString)
-> (Opts -> Maybe Input) -> Opts -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opts -> Maybe Input
_input)
  Text -> IO ()
output' <- (Opts -> Text -> IO ()) -> ReaderT Opts IO (Text -> IO ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Text -> IO ())
-> (Output -> Text -> IO ()) -> Maybe Output -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
TL.putStrLn ([Char] -> Text -> IO ()
TL.writeFile ([Char] -> Text -> IO ())
-> (Output -> [Char]) -> Output -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output -> [Char]
unOutput) (Maybe Output -> Text -> IO ())
-> (Opts -> Maybe Output) -> Opts -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opts -> Maybe Output
_output)
  Maybe Height
height' <- (Opts -> Maybe Height) -> ReaderT Opts IO (Maybe Height)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Opts -> Maybe Height
_height
  Maybe Width
width' <- (Opts -> Maybe Width) -> ReaderT Opts IO (Maybe Width)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Opts -> Maybe Width
_width
  Mark
mark' <- (Opts -> Mark) -> ReaderT Opts IO Mark
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Opts -> Mark
_mark
  Maybe Color
color' <- (Opts -> Maybe Color) -> ReaderT Opts IO (Maybe Color)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Opts -> Maybe Color
_color
  [Feature]
features' <- (Opts -> [Feature]) -> ReaderT Opts IO [Feature]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Opts -> [Feature]
_features
  Maybe Facet
facet' <- (Opts -> Maybe Facet) -> ReaderT Opts IO (Maybe Facet)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Opts -> Maybe Facet
_facet
  Maybe FacetNum
facetNum' <- (Opts -> Maybe FacetNum) -> ReaderT Opts IO (Maybe FacetNum)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Opts -> Maybe FacetNum
_facetNum
  Delimiter
delimiter' <- (Opts -> Delimiter) -> ReaderT Opts IO Delimiter
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Opts -> Delimiter
_delimiter
  DefaultTheme
defaultTheme' <- (Opts -> DefaultTheme) -> ReaderT Opts IO DefaultTheme
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Opts -> DefaultTheme
_defaultTheme

  ByteString
contents <- IO ByteString -> ReaderT Opts IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
input'

  let rows :: [Map Text Text]
rows = Delimiter -> ByteString -> [Map Text Text]
loadCsv Delimiter
delimiter' ByteString
contents
      dataSet :: [DataColumn] -> Data
dataSet =
        Maybe Color
-> Maybe Facet
-> [Feature]
-> [Map Text Text]
-> [DataColumn]
-> Data
rowsToDataColumns Maybe Color
color' Maybe Facet
facet' [Feature]
features' ([Map Text Text] -> [DataColumn] -> Data)
-> [Map Text Text] -> [DataColumn] -> Data
forall a b. (a -> b) -> a -> b
$ [Map Text Text]
rows
      colorLabels :: Maybe [ColorLabel]
colorLabels =
        (Color -> [ColorLabel]) -> Maybe Color -> Maybe [ColorLabel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\ (Color Text
c)
          -> (Map Text Text -> ColorLabel) -> [Map Text Text] -> [ColorLabel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ColorLabel
ColorLabel (Text -> ColorLabel)
-> (Map Text Text -> Text) -> Map Text Text -> ColorLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text)
-> (Map Text Text -> Maybe Text) -> Map Text Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Text
getColName Text
c)) [Map Text Text]
rows
          )
          Maybe Color
color'
      colorInfo :: Maybe (Color, [ColorLabel])
colorInfo = (,) (Color -> [ColorLabel] -> (Color, [ColorLabel]))
-> Maybe Color -> Maybe ([ColorLabel] -> (Color, [ColorLabel]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Color
color' Maybe ([ColorLabel] -> (Color, [ColorLabel]))
-> Maybe [ColorLabel] -> Maybe (Color, [ColorLabel])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [ColorLabel]
colorLabels
      facetSpec :: Facet -> [Data]
facetSpec (Facet Text
x) = [ [FacetChannel] -> Data
VL.facetFlow
                            ([FacetChannel] -> Data) -> [FacetChannel] -> Data
forall a b. (a -> b) -> a -> b
$ [Text -> FacetChannel
VL.FName (Text -> FacetChannel) -> (Text -> Text) -> Text -> FacetChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getColName (Text -> FacetChannel) -> Text -> FacetChannel
forall a b. (a -> b) -> a -> b
$ Text
x]
                           [FacetChannel] -> [FacetChannel] -> [FacetChannel]
forall a. Semigroup a => a -> a -> a
<> [FacetChannel]
-> (Measurement -> [FacetChannel])
-> Maybe Measurement
-> [FacetChannel]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Measurement
y -> [Measurement -> FacetChannel
VL.FmType Measurement
y]) (Text -> Maybe Measurement
getColMeasurement Text
x)
                            ]
      plotSpec :: [Data]
plotSpec = [ DefaultTheme
-> Maybe (Color, [ColorLabel])
-> [Feature]
-> [EncodingSpec]
-> Data
enc DefaultTheme
defaultTheme' Maybe (Color, [ColorLabel])
colorInfo [Feature]
features' []
                 , Mark -> [MarkProperty] -> Data
VL.mark Mark
mark' []
                 , [SelectSpec] -> Data
VL.selection ([SelectSpec] -> Data)
-> ([SelectSpec] -> [SelectSpec]) -> [SelectSpec] -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Selection -> [SelectionProperty] -> [SelectSpec] -> [SelectSpec]
VL.select Text
"view" Selection
VL.Interval [SelectionProperty
VL.BindScales]
                 ([SelectSpec] -> Data) -> [SelectSpec] -> Data
forall a b. (a -> b) -> a -> b
$ []
                 ]
      p :: VegaLite
p       = [Data] -> VegaLite
VL.toVegaLite
              ([Data] -> VegaLite) -> [Data] -> VegaLite
forall a b. (a -> b) -> a -> b
$   [ [DataColumn] -> Data
dataSet []
                  ]
                 [Data] -> [Data] -> [Data]
forall a. Semigroup a => a -> a -> a
<> [Data] -> [Data] -> Bool -> [Data]
forall a. a -> a -> Bool -> a
bool [Data]
plotSpec [VLSpec -> Data
VL.specification (VLSpec -> Data) -> ([Data] -> VLSpec) -> [Data] -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Data] -> VLSpec
VL.asSpec ([Data] -> Data) -> [Data] -> Data
forall a b. (a -> b) -> a -> b
$ [Data]
plotSpec] (Maybe Facet -> Bool
forall a. Maybe a -> Bool
isJust Maybe Facet
facet')
                 [Data] -> [Data] -> [Data]
forall a. Semigroup a => a -> a -> a
<> [Data] -> (Height -> [Data]) -> Maybe Height -> [Data]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(Height Double
x) -> [Double -> Data
VL.height Double
x]) Maybe Height
height'
                 [Data] -> [Data] -> [Data]
forall a. Semigroup a => a -> a -> a
<> [Data] -> (Width -> [Data]) -> Maybe Width -> [Data]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(Width Double
x) -> [Double -> Data
VL.width Double
x]) Maybe Width
width'
                 [Data] -> [Data] -> [Data]
forall a. Semigroup a => a -> a -> a
<> [Data] -> (Facet -> [Data]) -> Maybe Facet -> [Data]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Facet -> [Data]
facetSpec Maybe Facet
facet'
                 [Data] -> [Data] -> [Data]
forall a. Semigroup a => a -> a -> a
<> [Data] -> (FacetNum -> [Data]) -> Maybe FacetNum -> [Data]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(FacetNum Int
x) -> [Natural -> Data
VL.columns (Natural -> Data) -> Natural -> Data
forall a b. (a -> b) -> a -> b
$ Int -> Natural
intToNatural Int
x]) Maybe FacetNum
facetNum'
                 [Data] -> [Data] -> [Data]
forall a. Semigroup a => a -> a -> a
<> [Data] -> [Data] -> Bool -> [Data]
forall a. a -> a -> Bool -> a
bool [Config -> [ConfigureSpec] -> Data
VL.theme Config
VL.defaultConfig []] [] (DefaultTheme -> Bool
unDefaultTheme DefaultTheme
defaultTheme')

  IO () -> ReaderT Opts IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Opts IO ())
-> (Text -> IO ()) -> Text -> ReaderT Opts IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
output' (Text -> ReaderT Opts IO ()) -> Text -> ReaderT Opts IO ()
forall a b. (a -> b) -> a -> b
$ VegaLite -> Text
VL.toHtml VegaLite
p

  () -> ReaderT Opts IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()