{-# LANGUAGE DeriveGeneric, DerivingVia, DeriveAnyClass #-}
{- A dataframe is a strongly-typed, ordered list of named tuples. A dataframe differs from a relation in that its tuples are ordered.-}
module ProjectM36.DataFrame where
import ProjectM36.Base
import qualified ProjectM36.Attribute as A hiding (drop)
import ProjectM36.Error
import qualified ProjectM36.Relation as R
import ProjectM36.Relation.Show.Term
import qualified ProjectM36.Relation.Show.HTML as RelHTML
import ProjectM36.DataTypes.Sorting
import ProjectM36.AtomType
import ProjectM36.Atom
import qualified Data.Vector as V
import GHC.Generics
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.HashSet as HS
import Data.Hashable (Hashable)
import Data.Maybe
import qualified Data.Text as T
import Control.Arrow
import Control.Monad (unless)
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid
#endif

data AttributeOrderExpr = AttributeOrderExpr AttributeName Order
  deriving (Int -> AttributeOrderExpr -> ShowS
[AttributeOrderExpr] -> ShowS
AttributeOrderExpr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeOrderExpr] -> ShowS
$cshowList :: [AttributeOrderExpr] -> ShowS
show :: AttributeOrderExpr -> String
$cshow :: AttributeOrderExpr -> String
showsPrec :: Int -> AttributeOrderExpr -> ShowS
$cshowsPrec :: Int -> AttributeOrderExpr -> ShowS
Show, forall x. Rep AttributeOrderExpr x -> AttributeOrderExpr
forall x. AttributeOrderExpr -> Rep AttributeOrderExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeOrderExpr x -> AttributeOrderExpr
$cfrom :: forall x. AttributeOrderExpr -> Rep AttributeOrderExpr x
Generic, AttributeOrderExpr -> AttributeOrderExpr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeOrderExpr -> AttributeOrderExpr -> Bool
$c/= :: AttributeOrderExpr -> AttributeOrderExpr -> Bool
== :: AttributeOrderExpr -> AttributeOrderExpr -> Bool
$c== :: AttributeOrderExpr -> AttributeOrderExpr -> Bool
Eq)

data AttributeOrder = AttributeOrder AttributeName Order
  deriving (Int -> AttributeOrder -> ShowS
[AttributeOrder] -> ShowS
AttributeOrder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeOrder] -> ShowS
$cshowList :: [AttributeOrder] -> ShowS
show :: AttributeOrder -> String
$cshow :: AttributeOrder -> String
showsPrec :: Int -> AttributeOrder -> ShowS
$cshowsPrec :: Int -> AttributeOrder -> ShowS
Show, forall x. Rep AttributeOrder x -> AttributeOrder
forall x. AttributeOrder -> Rep AttributeOrder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeOrder x -> AttributeOrder
$cfrom :: forall x. AttributeOrder -> Rep AttributeOrder x
Generic, AttributeOrder -> AttributeOrder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeOrder -> AttributeOrder -> Bool
$c/= :: AttributeOrder -> AttributeOrder -> Bool
== :: AttributeOrder -> AttributeOrder -> Bool
$c== :: AttributeOrder -> AttributeOrder -> Bool
Eq)

data Order = AscendingOrder | DescendingOrder
  deriving (Order -> Order -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c== :: Order -> Order -> Bool
Eq, Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> String
$cshow :: Order -> String
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> Order -> ShowS
Show, forall x. Rep Order x -> Order
forall x. Order -> Rep Order x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Order x -> Order
$cfrom :: forall x. Order -> Rep Order x
Generic)

ascending :: T.Text
ascending :: Text
ascending = Text
"⬆"

descending :: T.Text
descending :: Text
descending = Text
"⬇"

arbitrary :: T.Text
arbitrary :: Text
arbitrary = Text
"↕"

