{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
module Output where

import Types

import Control.Arrow (second)
import Data.Char
import Data.List
import Data.Monoid
import Data.Text.Format
import Data.Text.Lazy.Builder
import System.IO
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as L
import qualified Data.Vector.Generic as V

fixed' :: Double -> Builder
fixed' = left 11 ' ' . fixed 8

escape :: T.Text -> T.Text
escape = T.map nowhite
  where
    nowhite x | isSpace x = '_'
              | otherwise =  x

showPts :: Points -> Char
showPts False = '0'
showPts True  = '1'

type Name = T.Text

data Column = Column
    { name  :: Name
    , width :: Int
    , list  :: [Builder]
    }

class Columnable a where
    toColumns :: [a] -> [Column]

column :: Int -> Name -> [Builder] -> Column
column w n xs = Column
    { name = n
    , width = max w (T.length n)
    , list = xs
    }

mhead :: (Monoid a) => [a] -> a
mhead  [] = mempty
mhead (x:_) = x

mtail :: (Monoid a) => [a] -> [a]
mtail  [] = []
mtail (_:xs) = xs

buildLine :: [Int] -> [Builder] -> Builder
buildLine widths = mconcat . (++ [singleton '\n']) . intersperse (singleton ' ')
                 . zipWith (flip left ' ')  widths

tableHead :: [Column] -> Builder
tableHead cs = buildLine (map width cs) . map (fromText . name) $ cs

tableBody :: [Column] -> Builder
tableBody cs = build' . map list $ cs
  where
    widths = map width cs
    build' xs
      | all null xs = mempty
      | otherwise   = (buildLine widths . map mhead $ xs) `mappend` (build' . map mtail $ xs)

buildTable :: [Column] -> Builder
buildTable [] = singleton '\n'
buildTable cs = tableHead cs `mappend` tableBody cs

nameColumn :: [T.Text] -> Column
nameColumn = textColumn ""

textColumn :: Name -> [T.Text] -> Column
textColumn name xs = column (maximum $ 0 : map T.length xs) name (map fromText xs)

numberColumn :: Int -> Int -> T.Text -> [Double] -> Column
numberColumn w p n = column w n . map (fixed p)


thetaColumn :: [Theta] -> Column
thetaColumn = column 12 "theta" . map fixed'

instance Columnable AB where
    toColumns abs = let (as, bs) = unzip abs
                    in zipWith (\n -> column 11 n . map fixed') ["a", "b"] [as, bs]

instance Columnable ABC where
    toColumns abcs = let (as, bs, cs) = unzip3 abcs
                     in zipWith (\n -> column 11 n . map fixed') ["a", "b", "c"] [as, bs, cs]

tableThetas :: [(Contestant, Theta)] -> [Column]
tableThetas xs = let (cs, ts) = unzip xs
                  in [nameColumn cs, thetaColumn ts]

tableTaskParams :: [(Task, TaskParam)] -> [Column]
tableTaskParams xs = let (ts, ds) = unzip xs
                     in nameColumn ts : toColumns ds

formatTextResponse :: (Contestant, Task, Points) -> Builder
formatTextResponse (c,t,r) = build "{} {} {}" (escape c, escape t, showPts r)

responseColumns :: Responses -> [Column]
responseColumns xs = let (c,t,r) = (unzip3 . responsesToList) xs
                     in [ textColumn "contestant" c
                        , textColumn "task" t
                        , column 1 "result" (map (singleton . showPts) r) ]

unlinesB :: [Builder] -> Builder
unlinesB = mconcat . concatMap (:[singleton '\n'])

formatDottedResponses :: Responses -> Builder
formatDottedResponses Responses {..} = build' respCont
  where
    n :: Int
    n = V.length tasks
    line = V.update (V.replicate n '.') . V.map (second showPts)
    buildLn xs = fromString $ V.toList xs ++ "\n"
    build' = mconcat . V.toList . V.map (buildLn . line)

writeFile :: FilePath -> Builder -> IO ()
writeFile path = L.writeFile path . toLazyText

maybeWriteFile :: Maybe FilePath -> Builder -> IO ()
maybeWriteFile (Just path) = L.writeFile path . toLazyText
maybeWriteFile _ = const . return $ ()

writeDefFile :: Handle -> Maybe FilePath -> Builder -> IO ()
writeDefFile _ (Just path) = L.writeFile path . toLazyText
writeDefFile h Nothing = L.hPutStr h . toLazyText