{-# LANGUAGE FlexibleInstances, OverloadedStrings, FlexibleContexts #-}

{-|
Module      : VizHaskell.TreeRepresentation
Description : Representation of all the types that can be shown as a tree.

This module defines the 'TreeRepresentation' class, with allows one to define
a data type as being representable by a tree.
-}
module VizHaskell.TreeRepresentation(
        TreeRepresentable(..),
        RepresentationTree(..)
      ) where

import VizHaskell.Core
import Data.Aeson
import Data.Aeson.Types(Pair)
import Data.String
import qualified Data.Text
import qualified Data.Vector as V


{-|
  Class defining all the datatypes that may be represented
  as a tree.
-}
class TreeRepresentable t where
  {-|
    It returns the contents of a node.
  -}
  contents  :: t b -> Maybe b

  {-|
    It returns the children of a node.
  -}
  children  :: t b -> [t b]
  {-|
    Additional info attached to the given node.
    Unless explicitly overwritten by concrete representations,
    it defaults to @Nothing@.
  -}
  label     :: t b -> Maybe String
  {-|
    CSS style being applied to the
    given node. Unless explicitly overwritten by concrete representations,
    it defaults to @Nothing@.
  -}
  className :: t b -> Maybe String

  label     _ = Nothing
  className _ = Nothing


{-|
  This representation type specifies that the value associated with
  this representation (see 'VizHaskell.Core.RPair') must be shown as
  a tree. It receives another representation type, which refers to
  the representation type of the values contained within the nodes.
-}
data RepresentationTree rep = RepresentationTree rep

instance Representation rep => Representation (RepresentationTree rep)

{-|
  All the types implementing 'TreeRepresentable' are representable with
  a 'RepresentationTree', provided their nodes are also representable.
-}
instance (TreeRepresentable t, Representation rep, VizRepresentable (RPair rep b))
    => VizRepresentable (RPair (RepresentationTree rep) (t b)) where
    vizToJSON rpair =
      case contents repValue of
        Nothing -> object [ "value" .= object [] , "children" .= Array (V.empty), "repType" .= String "tree"]
        Just val -> object ([
                             "repType" .= String "tree",
                             "value" .= vizToJSON (buildRPair repNodes val),
                             "children" .= Array (V.fromList
                                (map (vizToJSON . buildRPair rep) (children repValue)))
                            ] ++ showIfMaybe "label" (label repValue)
                              ++ showIfMaybe "className" (className repValue))
      where rep@(RepresentationTree repNodes) = rPairRepresentation rpair
            repValue = rPairValue rpair
            showIfMaybe :: Data.Text.Text -> Maybe String -> [Pair]
            showIfMaybe attr Nothing = []
            showIfMaybe attr (Just str) = [attr .= String (fromString str)]