data DataFrame = DataFrame {
  DataFrame -> [AttributeOrder]
orders :: [AttributeOrder],
  DataFrame -> Attributes
attributes :: Attributes,
  DataFrame -> [DataFrameTuple]
tuples :: [DataFrameTuple]
  }
  deriving (Int -> DataFrame -> ShowS
[DataFrame] -> ShowS
DataFrame -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataFrame] -> ShowS
$cshowList :: [DataFrame] -> ShowS
show :: DataFrame -> String
$cshow :: DataFrame -> String
showsPrec :: Int -> DataFrame -> ShowS
$cshowsPrec :: Int -> DataFrame -> ShowS
Show, forall x. Rep DataFrame x -> DataFrame
forall x. DataFrame -> Rep DataFrame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataFrame x -> DataFrame
$cfrom :: forall x. DataFrame -> Rep DataFrame x
Generic)

-- if there is no ordering, then compare sets of tuples
instance Eq DataFrame where
  DataFrame
dfA == :: DataFrame -> DataFrame -> Bool
== DataFrame
dfB =
    DataFrame -> Attributes
attributes DataFrame
dfA forall a. Eq a => a -> a -> Bool
== DataFrame -> Attributes
attributes DataFrame
dfB Bool -> Bool -> Bool
&&
    DataFrame -> [AttributeOrder]
orders DataFrame
dfA forall a. Eq a => a -> a -> Bool
== DataFrame -> [AttributeOrder]
orders DataFrame
dfB Bool -> Bool -> Bool
&&
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataFrame -> [AttributeOrder]
orders DataFrame
dfA) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataFrame -> [AttributeOrder]
orders DataFrame
dfB) then
      forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList (DataFrame -> [DataFrameTuple]
tuples DataFrame
dfA) forall a. Eq a => a -> a -> Bool
== forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList (DataFrame -> [DataFrameTuple]
tuples DataFrame
dfB)
      else
      DataFrame -> [DataFrameTuple]
tuples DataFrame
dfA forall a. Eq a => a -> a -> Bool
== DataFrame -> [DataFrameTuple]
tuples DataFrame
dfB

data DataFrameTuple = DataFrameTuple Attributes (V.Vector Atom)
  deriving (DataFrameTuple -> DataFrameTuple -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataFrameTuple -> DataFrameTuple -> Bool
$c/= :: DataFrameTuple -> DataFrameTuple -> Bool
== :: DataFrameTuple -> DataFrameTuple -> Bool
$c== :: DataFrameTuple -> DataFrameTuple -> Bool
Eq, Int -> DataFrameTuple -> ShowS
[DataFrameTuple] -> ShowS
DataFrameTuple -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataFrameTuple] -> ShowS
$cshowList :: [DataFrameTuple] -> ShowS
show :: DataFrameTuple -> String
$cshow :: DataFrameTuple -> String
showsPrec :: Int -> DataFrameTuple -> ShowS
$cshowsPrec :: Int -> DataFrameTuple -> ShowS
Show, forall x. Rep DataFrameTuple x -> DataFrameTuple
forall x. DataFrameTuple -> Rep DataFrameTuple x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataFrameTuple x -> DataFrameTuple
$cfrom :: forall x. DataFrameTuple -> Rep DataFrameTuple x
Generic, Eq DataFrameTuple
Int -> DataFrameTuple -> Int
DataFrameTuple -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: DataFrameTuple -> Int
$chash :: DataFrameTuple -> Int
hashWithSalt :: Int -> DataFrameTuple -> Int
$chashWithSalt :: Int -> DataFrameTuple -> Int
Hashable)

sortDataFrameBy :: [AttributeOrder] -> DataFrame -> Either RelationalError DataFrame
sortDataFrameBy :: [AttributeOrder] -> DataFrame -> Either RelationalError DataFrame
sortDataFrameBy [AttributeOrder]
attrOrders DataFrame
frame = do
  [Attribute]
