{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# language ConstraintKinds #-}
{-# language DeriveAnyClass #-}
{-# language GADTs #-}
{-# language LambdaCase #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# options_ghc -Wno-unused-imports #-}
{-# options_ghc -Wno-unused-top-binds #-}
module Core.Data.Frame.PrettyPrint where

import Data.Proxy (Proxy)
import qualified GHC.Generics as G
import qualified Data.Foldable as F (foldl', foldlM)

import Data.Foldable (Foldable(..))
import Data.Function (on)
import Data.List (filter, sortBy, groupBy, intersperse)

-- boxes
import Text.PrettyPrint.Boxes (Box, Alignment, emptyBox, nullBox, vcat, hcat, vsep, hsep, text, para, punctuateH, render, printBox, (<>), (<+>), (//), (/+/), top, left, right, center1, center2, rows, cols, moveDown)

-- import qualified Data.Text as T
-- containers
import qualified Data.Map as M
import Data.Sequence (Seq, (|>), (<|))
-- generic-trie
import qualified Data.GenericTrie as GT
-- generics-sop
import Generics.SOP (All, HasDatatypeInfo(..), datatypeInfo, DatatypeName, datatypeName, DatatypeInfo(..), FieldInfo(..), FieldName, fieldName, ConstructorInfo(..), constructorInfo, ConstructorName, constructorName, All(..), All2, hcliftA, hcliftA2, hliftA, hcmap, Proxy(..), SOP(..), NP(..), I(..), K(..), unK, mapIK, hcollapse, SListI, hcpure)
import Generics.SOP.NP (cpure_NP)
-- import Generics.SOP.Constraint (SListIN)
import Generics.SOP.GGP (GCode, GDatatypeInfo, GFrom, gdatatypeInfo, gfrom)
-- hashable
import Data.Hashable (Hashable(..))
-- unordered-containers
import qualified Data.HashMap.Strict as HM (HashMap, singleton, fromList, toList, union, keys, mapWithKey)

import qualified Core.Data.Frame as CDF
import qualified Core.Data.Frame.Generic as CDF (encode)
import Data.Generics.Encode.Internal (Heidi, toVal, Val(..), header, Header(..),  VP(..))
import qualified Data.Generics.Encode.OneHot as OH (OneHot)

-- import Prelude hiding ((<>))

{-
+-------------+-----------------+
| Person      | House           |
+-------+-----+-------+---------+
| Name  | Age | Color | Price   |
+-------+-----+-------+---------+
| David | 63  | Green | $170000 |
| Ava   | 34  | Blue  | $115000 |
| Sonic | 12  | Green | $150000 |
+-------+-----+-------+---------+

(table example from colonnade : https://hackage.haskell.org/package/colonnade-1.2.0.2/docs/src/Colonnade.html#cap )
-}





-- | render the frame header
-- >>> printBox $ headerBox $ header (Proxy @R)

-- -- headerBox :: Header String -> Box
-- headerBox h0 = go h0 0
--   where
--     go h d =
--       case h of
--         HSum ty hm -> withHM '+' ty hm
--         HProd ty hm -> withHM '*' ty hm
--         HLeaf l -> HLeaf (text l, d) -- fixme depth to be adjusted with 'moveDown'
--       where
--         d' = d + 3 -- depth of deepest rendered layer so far
--         withHM sep ty hm = boxLayer
--           where
--             boxLayer = text ty /|/
--                        dashesWith sep bxs /|/
--                        hSepList bxs
--             bxs = values $ HM.mapWithKey (\k hrest -> text k /|/ go hrest d') hm


headerBox :: Show a => Header a -> Box
headerBox :: Header a -> Box
headerBox Header a
h =
  case Header a
h of
      HSum String
ty HashMap String (Header a)
hm -> Char -> String -> HashMap String (Header a) -> Box
forall a.
Show a =>
Char -> String -> HashMap String (Header a) -> Box
withHM Char
'+' String
ty HashMap String (Header a)
hm
      HProd String
ty HashMap String (Header a)
hm -> Char -> String -> HashMap String (Header a) -> Box
forall a.
Show a =>
Char -> String -> HashMap String (Header a) -> Box
withHM Char
'*' String
ty HashMap String (Header a)
hm
      HLeaf a
l -> String -> Box
text (String -> Box) -> String -> Box
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
l
  where
    withHM :: Char -> String -> HashMap String (Header a) -> Box
withHM Char
sep String
ty HashMap String (Header a)
hm = Box
boxLayer
      where
        boxLayer :: Box
boxLayer = String -> Box
text String
ty Box -> Box -> Box
/|/
                   Char -> [Box] -> Box
dashesWith Char
sep [Box]
bxs Box -> Box -> Box
/|/
                   [Box] -> Box
hSepList [Box]
bxs
        bxs :: [Box]
bxs = HashMap String Box -> [Box]
forall k v. HashMap k v -> [v]
values (HashMap String Box -> [Box]) -> HashMap String Box -> [Box]
forall a b. (a -> b) -> a -> b
$ (String -> Header a -> Box)
-> HashMap String (Header a) -> HashMap String Box
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\String
k Header a
v -> String -> Box
text String
k Box -> Box -> Box
/|/ Header a -> Box
forall a. Show a => Header a -> Box
headerBox Header a
v) HashMap String (Header a)
hm



values :: HM.HashMap k v -> [v]
values :: HashMap k v -> [v]
values = ((k, v) -> v) -> [(k, v)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> v
forall a b. (a, b) -> b
snd ([(k, v)] -> [v])
-> (HashMap k v -> [(k, v)]) -> HashMap k v -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HM.toList

dashesWith :: Char -> [Box] -> Box
dashesWith :: Char -> [Box] -> Box
dashesWith Char
sep [Box]
bxs = Alignment -> Box -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Alignment -> Box -> f Box -> Box
punctuateH Alignment
top (String -> Box
text [Char
sep]) ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$  (Box -> Box) -> [Box] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map (\Box
b -> Int -> Box
dashes (Box -> Int
cols Box
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)) [Box]
bxs
  where n :: Int
n = [Box] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Box]
bxs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

dashes :: Int -> Box
dashes :: Int -> Box
dashes Int
n = String -> Box
text (String -> Box) -> String -> Box
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'-'

hSepList :: [Box] -> Box
hSepList :: [Box] -> Box
hSepList = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
hcat Alignment
top ([Box] -> Box) -> ([Box] -> [Box]) -> [Box] -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> [Box] -> [Box]
forall a. a -> [a] -> [a]
intersperse Box
seph

seph :: Box
seph :: Box
seph = String -> Box
text String
" | "

(/|/) :: Box -> Box -> Box
Box
b1 /|/ :: Box -> Box -> Box
/|/ Box
b2 = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
center1 [Box
b1, Box
b2]




-- examples

{-
gshow :: forall a. (Generic a, HasDatatypeInfo a, All2 Show (Code a))
      => a -> String
gshow a =
  gshow' (constructorInfo (datatypeInfo (Proxy :: Proxy a))) (from a)

gshow' :: (All2 Show xss, SListI xss) => NP ConstructorInfo xss -> SOP I xss -> String
gshow' cs (SOP sop) = hcollapse $ hcliftA2 allp goConstructor cs sop

goConstructor :: All Show xs => ConstructorInfo xs -> NP I xs -> K String xs
goConstructor (Constructor n) args =
    K $ intercalate " " (n : args')
  where
    args' :: [String]
    args' = hcollapse $ hcliftA p (K . show . unI) args

goConstructor (Record n ns) args =
    K $ n ++ " {" ++ intercalate ", " args' ++ "}"
  where
    args' :: [String]
    args' = hcollapse $ hcliftA2 p goField ns args

goConstructor (Infix n _ _) (arg1 :* arg2 :* Nil) =
    K $ show arg1 ++ " " ++ show n ++ " " ++ show arg2
#if __GLASGOW_HASKELL__ < 800
goConstructor (Infix _ _ _) _ = error "inaccessible"
#endif

goField :: Show a => FieldInfo a -> I a -> K String a
goField (FieldInfo field) (I a) = K $ field ++ " = " ++ show a

p :: Proxy Show
p = Proxy

allp :: Proxy (All Show)
allp = Proxy
-}