{-# LANGUAGE OverloadedStrings, NamedFieldPuns #-}

module Formatter (
  prettyFormatState
, prettyFormatState'
, prettyPrintState
, prettyPrintState'
) where

import Base (State(..), Address)
import Memory (getMemAdr)

import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.String (fromString)

data PrinterConfig = PrinterConfig { cellCountHorizontal :: Int
                                   , cellRowsAbove :: Int
                                   , cellRowsBelow :: Int
                                   }
  deriving (Read, Show, Eq)

defaultPrinterConfig = PrinterConfig { cellCountHorizontal = 7
                                     , cellRowsAbove = 0
                                     , cellRowsBelow = 0
                                     }

divideBy2IntoInts :: Bool -> Int -> (Int, Int)
divideBy2IntoInts preferLeft n = if preferLeft then (ceiling x, floor x) else (floor x, ceiling x)
  where
    x = fromIntegral n / 2.0

createSideCell :: Bool -> Address -> Int -> T.Text
createSideCell isLeft addr value = fromString str
  where
    topLength = length $ show addr
    innerLength = length $ show value
    len = max topLength innerLength

    topLen2 = divideBy2IntoInts True (len - topLength)
    fstTopSpc = replicate (fst topLen2) '─'
    sndTopSpc = replicate (snd topLen2) '─'

    innerLen2 = divideBy2IntoInts True (len - innerLength)
    fstInnerSpc = replicate (fst innerLen2) ' '
    sndInnerSpc = replicate (snd innerLen2) ' '

    l x = if isLeft then x else ""
    r x = if isLeft then "" else x

    str = l "┬" ++ fstTopSpc ++ "[" ++ show addr ++ "]" ++ sndTopSpc ++ r "┬" ++ "\n"
       ++ l "│" ++ " " ++ fstInnerSpc ++ show value ++ sndInnerSpc ++ " " ++ r "│" ++ "\n"
       ++ l "┴" ++ replicate (len + 2) '─' ++ r "┴"

createLeftCell = createSideCell True
createRightCell = createSideCell False

createMidCell :: Address -> Int -> T.Text
createMidCell addr value = fromString str
  where
    topLength = length $ show addr
    innerLength = length $ show value
    len = max topLength innerLength

    topLen2 = divideBy2IntoInts True (len - topLength)
    fstTopSpc = replicate (fst topLen2) '─'
    sndTopSpc = replicate (snd topLen2) '─'

    innerLen2 = divideBy2IntoInts True (len - innerLength)
    fstInnerSpc = replicate (fst innerLen2) ' '
    sndInnerSpc = replicate (snd innerLen2) ' '

    str = "╦" ++ fstTopSpc ++ "[" ++ show addr ++ "]" ++ sndTopSpc ++ "╦\n"
       ++ "║ " ++ fstInnerSpc ++ show value ++ sndInnerSpc ++ " ║\n"
       ++ "╩" ++ replicate (len + 2) '═' ++ "╩"

mergeTextBlocks :: T.Text -> T.Text -> T.Text
mergeTextBlocks a b = T.unlines $ zipWith T.append (T.lines a) (T.lines b)

prettyFormatState :: PrinterConfig -> State -> T.Text
prettyFormatState
  c@PrinterConfig { cellCountHorizontal, cellRowsAbove, cellRowsBelow }
  s@State {memory, codePos}
  = foldl1 mergeTextBlocks cells
  where
    cellsAround = divideBy2IntoInts False (cellCountHorizontal - 1)

    fetchCellWithOffset offset = getMemAdr memory $ codePos + offset

    cells :: [T.Text]
    cells = map (\x -> createLeftCell (codePos + x) (fetchCellWithOffset x)) [(negate (fst cellsAround))..(-1)]
         ++ [createMidCell codePos (fetchCellWithOffset 0) ]
         ++ map (\x -> createRightCell (codePos + x) (fetchCellWithOffset x)) [(snd cellsAround)..3]

prettyFormatState' :: State -> T.Text
prettyFormatState' = prettyFormatState defaultPrinterConfig

prettyPrintState :: PrinterConfig -> State -> IO ()
prettyPrintState c s = T.putStrLn $ prettyFormatState c s

prettyPrintState' :: State -> IO ()
prettyPrintState' s = T.putStrLn $ prettyFormatState' s