attrs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(AttributeOrder Text
nam Order
_) -> Text -> Attributes -> Either RelationalError Attribute
A.attributeForName Text
nam (DataFrame -> Attributes
attributes DataFrame
frame)) [AttributeOrder]
attrOrders 
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Attribute
attr -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AtomType -> Bool
isSortableAtomType (Attribute -> AtomType
A.atomType Attribute
attr)) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (Attribute -> RelationalError
AttributeNotSortableError Attribute
attr)) [Attribute]
attrs
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [AttributeOrder] -> Attributes -> [DataFrameTuple] -> DataFrame
DataFrame [AttributeOrder]
attrOrders (DataFrame -> Attributes
attributes DataFrame
frame) ((DataFrameTuple -> DataFrameTuple -> Ordering)
-> [DataFrameTuple] -> [DataFrameTuple]
sortTuplesBy ([AttributeOrder] -> DataFrameTuple -> DataFrameTuple -> Ordering
compareTupleByAttributeOrders [AttributeOrder]
attrOrders) (DataFrame -> [DataFrameTuple]
tuples DataFrame
frame))

sortTuplesBy :: (DataFrameTuple -> DataFrameTuple -> Ordering) -> [DataFrameTuple] -> [DataFrameTuple]
sortTuplesBy :: (DataFrameTuple -> DataFrameTuple -> Ordering)
-> [DataFrameTuple] -> [DataFrameTuple]
sortTuplesBy = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy

compareTupleByAttributeOrders :: [AttributeOrder] -> DataFrameTuple -> DataFrameTuple -> Ordering
compareTupleByAttributeOrders :: [AttributeOrder] -> DataFrameTuple -> DataFrameTuple -> Ordering
compareTupleByAttributeOrders [AttributeOrder]
attributeOrders DataFrameTuple
tup1 DataFrameTuple
tup2 = 
  let compare' :: AttributeOrder -> Ordering
compare' (AttributeOrder Text
attr Order
order) = if Order
order forall a. Eq a => a -> a -> Bool
== Order
DescendingOrder 
        then Text -> DataFrameTuple -> DataFrameTuple -> Ordering
compareTupleByOneAttributeName Text
attr DataFrameTuple
tup2 DataFrameTuple
tup1
        else Text -> DataFrameTuple -> DataFrameTuple -> Ordering
compareTupleByOneAttributeName Text
attr DataFrameTuple
tup1 DataFrameTuple
tup2
      res :: [Ordering]
res = forall a b. (a -> b) -> [a] -> [b]
map AttributeOrder -> Ordering
compare' [AttributeOrder]
attributeOrders in
  forall a. a -> Maybe a -> a
fromMaybe Ordering
EQ (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
/= Ordering
EQ) [Ordering]
res)

compareTupleByOneAttributeName :: AttributeName -> DataFrameTuple -> DataFrameTuple -> Ordering
compareTupleByOneAttributeName :: Text -> DataFrameTuple -> DataFrameTuple -> Ordering
compareTupleByOneAttributeName Text
attr DataFrameTuple
tuple1 DataFrameTuple
tuple2 =
  let eAtom1 :: Either RelationalError Atom
eAtom1 = Text -> DataFrameTuple -> Either RelationalError Atom
atomForAttributeName Text
attr DataFrameTuple
tuple1
      eAtom2 :: Either RelationalError Atom
eAtom2 = Text -> DataFrameTuple -> Either RelationalError Atom
atomForAttributeName Text
attr DataFrameTuple
tuple2 in
  case Either RelationalError Atom
eAtom1 of
    Left RelationalError
err -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show RelationalError
err)
    Right Atom
atom1 ->
      case Either RelationalError Atom
eAtom2 of
        Left RelationalError
err -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show RelationalError
err)
        Right Atom
atom2 -> Atom -> Atom -> Ordering
compareAtoms Atom
atom1 Atom
atom2

