{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE DefaultSignatures #-}
-- Remove this
{-# LANGUAGE DeriveDataTypeable #-}
-- Remove this
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{- | Module implements the default methods for Tabulate
 All examples listed in the document need the following language pragmas
 and following modules imported

 @
 {#- LANGUAGE MultiParamTypeClasses}
 {#- LANGUAGE DeriveGeneric}
 {#- LANGUAGE DeriveDataTypeable}

 import qualified GHC.Generics as G
 import Data.Data
 @
-}
module Literate.Table where

--import Data.Generics.Aliases

import Data.Bool (Bool)
import Data.Data
import Data.Foldable (foldMap)
import Data.Function (($), (.))
import Data.Functor (fmap)
import Data.Int (Int)
import Data.List ((++))
import Data.List qualified as L
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Maybe
import Data.String (String)
import Data.Tree
import Data.Typeable
import GHC.Err (undefined)
import GHC.Float (Float)
import GHC.Generics as G
import GHC.Num (Integer, (+), (-))
import GHC.Show
import Literate.Box qualified as B
import System.IO (IO)
import Text.Printf
import Prelude (Double, error)

-- | * Class 'GRecordMeta'
class GRecordMeta f where
  toTree :: f a -> [Tree String]

instance GRecordMeta U1 where
  toTree U1 = []
instance (GRecordMeta a, GRecordMeta b) => GRecordMeta (a :*: b) where
  toTree (x :*: y) = toTree x ++ toTree y
instance (GRecordMeta a, GRecordMeta b) => GRecordMeta (a :+: b) where
  toTree (G.L1 x) = toTree x
  toTree (G.R1 x) = toTree x
instance (GRecordMeta a, Selector s) => GRecordMeta (M1 S s a) where
  toTree a = [Node (selName a) $ toTree (unM1 a)]
instance (GRecordMeta a, Constructor c) => GRecordMeta (M1 C c a) where
  -- we don't want to build node for constructor
  --toTree a = [Node (conName a) $ toTree (unM1 a)]
  toTree a = toTree (unM1 a)
instance (GRecordMeta a) => GRecordMeta (M1 D c a) where
  toTree (M1 x) = toTree x
instance (CellValueFormatter a, Data a, RecordMeta a) => GRecordMeta (K1 i a) where
  --toTree x = [Node (show (unK1 x)) (toTree' $ unK1 x)]
  toTree x = toTree' $ unK1 x

{- | Use this flag to expand a Record Type as a table when
 nested inside another record.
-}
data ExpandWhenNested

{- | Use this flag to not expand a Record type as a table when
 nested inside another record. The 'Show' instance of the nested record
 is used by default without expanding. This means that the fields of the
 nested record are not displayed as separate headers.
-}
data DoNotExpandWhenNested

{- | Class instance that needs to be instantiated for each
 record that needs to be printed using printTable

 @

 data Stock = Stock {price:: Double, name:: String} derive (Show, G.Generic, Data)
 instance Tabulate S 'ExpandWhenNested'
 @

 If 'S' is embedded inside another `Record` type and should be
 displayed in regular Record Syntax, then

 @

 instance Tabulate S 'DoNotExpandWhenNested'
 @
-}
class Tabulate a flag | a -> flag

--instance TypeCast flag HFalse => Tabulate a flag
instance {-# OVERLAPPABLE #-} (flag ~ DoNotExpandWhenNested) => Tabulate a flag

class RecordMeta a where
  toTree' :: a -> [Tree String]
instance (Tabulate a flag, RecordMeta' flag a) => RecordMeta a where
  toTree' = toTree'' (undefined :: proxy flag)

class RecordMeta' flag a where
  toTree'' :: proxy flag -> a -> [Tree String]
instance (G.Generic a, GRecordMeta (Rep a)) => RecordMeta' ExpandWhenNested a where
  toTree'' _ a = toTree (G.from a)
instance (CellValueFormatter a) => RecordMeta' DoNotExpandWhenNested a where
  toTree'' _ a = [Node (ppFormatter a) []]

{- |  Class that implements formatting using printf.
    Default instances for String, Char, Int, Integer, Double and Float
    are provided. For types that are not an instance of this class
    `show` is used.
-}
class CellValueFormatter a where
  -- Function that can be implemented by each instance
  ppFormatter :: a -> String
  -- Future support for this signature will be added
  --ppFormatterWithStyle :: TablizeValueFormat -> a -> String

  -- Default instance of function for types that do
  -- do not have their own instance
  default ppFormatter :: (Show a) => a -> String
  ppFormatter x = show x

instance CellValueFormatter Integer where
  ppFormatter x = printf "%d" x
instance CellValueFormatter Int where
  ppFormatter x = printf "%d" x
instance CellValueFormatter Float where
  ppFormatter x = printf "%14.7g" x
instance CellValueFormatter String where
  ppFormatter x = printf "%s" x
instance CellValueFormatter Double where
  ppFormatter x = printf "%14.7g" x
instance CellValueFormatter Bool
instance (Show a, CellValueFormatter a) => CellValueFormatter (Maybe a)

gen_renderTableWithFlds :: [DisplayFld t] -> [t] -> B.Box
gen_renderTableWithFlds flds recs = results
 where
  col_wise_values = fmap (\(DFld f) -> fmap (ppFormatter . f) recs) flds
  vertical_boxes = fmap (B.vsep 0 B.AlignTopLeft) $ fmap (fmap B.text) col_wise_values
  results = B.hsep 5 B.AlignTopLeft vertical_boxes

class Boxable b where
  printTable :: (G.Generic a, GRecordMeta (Rep a)) => b a -> IO ()

  --printTableWithStyle :: (Data a, G.Generic a, GTabulate(Rep a)) => TablizeValueFormat -> b a -> IO ()

  renderTable :: (G.Generic a, GRecordMeta (Rep a)) => b a -> B.Box
  printTableWithFlds :: [DisplayFld t] -> b t -> IO ()
  renderTableWithFlds :: [DisplayFld t] -> b t -> B.Box

-- | Instance methods to render or print a list of records in a tabular format.
instance Boxable [] where
  printTable m = B.printBox $ ppRecords m

  renderTable m = ppRecords m
  printTableWithFlds flds recs = B.printBox $ renderTableWithFlds flds recs
  renderTableWithFlds = gen_renderTableWithFlds

{-
instance Boxable V.Vector where
  -- | Prints a "Vector" as a table. Called by "printTable".
  -- | Need not be called directly
  printTable m = B.printBox $ renderTable m  --TODO: switch this to Vector
  renderTable m = ppRecords $ V.toList m

  -- | Print a "Vector" of records as a table with the selected fields.
  -- Called by "printTableWithFlds".
  printTableWithFlds flds recs = B.printBox $ renderTableWithFlds flds $ V.toList recs
  renderTableWithFlds flds recs = gen_renderTableWithFlds flds $ V.toList recs
-}

instance (CellValueFormatter k) => Boxable (Map.Map k) where
  printTable m = B.printBox $ renderTable m
  renderTable m = ppRecordsWithIndex m
  printTableWithFlds flds recs = B.printBox $ renderTableWithFlds flds recs

  renderTableWithFlds flds recs = results
   where
    data_cols = renderTableWithFlds flds $ Map.elems recs
    index_cols = B.vsep 0 B.AlignTopLeft $ fmap (B.text . ppFormatter) $ Map.keys recs
    vertical_cols = B.hsep 5 B.AlignTopLeft [index_cols, data_cols]
    results = vertical_cols

-- Pretty Print the reords as a table. Handles both records inside
-- Lists and Vectors
ppRecords :: (GRecordMeta (Rep a), G.Generic a) => [a] -> B.Box
ppRecords recs = result
 where
  result = B.hsep 5 B.AlignTopLeft $ createHeaderDataBoxes recs

-- Pretty Print the records as a table. Handles records contained in a Map.
-- Functions also prints the keys as the index of the table.
ppRecordsWithIndex :: (CellValueFormatter k, GRecordMeta (Rep a), G.Generic a) => (Map.Map k a) -> B.Box
ppRecordsWithIndex recs = result
 where
  data_boxes = createHeaderDataBoxes $ Map.elems recs
  index_box = createIndexBoxes recs
  result = B.hsep 5 B.AlignTopLeft $ index_box : data_boxes

-- What follows are helper functions to build the B.Box structure to print as table.

-- Internal helper functions for building the Tree.

-- Build the list of paths from the root to every leaf.
constructPath :: Tree a -> [[a]]
constructPath (Node r []) = [[r]]
constructPath (Node r f) = [r : x | x <- (L.concatMap constructPath f)]

-- Fill paths with a "-" so that all paths have the
-- same length.
fillPath paths = stripped_paths
 where
  depth = L.maximum $ L.map L.length paths
  diff = L.map (\p -> depth - (L.length p)) paths
  new_paths = L.map (\(p, d) -> p ++ L.replicate d "-") $ L.zip paths diff
  stripped_paths = [xs | x : xs <- new_paths]

-- Count the number of fields in the passed structure.
-- The no of leaves is the sum of all fields across all nested
-- records in the passed structure.
countLeaves :: Tree a -> Tree (Int, a)
countLeaves (Node r f) = case f of
  [] -> Node (1, r) []
  x -> countLeaves' x
   where
    countLeaves' x =
      let count_leaves = fmap countLeaves x
          level_count = List.foldr (\(Node (c, a) _) b -> c + b) 0 count_leaves
       in Node (level_count, r) count_leaves

-- Trims a the tree of records and return just the
-- leaves of the record
trimTree (Node r f) = trimLeaves r f

-- Helper function called by trimTree.
trimLeaves r f = Node r (trimLeaves' f)
 where
  trimLeaves' f =
    let result = fmap trimLeaves'' f
         where
          trimLeaves'' (Node r' f') =
            let result' = case f' of
                  [] -> Nothing
                  _ -> Just $ trimLeaves r' f'
             in result'
     in catMaybes result

-- Get  all the leaves from the record. Returns all leaves
-- across the record structure.
getLeaves :: (CellValueFormatter a) => Tree a -> [String]
getLeaves (Node r f) = case f of
  [] -> [(ppFormatter r)]
  _ -> foldMap getLeaves f

recsToTrees recs = fmap (\a -> Node "root" $ (toTree . G.from $ a)) $ recs

getHeaderDepth rec_trees = header_depth
 where
  header_depth = L.length . L.head . fillPath . constructPath . trimTree . L.head $ rec_trees

createBoxedHeaders :: [[String]] -> [B.Box]
createBoxedHeaders paths = boxes
 where
  boxes = L.map wrapWithBox paths
  wrapWithBox p = B.vsep 0 B.AlignTopLeft $ L.map B.text p

--createHeaderCols :: [Tree String] -> [B.Box]
createHeaderCols rec_trees = header_boxes
 where
  header_boxes = createBoxedHeaders . fillPath . constructPath . trimTree . L.head $ rec_trees

--createDataBoxes :: [Tree a] -> [B.Box]
createDataBoxes rec_trees = vertical_boxes
 where
  horizontal_boxes = fmap (fmap B.text) $ fmap getLeaves rec_trees
  vertical_boxes = fmap (B.vsep 0 B.AlignTopLeft) $ L.transpose horizontal_boxes

--createIndexBoxes :: Map.Map a a -> B.Box
createIndexBoxes recs = index_box
 where
  rec_trees = recsToTrees $ Map.elems recs
  header_depth = getHeaderDepth rec_trees
  index_col = (L.replicate header_depth "-") ++ (L.map ppFormatter $ Map.keys recs)
  index_box = B.vsep 0 B.AlignTopLeft $ L.map B.text index_col

createHeaderDataBoxes recs = vertical_boxes
 where
  rec_trees = recsToTrees recs
  header_boxes = createHeaderCols rec_trees
  data_boxes = createDataBoxes rec_trees
  vertical_boxes = fmap (\(a, b) -> B.vsep 0 B.AlignTopLeft $ [a, b]) $ L.zip header_boxes data_boxes

-- testing

data T = C1 {aInt :: Double, aString :: String} deriving (Data, Typeable, Show, G.Generic)
data T1 = C2 {t1 :: T, bInt :: Double, bString :: String} deriving (Data, Typeable, Show, G.Generic)

c1 = C1 1000 "record_c1fdsafaf"
c2 = C2 c1 100.12121 "record_c2"
c3 = C2 c1 1001.12111 "record_c2fdsafdsafsafdsafasfa"
c4 = C2 c1 22222.12121 "r"

instance Tabulate T ExpandWhenNested
instance Tabulate T1 ExpandWhenNested
instance CellValueFormatter T

data R2 = R2 {a :: Maybe Integer} deriving (G.Generic, Show)
data R3 = R3 {r31 :: Maybe Integer, r32 :: String} deriving (G.Generic, Show)
tr = Node "root" (toTree . G.from $ c2)
r2 = Node "root" (toTree . G.from $ (R2 (Just 10)))
r3 = Node "root" (toTree . G.from $ (R3 (Just 10) "r3_string"))

-- | Used with 'printTableWithFlds'
data DisplayFld a = forall s. CellValueFormatter s => DFld (a -> s)

-- printTableWithFlds2 :: [DisplayFld t] -> V.Vector t -> IO ()
-- printTableWithFlds2 flds recs = B.printBox $ printTableWithFlds flds $ V.toList recs

-- printTableWithFlds3 :: (CellValueFormatter k) => [DisplayFld t] -> Map.Map k t -> String
-- printTableWithFlds3 flds recs = results
--  where
--   data_cols = renderTableWithFlds flds $ Map.elems recs
--   index_cols = B.vsep 0 B.AlignTopLeft $ fmap (B.text . ppFormatter) $ Map.keys recs
--   vertical_cols = B.hsep 5 B.AlignTopLeft [index_cols, data_cols]
--   results = B.render vertical_cols

data R00
  = R00
      { r00Int :: Int
      , r00String :: String
      }
  | R00_
      { r00_Int :: Int


-- R0 has to derive from Data, since
-- it will be nested
data R01 = R01
  { test_string :: String
  , test_integer :: Integer
  , test_float :: Float
  , test_DOUBLE :: Maybe Double
  }
  deriving (Data, Show, G.Generic)
instance CellValueFormatter R01

data R02 = R02 {r2_r00 :: R00, r2_r01 :: R01}
  deriving (Show, G.Generic, Data)
instance CellValueFormatter R02

data R03 = R03 {r3_id :: Int, r3_r02 :: R02}
  deriving (Show, G.Generic, Data)

instance Tabulate R01 ExpandWhenNested
instance Tabulate R02 ExpandWhenNested
instance Tabulate R03 ExpandWhenNested

getR01 =
  R01
    { test_string = "Jack-Jack"
    , test_integer = 10
    , test_DOUBLE = Just 10.101
    , test_float = 0.101021
    }

getR02 = R02{r2_r00 = R00_ 100 "foo", r2_r01 = getR01}

getR03 = R03{r3_id = 200, r3_r02 = getR02}

recordsList = List.replicate 2 $ getR03

-- >>> recordsList
-- [R03 {r3_id = 20, nested_r02 = R02 {r2_id = 10, nested_r = R01 {test_string = "Jack-Jack", test_integer = 10, test_float = 0.101021, test_double = 10.101}}}
-- ,R03 {r3_id = 20, nested_r02 = R02 {r2_id = 10, nested_r = R01 {test_string = "Jack-Jack", test_integer = 10, test_float = 0.101021, test_double = 10.101}}}]
--
-- >>> B.rows $ renderTable recordsList
-- 5
--
-- >>> B.cols $ renderTable recordsList
-- 91

-- >>> error $ B.render $ renderTable recordsList
-- r3_id     r3_r02     r3_r02        r3_r02          r3_r02           r3_r02             r3_r02
-- -         r2_r00     r2_r00        r2_r01          r2_r01           r2_r01             r2_r01
-- -         r00Int     r00String     test_string     test_integer     test_float         test_DOUBLE
-- 200       100        foo           Jack-Jack       10                    0.1010210     Just 10.101
-- 200       100        foo           Jack-Jack       10                    0.1010210     Just 10.101

recordsMap =
  Map.fromList
    [ ("key1", getR03)
    , ("key2", getR03)
    , ("key3", getR03{r3_id = 32})
    ]

-- >>> B.rows $ renderTable recordsMap
-- 5

-- >>> B.cols $ renderTable recordsMap
-- 100

-- >>> error $ B.render $ renderTable recordsMap
-- -        r3_id     r3_r02     r3_r02        r3_r02          r3_r02           r3_r02             r3_r02
-- -        -         r2_r00     r2_r00        r2_r01          r2_r01           r2_r01             r2_r01
-- -        -         r00Int     r00String     test_string     test_integer     test_float         test_DOUBLE
-- key1     200       100        foo           Jack-Jack       10                    0.1010210     Just 10.101
-- key2     200       100        foo           Jack-Jack       10                    0.1010210     Just 10.101
-- key3     32        100        foo           Jack-Jack       10                    0.1010210     Just 10.101