module Export.Generic where

import Ast
import Text.PrettyPrint

import Data.List (intersperse, transpose)

data Table
  = Rows [Row]
  | Cols [Col]
  deriving (Eq, Show)

type Row = [Elem]
type Col = [Elem]
type Elem = String

reformat :: Table -> Table
reformat (Rows t) = Cols $ transpose t
reformat (Cols t) = Rows $ transpose t

transp :: Table -> Table
transp (Rows t) = Cols t
transp (Cols t) = Rows t

toCSV :: String -> Table -> String
toCSV s (t@(Cols _)) = toCSV s $ reformat t
toCSV s (Rows rs) = concat $ intersperse "\n" $ map formatRow rs
  where
    formatRow r  = concat $ intersperse s $ map formatElem r
    formatElem e = e -- Currently only string to string

toHTML :: Table -> String
toHTML (t@(Cols _)) = toHTML $ reformat t
toHTML (Rows rs) = "<table>" ++ (concatMap formatRow rs) ++ "</table>"
  where
    formatRow r  = "<tr>" ++ (concatMap formatElem r) ++ "</tr>"
    formatElem e = "<td>" ++ e ++ "</td>"

isIntegral :: Double -> Bool
isIntegral x = x == fromInteger (round x)

pointsDoc :: Double -> Doc
pointsDoc v | isInfinite v = text "*"
pointsDoc v | isNaN v = empty
pointsDoc v | isIntegral v = integer (round v)
pointsDoc v = double v

propertyExpDoc :: PropertyExp -> Doc
propertyExpDoc (Lookup (index, name)) =
  brackets $ int index <> text "." <> text name
propertyExpDoc (Value value) = text value
propertyExpDoc (Num value) = pointsDoc value
propertyExpDoc (Sum str) = text "sum" <> (parens $ text str)

unify :: Judgement -> Judgement -> Maybe Judgement
unify
  (Judgement (lh, _, lcs, []))
  (Judgement (rh, rps, rcs, _))
        | lh == rh && lcs == rcs = do
    pure $ Judgement (lh, rps, lcs, [])
unify
  (Judgement (lh, _, lcs, ljs))
  (Judgement (rh, rps, rcs, rjs))
        | lh == rh && lcs == rcs = do
    newJs <- mapM (uncurry unify) (zip ljs rjs)
    pure $ Judgement (lh, rps, lcs, newJs)
unify (Bonus l) (Bonus r) | l == r =
    pure $ (Bonus l)
unify _ _ = Nothing

summary :: Word -> Judgement -> Judgement
summary _ (Bonus (h, prop, _)) =
  (Bonus (h, prop, []))
summary 0 (Judgement (h, _, p, _)) =
  Judgement (h, [], p, [])
summary depth (Judgement (h, _, _, js)) =
  Judgement (h, [], [], map (summary $ depth - 1) js)

-- For retrieval of property values

lookupProperty :: String -> Judgement -> Maybe Doc
lookupProperty name (Judgement (_, properties, _, _)) =
  case (lookup name (map (\(Property (n,v)) -> (n,v)) properties)) of
    Nothing -> Nothing
    Just(value) -> pure $ propertyExpDoc value
lookupProperty name (Bonus (_, properties, _)) =
  case (lookup name (map (\(Property (n,v)) -> (n,v)) properties)) of
    Nothing -> Nothing
    Just(value) -> pure $ propertyExpDoc value

lookupTotal :: Judgement -> Doc
lookupTotal j =
  case lookupProperty "Total" j of
    Nothing -> error $ "Total not found. Please report!"
    Just d  -> d

lookupMaxPoints :: Judgement -> Doc
lookupMaxPoints j =
  case lookupProperty "MaxPoints" j of
    Nothing -> error "MaxPoint not found. Please report!"
    Just d  -> d

lookupTitle :: Judgement -> Doc
lookupTitle j =
  case lookupProperty "Title" j of
    Nothing -> error "Title not found. Please report!"
    Just d  -> d

getTotal :: Judgement -> String
getTotal = render . lookupTotal

getTitle :: Judgement -> String
getTitle = render . lookupTitle

getMaxPoints :: Judgement -> String
getMaxPoints = render . lookupMaxPoints