atomForAttributeName :: AttributeName -> DataFrameTuple -> Either RelationalError Atom
atomForAttributeName :: Text -> DataFrameTuple -> Either RelationalError Atom
atomForAttributeName Text
attrName (DataFrameTuple Attributes
tupAttrs Vector Atom
tupVec) = case forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndex (\Attribute
attr -> Attribute -> Text
A.attributeName Attribute
attr forall a. Eq a => a -> a -> Bool
== Text
attrName) (Attributes -> Vector Attribute
attributesVec Attributes
tupAttrs) of
  Maybe Int
Nothing -> forall a b. a -> Either a b
Left (Set Text -> RelationalError
NoSuchAttributeNamesError (forall a. a -> Set a
S.singleton Text
attrName))
  Just Int
index -> case Vector Atom
tupVec forall a. Vector a -> Int -> Maybe a
V.!? Int
index of
    Maybe Atom
Nothing -> forall a b. a -> Either a b
Left (Set Text -> RelationalError
NoSuchAttributeNamesError (forall a. a -> Set a
S.singleton Text
attrName))
    Just Atom
atom -> forall a b. b -> Either a b
Right Atom
atom

take' :: Integer -> DataFrame -> DataFrame
take' :: Integer -> DataFrame -> DataFrame
take' Integer
n DataFrame
df = DataFrame
df { tuples :: [DataFrameTuple]
tuples = forall a. Int -> [a] -> [a]
take (forall a. Num a => Integer -> a
fromInteger Integer
n) (DataFrame -> [DataFrameTuple]
tuples DataFrame
df) }

drop' :: Integer -> DataFrame -> DataFrame
drop' :: Integer -> DataFrame -> DataFrame
drop' Integer
n DataFrame
df = DataFrame
df { tuples :: [DataFrameTuple]
tuples = forall a. Int -> [a] -> [a]
drop (forall a. Num a => Integer -> a
fromInteger Integer
n) (DataFrame -> [DataFrameTuple]
tuples DataFrame
df) }

