{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Hydrogen.Data.Types where

import Hydrogen.Prelude
import Hydrogen.Prelude.Extra

import Hydrogen.Syntax.Types

import Text.Parsec.Pos

import qualified Data.Map as Map

data Data where
    DNode :: Map String Data -> [Data] -> Data
    DNumber :: Rational -> Data
    DString :: String -> Data
    DVersion :: Version -> Data
    DUUID :: UUID -> Data
    DBool :: Bool -> Data
    DDateTime :: ZonedTime -> Data
    DDate :: Day -> Data
    DTime :: TimeOfDay -> Data
    DLink :: String -> Data
    DConstant :: String -> Data
  deriving (Eq)

data Document = Document Data [POPs]

showsDNode :: String -> Data -> ShowS
showsDNode pfx node xs = case node of

    DNode obj ds -> Map.foldrWithKey showsKeyValue xs' obj
      where
        showsKeyValue key = \case
            val@(DNode _ _) -> (printf "\n%s%s{" pfx key ++)
                . showsDNode pfx' val . (printf "\n%s}" pfx ++)
            val -> (printf "\n%s%s: " pfx key ++) . showsDNode pfx' val

        pfx' = "  " ++ pfx
        xs' = foldr showsValue xs ds
        showsValue val = (('\n':pfx) ++) . shows val

    d -> shows d xs


instance Show Data where

    showsPrec _ = \case

        d@(DNode obj ds) -> if Map.null obj && null ds then id else tail . showsDNode "" d

        DNumber rat -> 
            if | denom == 1 -> (show num ++)
               | otherwise -> (printf "%d/%d" num denom ++)
          where
            (num, denom) = (numerator rat, denominator rat)

        DString str -> shows str

        DVersion ver -> ('v' :) . shows ver

        DUUID uuid -> shows uuid

        DBool val -> (bool "TRUE" "FALSE" val ++)

        DDateTime date -> shows localDay . ('T' :) . shows localTimeOfDay . showTimeZone
          where
            LocalTime { .. } = zonedTimeToLocalTime date
            offset = timeZoneMinutes (zonedTimeZone date)
            (hours, minutes) = quotRem offset 60
            showTimeZone = case offset of
                0 -> ('Z' :)
                _ -> (printf "%+02d:%02d" hours minutes ++)

        DDate day -> shows day

        DTime time -> shows time

        DLink link -> (link ++)

        DConstant s -> (s ++)


instance Show Document where

    showsPrec _ (Document props pops) = \xs ->
        "Properties:" ++ showsDNode "  " props ("\n\n" ++ showPopss pops xs)

      where
        showPopss pops xs = concatMap showPops pops ++ xs

        showPops pops = concatMap (\(a, b) -> printf "%s%s\n" (showPos a) (showTok "         " b)) pops ++ "\n"

        showPos :: SourcePos -> String
        showPos pos = printf "%3d%3d " (sourceLine pos) (sourceColumn pos)

        showTok :: String -> POP -> String
        showTok pfx = \case
            Token t k s -> printf "%s %s %s" (show t) k (show s)
            Block t k ts -> printf "%s %s %s" (show t) k (concatMap (\t -> '\n' : pfx' ++ showTok pfx' (snd t)) ts)
          where
            pfx' = "  " ++ pfx