{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE OverloadedStrings #-}

module Conftrack.Value (Value(..), ConfigError(..), Key(..), ConfigValue(..), Origin(..), KeyPart, prefixedWith) where

import Data.Text(Text)
import qualified Data.Text as T
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LB
import Data.List.NonEmpty (NonEmpty, prependList)
import System.OsPath (OsPath, encodeUtf)
import qualified Data.Text.Encoding as BS

data Value =
  ConfigString BS.ByteString
  | ConfigInteger Integer
  | ConfigOther Text Text
  | ConfigBool Bool
  | ConfigNull
  deriving Show

type KeyPart = Text

newtype Key = Key (NonEmpty KeyPart)
  deriving newtype (Eq, Ord, Show)

prefixedWith :: Key -> [KeyPart] -> Key
prefixedWith (Key key) prefix = Key (prependList prefix key)

data ConfigError =
  ParseError Text
  | TypeMismatch Text Value
  | NotPresent Key
  | Shadowed
  deriving Show

class ConfigValue a where
  fromConfig :: Value -> Either ConfigError a

data Origin = Origin Key Text
  deriving Show

instance ConfigValue Text where
  fromConfig (ConfigString a) = Right (BS.decodeUtf8 a)
  fromConfig val = Left (TypeMismatch "text" val)

instance ConfigValue Integer where
  fromConfig (ConfigInteger a) = Right a
  fromConfig val = Left (TypeMismatch "integer" val)

instance ConfigValue Int where
  fromConfig (ConfigInteger a) = Right (fromInteger a)
  fromConfig val = Left (TypeMismatch "integer" val)

instance ConfigValue Bool where
  fromConfig (ConfigBool b) = Right b
  fromConfig val = Left (TypeMismatch "bool" val)

instance ConfigValue a => ConfigValue (Maybe a) where
  fromConfig ConfigNull = Right Nothing
  fromConfig just = fmap Just (fromConfig just)

instance ConfigValue OsPath where
  fromConfig (ConfigString text) = case encodeUtf (T.unpack (BS.decodeUtf8 text)) of
    Right path -> Right path
    Left err -> Left (ParseError (T.pack $ show err))
  fromConfig val = Left (TypeMismatch "path" val)

instance ConfigValue LB.ByteString where
  fromConfig (ConfigString strict) = Right (LB.fromStrict strict)
  fromConfig val = Left (TypeMismatch "string" val)

instance ConfigValue BS.ByteString where
  fromConfig (ConfigString string) = Right string
  fromConfig val = Left (TypeMismatch "string" val)