toDataFrame :: Relation -> DataFrame
toDataFrame :: Relation -> DataFrame
toDataFrame (Relation Attributes
attrs (RelationTupleSet [RelationTuple]
tuples')) = [AttributeOrder] -> Attributes -> [DataFrameTuple] -> DataFrame
DataFrame [] Attributes
attrs (forall a b. (a -> b) -> [a] -> [b]
map (\(RelationTuple Attributes
tupAttrs Vector Atom
tupVec) -> Attributes -> Vector Atom -> DataFrameTuple
DataFrameTuple Attributes
tupAttrs Vector Atom
tupVec) [RelationTuple]
tuples')

fromDataFrame :: DataFrame -> Either RelationalError Relation 
fromDataFrame :: DataFrame -> Either RelationalError Relation
fromDataFrame DataFrame
df = Attributes -> RelationTupleSet -> Either RelationalError Relation
R.mkRelation (DataFrame -> Attributes
attributes DataFrame
df) ([RelationTuple] -> RelationTupleSet
RelationTupleSet [RelationTuple]
tuples')
  where
    tuples' :: [RelationTuple]
tuples' = forall a b. (a -> b) -> [a] -> [b]
map (\(DataFrameTuple Attributes
attrs' Vector Atom
tupVec) -> Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
attrs' Vector Atom
tupVec) (DataFrame -> [DataFrameTuple]
tuples DataFrame
df)

showDataFrame :: DataFrame -> T.Text
showDataFrame :: DataFrame -> Text
showDataFrame = Table -> Text
renderTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataFrame -> Table
dataFrameAsTable
  
--terminal display
dataFrameAsTable :: DataFrame -> Table
dataFrameAsTable :: DataFrame -> Table
dataFrameAsTable DataFrame
df = ([Text]
header, [[Text]]
body)
  where
    oAttrNames :: [Text]
oAttrNames = Attributes -> [Text]
A.orderedAttributeNames (DataFrame -> Attributes
attributes DataFrame
df)
    oAttrs :: [Attribute]
oAttrs = Attributes -> [Attribute]
A.orderedAttributes (DataFrame -> Attributes
attributes DataFrame
df)
    header :: [Text]
header = Text
"DF" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Text
dfPrettyAttribute [Attribute]
oAttrs
    dfPrettyAttribute :: Attribute -> Text
dfPrettyAttribute Attribute
attr = Attribute -> Text
prettyAttribute Attribute
attr forall a. Semigroup a => a -> a -> a
<> case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\(AttributeOrder Text
nam Order
_) -> Text
nam forall a. Eq a => a -> a -> Bool
== Attribute -> Text
A.attributeName Attribute
attr) (DataFrame -> [AttributeOrder]
orders DataFrame
df) of
      Maybe AttributeOrder
Nothing -> Text
arbitrary
      Just (AttributeOrder Text
_ Order
AscendingOrder) -> Text
ascending
      Just (AttributeOrder Text
_ Order
DescendingOrder) -> Text
descending
    body :: [[Text]]
body = forall a b. (a, b) -> b
snd (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' forall {a}.
(Num a, Show a) =>
(a, [[Text]]) -> DataFrameTuple -> (a, [[Text]])
tupleFolder (Int
1 :: Int,[]) (DataFrame -> [DataFrameTuple]
tuples DataFrame
df))
    tupleFolder :: (a, [[Text]]) -> DataFrameTuple -> (a, [[Text]])
tupleFolder (a
count, [[Text]]
acc) DataFrameTuple
tuple = (a
count forall a. Num a => a -> a -> a
+ a
1,
                                      [[Text]]
acc forall a. [a] -> [a] -> [a]
++ [String -> Text
T.pack (forall a. Show a => a -> String
show a
count) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\Text
attrName -> case Text -> DataFrameTuple -> Either RelationalError Atom
atomForAttributeName Text
attrName DataFrameTuple
tuple of
                                            Left RelationalError
_ -> Text
"?"
                                            Right Atom
atom -> Int -> Atom -> Text
showAtom Int
0 Atom
atom
                                            ) [Text]
oAttrNames])

-- | A Relation can be converted to a DataFrame for sorting, limits, and offsets.
data DataFrameExpr = DataFrameExpr {
  DataFrameExpr -> RelationalExpr
convertExpr :: RelationalExpr,
  DataFrameExpr -> [AttributeOrderExpr]
orderExprs :: [AttributeOrderExpr],
  DataFrameExpr -> Maybe Integer
offset :: Maybe Integer,
  DataFrameExpr -> Maybe Integer
limit :: Maybe Integer
  }
  deriving (Int -> DataFrameExpr -> ShowS
[DataFrameExpr] -> ShowS
DataFrameExpr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataFrameExpr] -> ShowS
$cshowList :: [DataFrameExpr] -> ShowS
show :: DataFrameExpr -> String
$cshow :: DataFrameExpr -> String
showsPrec :: Int -> DataFrameExpr -> ShowS
$cshowsPrec :: Int -> DataFrameExpr -> ShowS
Show, forall x. Rep DataFrameExpr x -> DataFrameExpr
forall x. DataFrameExpr -> Rep DataFrameExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataFrameExpr x -> DataFrameExpr
$cfrom :: forall x. DataFrameExpr -> Rep DataFrameExpr x
Generic, DataFrameExpr -> DataFrameExpr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataFrameExpr -> DataFrameExpr -> Bool
$c/= :: DataFrameExpr -> DataFrameExpr -> Bool
== :: DataFrameExpr -> DataFrameExpr -> Bool
$c== :: DataFrameExpr -> DataFrameExpr -> Bool
Eq)

-- | True iff dataframe features are required to execute this expression, False if this expression could be evaluated as a relational expression (no sorting, limit, or offset).
usesDataFrameFeatures :: DataFrameExpr -> Bool
usesDataFrameFeatures :: DataFrameExpr -> Bool
usesDataFrameFeatures DataFrameExpr
df = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataFrameExpr -> [AttributeOrderExpr]
orderExprs DataFrameExpr
df)) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (DataFrameExpr -> Maybe Integer
offset DataFrameExpr
df) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (DataFrameExpr -> Maybe Integer
limit DataFrameExpr
df)

