{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
module Ploterific.Plot.Plot
( plot
, labelColorScale
) where
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
import Ploterific.Plot.Types
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
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
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
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) }
)
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))
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
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]
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 ()