{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module ConfigParser (
    ConfigEntry(..), -- Export the data constructor and all field accessors
    Config,          -- Export the type alias
    parseConfigFile  -- Export the main function
) where

import Data.Yaml
import Data.Text (Text)
import GHC.Generics (Generic)
import System.IO (hPutStrLn, stderr)
import System.Exit (exitFailure)

-- 1. DATA DEFINITIONS (These must be exported)
data ConfigEntry = ConfigEntry
  { name             :: Text
  , nameserver       :: Text
  , domain           :: Text
  , raw_mode         :: Text
  , port             :: Maybe Int
  , speeder_password :: Text
  , udp2raw_password :: Text
  } deriving (Show, Generic)

type Config = [ConfigEntry]

instance FromJSON ConfigEntry where
  parseJSON = withObject "ConfigEntry" $ \v -> ConfigEntry
    <$> v .: "name"
    <*> v .: "nameserver"
    <*> v .: "domain"
    <*> v .: "raw_mode"
    <*> v .:? "port"
    <*> v .: "speeder_password"
    <*> v .: "udp2raw_password"

-- 2. EXPORTED FUNCTION
-- This function reads the file and returns the parsed configuration or an error message.
parseConfigFile :: FilePath -> IO (Either String Config)
parseConfigFile configFile = do
  result <- decodeFileEither configFile
  case result of
    Left err -> pure $ Left $ "Error parsing YAML from " ++ configFile ++ ": " ++ show err
    Right cfg -> pure $ Right cfg