-- | Returns a data frame expression without any sorting or limits.
nakedDataFrameExpr :: RelationalExpr -> DataFrameExpr
nakedDataFrameExpr :: RelationalExpr -> DataFrameExpr
nakedDataFrameExpr RelationalExpr
rexpr = DataFrameExpr { convertExpr :: RelationalExpr
convertExpr = RelationalExpr
rexpr,
                                           orderExprs :: [AttributeOrderExpr]
orderExprs = [],
                                           offset :: Maybe Integer
offset = forall a. Maybe a
Nothing,
                                           limit :: Maybe Integer
limit = forall a. Maybe a
Nothing }

dataFrameAsHTML :: DataFrame -> T.Text
-- web browsers don't display tables with empty cells or empty headers, so we have to insert some placeholders- it's not technically the same, but looks as expected in the browser
dataFrameAsHTML :: DataFrame -> Text
dataFrameAsHTML DataFrame
df 
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length (DataFrame -> [DataFrameTuple]
tuples DataFrame
df) forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Attributes -> Bool
A.null (DataFrame -> Attributes
attributes DataFrame
df) = Text
style forall a. Semigroup a => a -> a -> a
<>
                          Text
tablestart forall a. Semigroup a => a -> a -> a
<>
                          Text
"<tr><th></th></tr>" forall a. Semigroup a => a -> a -> a
<>
                          Text
"<tr><td></td></tr>" forall a. Semigroup a => a -> a -> a
<> 
                          Text
tablefooter forall a. Semigroup a => a -> a -> a
<> Text
"</table>"
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null (DataFrame -> [DataFrameTuple]
tuples DataFrame
df) Bool -> Bool -> Bool
&& Attributes -> Bool
A.null (DataFrame -> Attributes
attributes DataFrame
df) = Text
style forall a. Semigroup a => a -> a -> a
<>
                           Text
tablestart forall a. Semigroup a => a -> a -> a
<>
                           Text
"<tr><th></th></tr>" forall a. Semigroup a => a -> a -> a
<>
                           Text
tablefooter forall a. Semigroup a => a -> a -> a
<> 
                           Text
"</table>"
  | Bool
otherwise = Text
style forall a. Semigroup a => a -> a -> a
<>
                Text
tablestart forall a. Semigroup a => a -> a -> a
<> 
                Attributes -> [AttributeOrder] -> Text
attributesAsHTML (DataFrame -> Attributes
attributes DataFrame
df) (DataFrame -> [AttributeOrder]
orders DataFrame
df) forall a. Semigroup a => a -> a -> a
<> 
                [DataFrameTuple] -> Text
tuplesAsHTML (DataFrame -> [DataFrameTuple]
tuples DataFrame
df) forall a. Semigroup a => a -> a -> a
<> 
                Text
tablefooter forall a. Semigroup a => a -> a -> a
<> 
                Text
"</table>"
  where
    cardinality :: Text
cardinality = String -> Text
T.pack (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length (DataFrame -> [DataFrameTuple]
tuples DataFrame
df)))
    style :: Text
style = Text
"<style>.pm36dataframe {empty-cells: show;} .pm36dataframe tbody td, .pm36relation th { border: 1px solid black;}</style>"
    tablefooter :: Text
