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