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

module Hydrogen.Data.Types where

import Hydrogen.Prelude
import Hydrogen.Prelude.Extra

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)

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 ++)