tablefooter = Text
"<tfoot><tr><td colspan=\"100%\">" forall a. Semigroup a => a -> a -> a
<> Text
cardinality forall a. Semigroup a => a -> a -> a
<> Text
" tuples</td></tr></tfoot>"
    tablestart :: Text
tablestart = Text
"<table class=\"pm36dataframe\"\">"

tuplesAsHTML :: [DataFrameTuple] -> T.Text
tuplesAsHTML :: [DataFrameTuple] -> Text
tuplesAsHTML = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DataFrameTuple -> Text -> Text
folder Text
""
  where
    folder :: DataFrameTuple -> Text -> Text
folder DataFrameTuple
tuple Text
acc = Text
acc forall a. Semigroup a => a -> a -> a
<> DataFrameTuple -> Text
tupleAsHTML DataFrameTuple
tuple

tupleAssocs :: DataFrameTuple -> [(AttributeName, Atom)]
tupleAssocs :: DataFrameTuple -> [(Text, Atom)]
tupleAssocs (DataFrameTuple Attributes
attrs Vector Atom
tupVec) = forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Vector a -> Vector b
V.map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Attribute -> Text
A.attributeName) (forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip (Attributes -> Vector Attribute
attributesVec Attributes
attrs) Vector Atom
tupVec)
    

tupleAsHTML :: DataFrameTuple -> T.Text
tupleAsHTML :: DataFrameTuple -> Text
tupleAsHTML DataFrameTuple
tuple = Text
"<tr>" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat (forall a b. (a -> b) -> [a] -> [b]
L.map forall {a}. (a, Atom) -> Text
tupleFrag (DataFrameTuple -> [(Text, Atom)]
tupleAssocs DataFrameTuple
tuple)) forall a. Semigroup a => a -> a -> a
<> Text
"</tr>"
  where
    tupleFrag :: (a, Atom) -> Text
tupleFrag (a, Atom)
tup = Text
"<td>" forall a. Semigroup a => a -> a -> a
<> Atom -> Text
atomAsHTML (forall a b. (a, b) -> b
snd (a, Atom)
tup) forall a. Semigroup a => a -> a -> a
<> Text
"</td>"
    atomAsHTML :: Atom -> Text
atomAsHTML (RelationAtom Relation
rel) = Relation -> Text
RelHTML.relationAsHTML Relation
rel
    atomAsHTML (TextAtom Text
t) = Text
"&quot;" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"&quot;"
    atomAsHTML Atom
atom = Atom -> Text
atomToText Atom
atom

attributesAsHTML :: Attributes -> [AttributeOrder] -> T.Text
attributesAsHTML :: Attributes -> [AttributeOrder] -> Text
attributesAsHTML Attributes
attrs [AttributeOrder]
orders' = Text
"<tr>" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat (forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Text
oneAttrHTML (Attributes -> [Attribute]
A.toList Attributes
attrs)) forall a. Semigroup a => a -> a -> a
<> Text
"</tr>"
  where
    oneAttrHTML :: Attribute -> Text
oneAttrHTML Attribute
attr = Text
"<th>" forall a. Semigroup a => a -> a -> a
<> Attribute -> Text
prettyAttribute Attribute
attr forall a. Semigroup a => a -> a -> a
<> forall {a}. (Semigroup a, IsString a) => Text -> a
ordering (Attribute -> Text
A.attributeName Attribute
attr) forall a. Semigroup a => a -> a -> a
<> Text
"</th>"
    ordering :: Text -> a
ordering Text
attrName = a
" " forall a. Semigroup a => a -> a -> a
<> case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\(AttributeOrder Text
nam Order
_) -> Text
nam forall a. Eq a => a -> a -> Bool
== Text
attrName) [AttributeOrder]
orders' of
      Maybe AttributeOrder
Nothing -> a
"(arb)"
      Just (AttributeOrder Text
_ Order
AscendingOrder) -> a
"(asc)"
      Just (AttributeOrder Text
_ Order
DescendingOrder) -> a
"(desc)"