{-# LANGUAGE DeriveGeneric, DerivingVia #-}
{- 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 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 Data.Maybe
import qualified Data.Text as T
import Control.Arrow
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid
#endif

data AttributeOrderExpr = AttributeOrderExpr AttributeName Order
  deriving (Int -> AttributeOrderExpr -> ShowS
[AttributeOrderExpr] -> ShowS
AttributeOrderExpr -> String
(Int -> AttributeOrderExpr -> ShowS)
-> (AttributeOrderExpr -> String)
-> ([AttributeOrderExpr] -> ShowS)
-> Show AttributeOrderExpr
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. AttributeOrderExpr -> Rep AttributeOrderExpr x)
-> (forall x. Rep AttributeOrderExpr x -> AttributeOrderExpr)
-> Generic AttributeOrderExpr
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)

data AttributeOrder = AttributeOrder AttributeName Order
  deriving (Int -> AttributeOrder -> ShowS
[AttributeOrder] -> ShowS
AttributeOrder -> String
(Int -> AttributeOrder -> ShowS)
-> (AttributeOrder -> String)
-> ([AttributeOrder] -> ShowS)
-> Show AttributeOrder
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. AttributeOrder -> Rep AttributeOrder x)
-> (forall x. Rep AttributeOrder x -> AttributeOrder)
-> Generic AttributeOrder
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)

data Order = AscendingOrder | DescendingOrder
  deriving (Order -> Order -> Bool
(Order -> Order -> Bool) -> (Order -> Order -> Bool) -> Eq Order
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
(Int -> Order -> ShowS)
-> (Order -> String) -> ([Order] -> ShowS) -> Show Order
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. Order -> Rep Order x)
-> (forall x. Rep Order x -> Order) -> Generic Order
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
(Int -> DataFrame -> ShowS)
-> (DataFrame -> String)
-> ([DataFrame] -> ShowS)
-> Show DataFrame
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. DataFrame -> Rep DataFrame x)
-> (forall x. Rep DataFrame x -> DataFrame) -> Generic DataFrame
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)

data DataFrameTuple = DataFrameTuple Attributes (V.Vector Atom)
  deriving (DataFrameTuple -> DataFrameTuple -> Bool
(DataFrameTuple -> DataFrameTuple -> Bool)
-> (DataFrameTuple -> DataFrameTuple -> Bool) -> Eq DataFrameTuple
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
(Int -> DataFrameTuple -> ShowS)
-> (DataFrameTuple -> String)
-> ([DataFrameTuple] -> ShowS)
-> Show DataFrameTuple
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. DataFrameTuple -> Rep DataFrameTuple x)
-> (forall x. Rep DataFrameTuple x -> DataFrameTuple)
-> Generic DataFrameTuple
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)

sortDataFrameBy :: [AttributeOrder] -> DataFrame -> Either RelationalError DataFrame
sortDataFrameBy :: [AttributeOrder] -> DataFrame -> Either RelationalError DataFrame
sortDataFrameBy [AttributeOrder]
attrOrders DataFrame
frame = do
  [Attribute]
attrs <- (AttributeOrder -> Either RelationalError Attribute)
-> [AttributeOrder] -> Either RelationalError [Attribute]
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 
  (Attribute -> Either RelationalError ())
-> [Attribute] -> Either RelationalError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Attribute
attr -> if Bool -> Bool
not (AtomType -> Bool
isSortableAtomType (Attribute -> AtomType
atomType Attribute
attr)) then
            RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (Attribute -> RelationalError
AttributeNotSortableError Attribute
attr)
            else
            () -> Either RelationalError ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) [Attribute]
attrs
  DataFrame -> Either RelationalError DataFrame
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataFrame -> Either RelationalError DataFrame)
-> DataFrame -> Either RelationalError DataFrame
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 = (DataFrameTuple -> DataFrameTuple -> Ordering)
-> [DataFrameTuple] -> [DataFrameTuple]
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 Order -> Order -> Bool
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 = (AttributeOrder -> Ordering) -> [AttributeOrder] -> [Ordering]
forall a b. (a -> b) -> [a] -> [b]
map AttributeOrder -> Ordering
compare' [AttributeOrder]
attributeOrders in
  Ordering -> Maybe Ordering -> Ordering
