{-# Language OverloadedStrings, TypeOperators, TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-|
Module      : Main
Description : Encoder driver for BurntSushi TOML test suite
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

Encode TOML into JSON for use with <https://github.com/BurntSushi/toml-test>

-}
module Main (main) where

import Control.Applicative (empty)
import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.ByteString.Lazy qualified as BS
import Data.Foldable (toList)
import Data.Map qualified as Map
import Data.Text (Text)
import Data.Text qualified as Text
import System.Exit (exitFailure)
import Toml (prettyToml, Value(..), Value'(..), Table)
import Toml.Syntax.Lexer (lexValue, Token(..))
import Toml.Schema (toValue)

main :: IO ()
main =
 do txt <- BS.getContents
    case Aeson.decode txt of
        Just (Toml.Table t) -> putStr (show (prettyToml t))
        Nothing -> exitFailure

instance a ~ () => Aeson.FromJSON (Toml.Value' a) where
    parseJSON =
        mconcat [
            Aeson.withArray "array" \xs ->
                Toml.List <$> traverse Aeson.parseJSON (toList xs),
            Aeson.withObject "value" \o ->
                do ty <- o Aeson..: "type"
                   vl <- o Aeson..: "value"
                   decodeValue ty vl,
            fmap (toValue :: Map.Map String Value -> Value) . Aeson.parseJSON
        ]

decodeValue :: String -> Text -> Aeson.Parser Toml.Value
decodeValue "string"         x                                         = pure (Toml.Text      x)
decodeValue "bool"           (lexValue -> Right TokTrue              ) = pure (Toml.Bool      True)
decodeValue "bool"           (lexValue -> Right TokFalse             ) = pure (Toml.Bool      False)
decodeValue "integer"        (lexValue -> Right (TokInteger        x)) = pure (Toml.Integer   x)
decodeValue "time-local"     (lexValue -> Right (TokLocalTime      x)) = pure (Toml.TimeOfDay x)
decodeValue "datetime"       (lexValue -> Right (TokOffsetDateTime x)) = pure (Toml.ZonedTime x)
decodeValue "datetime-local" (lexValue -> Right (TokLocalDateTime  x)) = pure (Toml.LocalTime x)
decodeValue "date-local"     (lexValue -> Right (TokLocalDate      x)) = pure (Toml.Day       x)
decodeValue "float"          (lexValue -> Right (TokFloat          x)) = pure (Toml.Double    x)
decodeValue "float"          (lexValue -> Right (TokInteger        x)) = pure (Toml.Double    (fromInteger x))
-- extra infinities as toml-tests are inconsistent
decodeValue "float"          "+Inf"                                    = pure (Toml.Double    (1/0))
decodeValue "float"          "-Inf"                                    = pure (Toml.Double    (-1/0))
decodeValue _                _                                         = empty