{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Graphics.Vega.VegaLite.Input
( Data
, DataColumn
, DataRow
, Format(..)
, DataType(..)
, dataFromUrl
, dataFromColumns
, dataFromRows
, dataFromJson
, dataFromSource
, dataName
, datasets
, dataColumn
, dataRow
, noData
, dataSequence
, dataSequenceAs
) where
import qualified Data.Aeson as A
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Control.Arrow (second)
import Data.Aeson ((.=), Value, decode, encode, object, toJSON)
import Data.Aeson.Types (Pair)
import Data.Maybe (fromMaybe, mapMaybe)
#if !(MIN_VERSION_base(4, 12, 0))
import Data.Monoid ((<>))
#endif
import Graphics.Vega.VegaLite.Data
( DataValue(..)
, DataValues(..)
, dataValueSpec
)
import Graphics.Vega.VegaLite.Foundation
( FieldName
, toObject
)
import Graphics.Vega.VegaLite.Specification
( VLProperty(VLData, VLDatasets)
, VLSpec
, LabelledSpec
)
import Graphics.Vega.VegaLite.Time (dateTimeSpec)
data DataType
= FoNumber
| FoBoolean
| FoDate T.Text
| FoUtc T.Text
data Format
= JSON T.Text
| CSV
| TSV
| DSV Char
| TopojsonFeature T.Text
| TopojsonMesh T.Text
| Parse [(FieldName, DataType)]
type DataColumn = [LabelledSpec]
type DataRow = VLSpec
type Data = (VLProperty, VLSpec)
formatProperty :: Format -> [Pair]
formatProperty :: Format -> [Pair]
formatProperty (JSON Text
js) =
let ps :: [(Key, Text)]
ps = [(Key
"type", Text
"json")]
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null (Text -> Text
T.strip Text
js) then [] else [(Key
"property", Text
js)]
in forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. ToJSON a => a -> Value
toJSON) [(Key, Text)]
ps
formatProperty Format
CSV = [(Key
"type", Value
"csv")]
formatProperty Format
TSV = [(Key
"type", Value
"tsv")]
formatProperty (DSV Char
delim) = [(Key
"type", Value
"dsv"), Key
"delimiter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Char
delim]
formatProperty (TopojsonFeature Text
os) = [(Key
"type", Value
"topojson")
, Key
"feature" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
os
]
formatProperty (TopojsonMesh Text
os) = [(Key
"type", Value
"topojson")
, Key
"mesh" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
os
]
formatProperty (Parse [(Text, DataType)]
fmts) =
let pObj :: Value
pObj = [LabelledSpec] -> Value
toObject (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second DataType -> Value
dataTypeSpec) [(Text, DataType)]
fmts)
in [(Key
"parse", Value
pObj)]
dataTypeSpec :: DataType -> VLSpec
dataTypeSpec :: DataType -> Value
dataTypeSpec DataType
dType =
let s :: Text
s = case DataType
dType of
DataType
FoNumber -> Text
"number"
DataType
FoBoolean -> Text
"boolean"
FoDate Text
fmt | Text -> Bool
T.null Text
fmt -> Text
"date"
| Bool
otherwise -> Text
"date:'" forall a. Semigroup a => a -> a -> a
<> Text
fmt forall a. Semigroup a => a -> a -> a
<> Text
"'"
FoUtc Text
fmt | Text -> Bool
T.null Text
fmt -> Text
"utc"
| Bool
otherwise -> Text
"utc:'" forall a. Semigroup a => a -> a -> a
<> Text
fmt forall a. Semigroup a => a -> a -> a
<> Text
"'"
in forall a. ToJSON a => a -> Value
toJSON Text
s
dataRow :: [(FieldName, DataValue)] -> [DataRow] -> [DataRow]
dataRow :: [(Text, DataValue)] -> [Value] -> [Value]
dataRow [(Text, DataValue)]
rw = ([LabelledSpec] -> Value
toObject (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second DataValue -> Value
dataValueSpec) [(Text, DataValue)]
rw) forall a. a -> [a] -> [a]
:)
datasets :: [(T.Text, Data)] -> Data
datasets :: [(Text, Data)] -> Data
datasets [(Text, Data)]
namedData =
let converted :: (a, Value) -> Value
converted = Value -> Value
extract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
specs :: [LabelledSpec]
specs = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall {a}. (a, Value) -> Value
converted) [(Text, Data)]
namedData
convert :: Value -> Maybe [(T.Text, Value)]
convert :: Value -> Maybe [LabelledSpec]
convert Value
v = forall k v. HashMap k v -> [(k, v)]
HM.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => ByteString -> Maybe a
decode (forall a. ToJSON a => a -> ByteString
encode Value
v)
extract :: Value -> Value
extract Value
din =
let extract' :: [(a, a)] -> Maybe a
extract' [(a
_, a
v)] = forall a. a -> Maybe a
Just a
v
extract' [(a, a)]
_ = forall a. Maybe a
Nothing
in forall a. a -> Maybe a -> a
fromMaybe Value
din (Value -> Maybe [LabelledSpec]
convert Value
din forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {a}. [(a, a)] -> Maybe a
extract')
in (VLProperty
VLDatasets, [LabelledSpec] -> Value
toObject [LabelledSpec]
specs)
noData :: Data
noData :: Data
noData = (VLProperty
VLData, Value
A.Null)
dataName ::
T.Text
-> Data
-> Data
dataName :: Text -> Data -> Data
dataName Text
s odata :: Data
odata@(VLProperty
_, Value
dataSpec) =
let converted :: Maybe Pair
converted = Maybe [Pair]
convert forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. [a] -> Maybe a
extract
convert :: Maybe [Pair]
convert :: Maybe [Pair]
convert = forall k v. HashMap k v -> [(k, v)]
HM.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => ByteString -> Maybe a
decode (forall a. ToJSON a => a -> ByteString
encode Value
dataSpec)
extract :: [a] -> Maybe a
extract [a
v] = forall a. a -> Maybe a
Just a
v
extract [a]
_ = forall a. Maybe a
Nothing
in case Maybe Pair
converted of
Just Pair
v -> (VLProperty
VLData, [Pair] -> Value
object [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s, Pair
v ])
Maybe Pair
_ -> Data
odata
dataFromColumns ::
[Format]
-> [DataColumn]
-> Data
dataFromColumns :: [Format] -> [[LabelledSpec]] -> Data
dataFromColumns [Format]
fmts [[LabelledSpec]]
cols =
let dataArray :: [Value]
dataArray = forall a b. (a -> b) -> [a] -> [b]
map [LabelledSpec] -> Value
toObject (forall a. [[a]] -> [[a]]
transpose [[LabelledSpec]]
cols)
vals :: [Pair]
vals = [(Key
"values", forall a. ToJSON a => a -> Value
toJSON [Value]
dataArray)]
forall a. Semigroup a => a -> a -> a
<> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Format]
fmts
then []
else [(Key
"format", forall a. ToJSON a => a -> Value
toJSON Value
fmtObject)]
fmtObject :: Value
fmtObject = [Pair] -> Value
object (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Format -> [Pair]
formatProperty [Format]
fmts)
in (VLProperty
VLData, [Pair] -> Value
object [Pair]
vals)
transpose :: [[a]] -> [[a]]
transpose :: forall a. [[a]] -> [[a]]
transpose [] = []
transpose ([]:[[a]]
xss) = forall a. [[a]] -> [[a]]
transpose [[a]]
xss
transpose ((a
x:[a]
xs) : [[a]]
xss) =
let heads :: [a]
heads = forall {a} {b}. (a -> Maybe b) -> [a] -> [b]
filterMap forall {a}. [a] -> Maybe a
elmHead [[a]]
xss
tails :: [[a]]
tails = forall {a} {b}. (a -> Maybe b) -> [a] -> [b]
filterMap forall {a}. [a] -> Maybe [a]
elmTail [[a]]
xss
elmHead :: [a] -> Maybe a
elmHead (a
h:[a]
_) = forall a. a -> Maybe a
Just a
h
elmHead [] = forall a. Maybe a
Nothing
elmTail :: [a] -> Maybe [a]
elmTail [] = forall a. Maybe a
Nothing
elmTail (a
_:[a]
ts) = forall a. a -> Maybe a
Just [a]
ts
filterMap :: (a -> Maybe b) -> [a] -> [b]
filterMap = forall {a} {b}. (a -> Maybe b) -> [a] -> [b]
mapMaybe
in (a
x forall a. a -> [a] -> [a]
: [a]
heads) forall a. a -> [a] -> [a]
: forall a. [[a]] -> [[a]]
transpose ([a]
xs forall a. a -> [a] -> [a]
: [[a]]
tails)
dataFromJson :: VLSpec -> [Format] -> Data
dataFromJson :: Value -> [Format] -> Data
dataFromJson Value
vlspec [Format]
fmts =
let js :: Value
js = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Format]
fmts
then [Pair] -> Value
object [(Key
"values", Value
vlspec)]
else [Pair] -> Value
object [ (Key
"values", Value
vlspec)
, (Key
"format",
[Pair] -> Value
object (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Format -> [Pair]
formatProperty [Format]
fmts)) ]
in (VLProperty
VLData, Value
js)
dataColumn :: FieldName -> DataValues -> [DataColumn] -> [DataColumn]
dataColumn :: Text -> DataValues -> [[LabelledSpec]] -> [[LabelledSpec]]
dataColumn Text
colName DataValues
dVals [[LabelledSpec]]
xs =
let col :: [Value]
col = case DataValues
dVals of
Booleans [Bool]
cs -> forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
toJSON [Bool]
cs
DateTimes [[DateTime]]
cs -> forall a b. (a -> b) -> [a] -> [b]
map [DateTime] -> Value
dateTimeSpec [[DateTime]]
cs
Numbers [Double]
cs -> forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
toJSON [Double]
cs
Strings [Text]
cs -> forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
toJSON [Text]
cs
x :: [LabelledSpec]
x = forall a b. (a -> b) -> [a] -> [b]
map (Text
colName,) [Value]
col
in [LabelledSpec]
x forall a. a -> [a] -> [a]
: [[LabelledSpec]]
xs
dataFromRows ::
[Format]
-> [DataRow]
-> Data
dataFromRows :: [Format] -> [Value] -> Data
dataFromRows [Format]
fmts [Value]
rows =
let kvs :: [Pair]
kvs = (Key
"values", forall a. ToJSON a => a -> Value
toJSON [Value]
rows)
forall a. a -> [a] -> [a]
: if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Format]
fmts
then []
else [(Key
"format", [Pair] -> Value
object (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Format -> [Pair]
formatProperty [Format]
fmts))]
in (VLProperty
VLData, [Pair] -> Value
object [Pair]
kvs)
dataFromSource :: T.Text -> [Format] -> Data
dataFromSource :: Text -> [Format] -> Data
dataFromSource Text
sourceName [Format]
fmts =
let kvs :: [Pair]
kvs = (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
sourceName)
forall a. a -> [a] -> [a]
: if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Format]
fmts
then []
else [(Key
"format", [Pair] -> Value
object (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Format -> [Pair]
formatProperty [Format]
fmts))]
in (VLProperty
VLData, [Pair] -> Value
object [Pair]
kvs)
dataFromUrl :: T.Text -> [Format] -> Data
dataFromUrl :: Text -> [Format] -> Data
dataFromUrl Text
url [Format]
fmts =
let kvs :: [Pair]
kvs = (Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
url)
forall a. a -> [a] -> [a]
: if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Format]
fmts
then []
else [(Key
"format", [Pair] -> Value
object (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Format -> [Pair]
formatProperty [Format]
fmts))]
in (VLProperty
VLData, [Pair] -> Value
object [Pair]
kvs)
dataSequence ::
Double
-> Double
-> Double
-> Data
dataSequence :: Double -> Double -> Double -> Data
dataSequence Double
start Double
stop Double
step =
let vals :: [Pair]
vals = [(Key
"sequence", [Pair] -> Value
object [Pair]
svals)]
svals :: [Pair]
svals = [ Key
"start" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
start
, Key
"stop" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
stop
, Key
"step" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
step
]
in (VLProperty
VLData, [Pair] -> Value
object [Pair]
vals)
dataSequenceAs ::
Double
-> Double
-> Double
-> FieldName
-> Data
dataSequenceAs :: Double -> Double -> Double -> Text -> Data
dataSequenceAs Double
start Double
stop Double
step Text
outName =
let vals :: [Pair]
vals = [ Key
"sequence" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
svals ]
svals :: [Pair]
svals = [ Key
"start" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
start
, Key
"stop" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
stop
, Key
"step" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
step
, Key
"as" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
outName
]
in (VLProperty
VLData, [Pair] -> Value
object [Pair]
vals)