module Handler.Utils.Table.Pagination.CsvColumnExplanations
  ( CsvColumnsExplained(..)
  , genericCsvColumnsExplanations
  ) where

import Import

import qualified Data.Csv as Csv
import GHC.Generics
import qualified GHC.Generics as Generics

import Language.Haskell.TH
-- import Language.Haskell.TH.Datatype
-- import Language.Haskell.TH.Lib

import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as B8


class CsvColumnsExplained csv where
  csvColumnsExplanations :: forall p. p csv -> Map Csv.Name Widget
  csvColumnsExplanations _ = Map.empty

genericCsvColumnsExplanations :: forall msg p csv.
                                 ( Generic csv
                                 , GCsvColumnsExplained (Rep csv)
                                 , RenderMessage UniWorX msg
                                 )
                              => Csv.Options
                              -> Map Name msg
                              -> p csv
                              -> Map Csv.Name Widget
genericCsvColumnsExplanations opts msgMap' _ = Map.mapMaybe (fmap (toWidget <=< ap getMessageRender . pure) . flip Map.lookup msgMap) headerNames
  where
    msgMap :: Map String msg
    msgMap = Map.mapKeys nameBase msgMap'
    headerNames :: Map Csv.Name String
    headerNames = gCsvColumnsExplanations opts $ Generics.from (error "proxy" :: csv)

class GCsvColumnsExplained a where
  gCsvColumnsExplanations :: Csv.Options -> a p -> Map Csv.Name String

instance GCsvColumnsExplained U1 where
  gCsvColumnsExplanations _ _ = Map.empty

instance (GCsvColumnsExplained a, GCsvColumnsExplained b) => GCsvColumnsExplained (a :*: b) where
  gCsvColumnsExplanations opts _ = Map.unionWithKey (\h f1 f2 -> error $ "Column header ‘" ++ B8.unpack h ++ "’ is produced by both ‘" ++ f1 ++ "’ and ‘" ++ f2 ++ "’")
    (gCsvColumnsExplanations opts (error "proxy" :: a p))
    (gCsvColumnsExplanations opts (error "proxy" :: b p))
    

instance GCsvColumnsExplained a => GCsvColumnsExplained (M1 D c a) where
  gCsvColumnsExplanations opts _ = gCsvColumnsExplanations opts (error "proxy" :: a p)

instance GCsvColumnsExplained a => GCsvColumnsExplained (M1 C c a) where
  gCsvColumnsExplanations opts _ = gCsvColumnsExplanations opts (error "proxy" :: a p)

-- | Instance to ensure that you cannot derive DefaultOrdered for
-- constructors without selectors.
instance GCsvColumnsExplained (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a)
   where
     gCsvColumnsExplanations _ _ =
        error "You cannot derive CsvColumnsExplanations for constructors without selectors."

instance Selector s => GCsvColumnsExplained (M1 S s a) where
  gCsvColumnsExplanations (Csv.fieldLabelModifier -> f) m
    | null name = error "Cannot derive CsvColumnsExplanations for constructors without selectors"
    | otherwise = Map.singleton (B8.pack $ f name) name
    where name = selName m