{-# LANGUAGE UndecidableInstances #-}

module Worksheets.Utils.JSON (
  module Worksheets.Utils.JSON,
  module Data.Aeson,
  module Data.Aeson.Parser,
  module Data.Aeson.Types,
) where

import Data.Aeson
import Data.Aeson.Parser
import Data.Aeson.Types
import Data.Attoparsec.ByteString qualified as Atto
import Data.ByteString qualified as ByteString
import System.Exit qualified as Sys
import System.IO qualified as Sys

import Worksheets.Utils.Generics qualified as Generics
import Worksheets.Utils.Prelude hiding (Value)

readJSON :: FilePath -> (Value -> Parser a) -> IO a
readJSON path parser = do
  withDataFile path \fileHandle -> do
    res <- Atto.parseWith (ByteString.hGetSome fileHandle 4096) jsonLast' mempty
    case res of
      Atto.Partial _k -> do
        Sys.hPutStr Sys.stderr "withDataFile: Parser still Partial at EOF"
        Sys.exitFailure
      Atto.Fail _leftOver contexts message -> do
        Sys.hPrint Sys.stderr contexts
        Sys.hPutStr Sys.stderr message
        Sys.exitFailure
      Atto.Done _leftOver resJSON ->
        case parseEither (\() -> parser resJSON) () of
          Right a -> return a
          Left err -> do
            Sys.hPutStr Sys.stderr err
            Sys.exitFailure

-- | Enables the use of:
-- @
-- deriving (`ToJSON`, `FromJSON`) via (`GenericallyWithOptions` MyDataType)
-- @
newtype GenericallyWithOptions a = GenericallyWithOptions a

instance (Generic a, GFromJSON Zero (Generics.Rep a)) => FromJSON (GenericallyWithOptions a) where
  parseJSON x = genericParseJSON options x <&> GenericallyWithOptions
instance (Generic a, GToJSON' Value Zero (Generics.Rep a)) => ToJSON (GenericallyWithOptions a) where
  toJSON (GenericallyWithOptions x) = genericToJSON options x

options =
  defaultOptions
    { fieldLabelModifier = Generics.dropUntilUnderscore
    , constructorTagModifier = id
    , allNullaryToStringTag = True
    , omitNothingFields = False
    , sumEncoding = defaultTaggedObject
    , unwrapUnaryRecords = False
    , tagSingleConstructors = False
    , rejectUnknownFields = True
    }

-- \^ CoverageNote: safeguard to avoid missing-out data.