{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}

-- | Functions for producing sources reading from json strings or files, using the aeson library.
module Conftrack.Source.Aeson (mkJsonSource, mkJsonSourceWith, mkJsonFileSource, JsonSource(..)) where

import Conftrack.Value (Key (..), ConfigError(..), Value (..), KeyPart)
import Conftrack.Source (SomeSource(..), ConfigSource (..))

import Prelude hiding (readFile)
import qualified Data.Aeson as A
import Control.Monad.State (get, modify, MonadState (..))
import Data.Function ((&))
import Data.Text (Text)
import qualified Data.Aeson.Text as A
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Aeson.Types as A
import qualified Data.Aeson.Key as A
import Data.Aeson.Types (unexpected)
import qualified Data.List.NonEmpty as NonEmpty
import Control.Monad ((>=>))
import Data.Functor ((<&>))
import System.OsPath (OsPath)
import qualified System.OsPath as OS
import System.File.OsPath (readFile)
import qualified Data.Aeson.KeyMap as A
import qualified Data.Text.Encoding as BS

data JsonSource = JsonSource
  { jsonSourceValue :: A.Value
  , jsonSourceDescription :: Text
  } deriving (Show)

-- | Make a source from an aeson value
mkJsonSource :: A.Value -> SomeSource
mkJsonSource value = mkJsonSourceWith ("JSON string " <> LT.toStrict (A.encodeToLazyText value)) value

-- | same as 'mkJsonSource', but with an additional description to be shown
-- in output of 'Conftrack.Pretty.printConfigOrigins'.
mkJsonSourceWith :: Text -> A.Value -> SomeSource
mkJsonSourceWith description value = SomeSource (source, [])
  where source = JsonSource value description

-- | Make a source from a json file.
mkJsonFileSource :: OsPath -> IO (Maybe SomeSource)
mkJsonFileSource path = do
  bytes <- readFile path
  pathAsText <- OS.decodeUtf path <&> LT.toStrict . LT.pack
  pure $ A.decode bytes
    <&> mkJsonSourceWith ("JSON file " <> pathAsText)

instance ConfigSource JsonSource where
  type SourceState JsonSource = [Key]

  fetchValue key@(Key parts) JsonSource{..} = do
    case A.parseEither (lookupJsonPath (NonEmpty.toList parts) >=> parseJsonValue) jsonSourceValue of
      Left a -> pure $ Left (ParseError (T.pack a))
      Right val -> do
        modify (key :)
        pure $ Right (val, jsonSourceDescription)

  leftovers JsonSource{..} = do
    used <- get

    allJsonPaths jsonSourceValue
     & filter (`notElem` used)
     & Just
     & pure

-- | this is essentially a FromJSON instance for Value, but not written as one
-- so as to not introduce an orphan
parseJsonValue :: A.Value -> A.Parser Value
parseJsonValue = \case
  (A.String bytes) -> pure $ ConfigString (BS.encodeUtf8 bytes)
  (A.Number num) ->
    A.parseJSON (A.Number num) <&> ConfigInteger
  (A.Bool b) -> pure $ ConfigBool b
  A.Null -> pure ConfigNull
  (A.Object _) -> unexpected "unexpected json object"
  (A.Array _) -> unexpected "unexpected json array"

lookupJsonPath ::  [KeyPart] -> A.Value -> A.Parser A.Value
lookupJsonPath [] value = pure value
lookupJsonPath (part:parts) value = do
  A.withObject "blub" (\obj -> obj A..: A.fromText part) value
  >>= lookupJsonPath parts

allJsonPaths :: A.Value -> [Key]
allJsonPaths = fmap keyToKey . subKeys []
  where
    keyToKey keys = Key (fmap aesonKeyToText keys)
    aesonKeyToText (key :: A.Key) = case A.parseMaybe A.parseJSON (A.toJSON key) of
      Nothing -> error "key not representable as text; this is a bug in conftrack-aeson."
      Just a -> a
    subKeys prefix (A.Object keymap) =
      A.foldMapWithKey (\key v -> subKeys (prefix <> [key]) v) keymap
    subKeys prefix _ = case NonEmpty.nonEmpty prefix of
      Just key -> [key]
      _ -> undefined