forall a. a -> Maybe a -> a
fromMaybe Ordering
EQ ((Ordering -> Bool) -> [Ordering] -> Maybe Ordering
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Ordering -> Ordering -> Bool
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 -> String -> Ordering
forall a. HasCallStack => String -> a
error (RelationalError -> String
forall a. Show a => a -> String
show RelationalError
err)
    Right Atom
atom1 ->
      case Either RelationalError Atom
eAtom2 of
        Left RelationalError
err -> String -> Ordering
forall a. HasCallStack => String -> a
error (RelationalError -> String
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 (Attribute -> Bool) -> Vector Attribute -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndex (\Attribute
attr -> Attribute -> Text
attributeName Attribute
attr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
attrName) (Attributes -> Vector Attribute
attributesVec Attributes
tupAttrs) of
  Maybe Int
Nothing -> RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left (Set Text -> RelationalError
NoSuchAttributeNamesError (Text -> Set Text
forall a. a -> Set a
S.singleton Text
attrName))
  Just Int
index -> case Vector Atom
tupVec Vector Atom -> Int -> Maybe Atom
forall a. Vector a -> Int -> Maybe a
V.!? Int
index of
    Maybe Atom
Nothing -> RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left (Set Text -> RelationalError
NoSuchAttributeNamesError (Text -> Set Text
forall a. a -> Set a
S.singleton Text
attrName))
    Just Atom
atom -> Atom -> Either RelationalError 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 = Int -> [DataFrameTuple] -> [DataFrameTuple]
forall a. Int -> [a] -> [a]
take (Integer -> Int
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 = Int -> [DataFrameTuple] -> [DataFrameTuple]
forall a. Int -> [a] -> [a]
drop (Integer -> Int
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 ((RelationTuple -> DataFrameTuple)
-> [RelationTuple] -> [DataFrameTuple]
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' = (DataFrameTuple -> RelationTuple)
-> [DataFrameTuple] -> [RelationTuple]
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 (Table -> Text) -> (DataFrame -> Table) -> DataFrame -> Text
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]
orderedAttributeNames (DataFrame -> Attributes
attributes DataFrame
df)
    oAttrs :: [Attribute]
oAttrs = Attributes -> [Attribute]
orderedAttributes (DataFrame -> Attributes
attributes DataFrame
df)
    header :: [Text]
header = Text
"DF" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Attribute -> Text) -> [Attribute] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Text
dfPrettyAttribute [Attribute]
oAttrs
    dfPrettyAttribute :: Attribute -> Text
dfPrettyAttribute Attribute
attr = Attribute -> Text
prettyAttribute Attribute
attr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case (AttributeOrder -> Bool)
-> [AttributeOrder] -> Maybe AttributeOrder
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\(AttributeOrder Text
nam Order
_) -> Text
nam Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Attribute -> Text
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 = (Int, [[Text]]) -> [[Text]]
forall a b. (a, b) -> b
snd (((Int, [[Text]]) -> DataFrameTuple -> (Int, [[Text]]))
-> (Int, [[Text]]) -> [DataFrameTuple] -> (Int, [[Text]])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (Int, [[Text]]) -> DataFrameTuple -> (Int, [[Text]])
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 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1,
                                      [[Text]]
acc [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
++ [String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
count) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
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
(Int -> DataFrameExpr -> ShowS)
-> (DataFrameExpr -> String)
-> ([DataFrameExpr] -> ShowS)
-> Show DataFrameExpr
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. DataFrameExpr -> Rep DataFrameExpr x)
-> (forall x. Rep DataFrameExpr x -> DataFrameExpr)
-> Generic DataFrameExpr
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)

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 
  | [DataFrameTuple] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (DataFrame -> [DataFrameTuple]
tuples DataFrame
df) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Attributes -> Bool
A.null (DataFrame -> Attributes
attributes DataFrame
df) = Text
style Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                          Text
tablestart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                          Text
"<tr><th></th></tr>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                          Text
"<tr><td></td></tr>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 
                          Text
tablefooter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</table>"
  | [DataFrameTuple] -> Bool
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           Text
tablestart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           Text
"<tr><th></th></tr>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           Text
tablefooter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 
                           Text
"</table>"
  | Bool
otherwise = Text
style Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text
tablestart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 
                Attributes -> [AttributeOrder] -> Text
attributesAsHTML (DataFrame -> Attributes
attributes DataFrame
df) (DataFrame -> [AttributeOrder]
orders DataFrame
df) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 
                [DataFrameTuple] -> Text
tuplesAsHTML (DataFrame -> [DataFrameTuple]
tuples DataFrame
df) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 
                Text
tablefooter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 
                Text
"</table>"
  where
    cardinality :: Text
cardinality = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show ([DataFrameTuple] -> Int
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%\">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cardinality Text -> Text -> Text
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 = (DataFrameTuple -> Text -> Text)
-> Text -> [DataFrameTuple] -> Text
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 Text -> Text -> Text
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) = Vector (Text, Atom) -> [(Text, Atom)]
forall a. Vector a -> [a]
V.toList (Vector (Text, Atom) -> [(Text, Atom)])
-> Vector (Text, Atom) -> [(Text, Atom)]
forall a b. (a -> b) -> a -> b
$ ((Attribute, Atom) -> (Text, Atom))
-> Vector (Attribute, Atom) -> Vector (Text, Atom)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((Attribute -> Text) -> (Attribute, Atom) -> (Text, Atom)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Attribute -> Text
attributeName) (Vector Attribute -> Vector Atom -> Vector (Attribute, Atom)
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>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat (((Text, Atom) -> Text) -> [(Text, Atom)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
L.map (Text, Atom) -> Text
forall a. (a, Atom) -> Text
tupleFrag (DataFrameTuple -> [(Text, Atom)]
tupleAssocs DataFrameTuple
tuple)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</tr>"
  where
    tupleFrag :: (a, Atom) -> Text
tupleFrag (a, Atom)
tup = Text
"<td>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Atom -> Text
atomAsHTML ((a, Atom) -> Atom
forall a b. (a, b) -> b
snd (a, Atom)
tup) Text -> Text -> Text
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;" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
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>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat ((Attribute -> Text) -> [Attribute] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Text
oneAttrHTML (Attributes -> [Attribute]
A.toList Attributes
attrs)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</tr>"
  where
    oneAttrHTML :: Attribute -> Text
oneAttrHTML Attribute
attr = Text
"<th>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Attribute -> Text
prettyAttribute Attribute
attr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. (Semigroup a, IsString a) => Text -> a
ordering (Attribute -> Text
attributeName Attribute
attr) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</th>"
    ordering :: Text -> a
ordering Text
attrName = a
" " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> case (AttributeOrder -> Bool)
-> [AttributeOrder] -> Maybe AttributeOrder
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\(AttributeOrder Text
nam Order
_) -> Text
nam Text -> Text -> Bool
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)"