{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Worksheets.Utils.SQL (
  module Worksheets.Utils.SQL,
  module Database.SQLite.Simple,
  module Database.SQLite.Simple.FromRow,
  module Database.SQLite.Simple.FromField,
  module Database.SQLite.Simple.ToField,
  module Database.SQLite.Simple.Ok,
  module Database.SQLite.Simple.Internal,
) where

import Control.Exception (Exception, SomeException (..))
import Control.Monad.Trans.Class qualified as MT
import Control.Monad.Trans.Reader qualified as MT
import Control.Monad.Trans.State.Strict qualified as MT
import Data.Aeson qualified as JSON
import Data.List qualified as List
import Data.Text.Encoding qualified as Text
import Data.Text.Lazy qualified as LazyText
import Data.Text.Short qualified as ShortText
import Database.SQLite.Simple
import Database.SQLite.Simple.FromField
import Database.SQLite.Simple.FromRow
import Database.SQLite.Simple.Internal
import Database.SQLite.Simple.Ok (ManyErrors (..), Ok (..))
import Database.SQLite.Simple.ToField
import Database.SQLite.Simple.ToRow
import Database.SQLite3 qualified as SQL.Base
import Text.Show (showString)

import Worksheets.Utils.Generics qualified as Gen
import Worksheets.Utils.Prelude

-- DOC: https://highperformancesqlite.com/articles/sqlite-recommended-pragmas
--
-- PRAGMA foreign_keys = ON;
-- PRAGMA journal_mode = WAL;
-- PRAGMA mmap_size = 268435456; --256MB
-- PRAGMA page_size = 8192;

class GFromRowWithErrorContext f where gfromRowWithErrorContext :: RowParser (f a)
instance GFromRowWithErrorContext Gen.U1 where
  gfromRowWithErrorContext = pure Gen.U1
instance FromField a => GFromRowWithErrorContext (Gen.K1 i a) where
  gfromRowWithErrorContext = Gen.K1 <$> fromFieldWithErrorContext
instance GFromRowWithErrorContext a => GFromRowWithErrorContext (Gen.M1 i c a) where
  gfromRowWithErrorContext = Gen.M1 <$> gfromRowWithErrorContext
instance (GFromRowWithErrorContext a, GFromRowWithErrorContext b) => GFromRowWithErrorContext (a Gen.:*: b) where
  gfromRowWithErrorContext = (Gen.:*:) <$> gfromRowWithErrorContext <*> gfromRowWithErrorContext

fromFieldWithErrorContext :: FromField a => RowParser a
fromFieldWithErrorContext = fieldWithErrorContext fromField
{-# INLINE fromFieldWithErrorContext #-}

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

instance (Generic a, GFromRowWithErrorContext (Gen.Rep a)) => FromRow (GenericallyWithOptions a) where
  fromRow = gfromRowWithErrorContext <&> (Gen.to >>> GenericallyWithOptions)
instance (Generic a, GToRow (Gen.Rep a)) => ToRow (GenericallyWithOptions a) where
  toRow (GenericallyWithOptions x) = Gen.from x & gtoRow

instance ToField ShortText where
  toField = SQLText . ShortText.toText
instance FromField ShortText where
  -- fromField = fromField >>> fmap ShortText.fromText
  fromField (Field (SQLText txt) _) = Ok $ txt & ShortText.fromText
  fromField f@(Field d col) = returnError ConversionFailed f $ "need an SQLText at column=" <> show col <> " but got: " <> show d

data FieldErrorContext = FieldErrorContext
  { fieldErrorContextRemainingColumns :: [SQL.Base.SQLData]
  }
instance Show FieldErrorContext where
  showsPrec _p FieldErrorContext{..} = showString (pShow fieldErrorContextRemainingColumns & LazyText.unpack)
instance Exception FieldErrorContext

fieldWithErrorContext :: FieldParser a -> RowParser a
fieldWithErrorContext fieldP = RP $ do
  ncols <- MT.asks nColumns
  (column, remaining) <- MT.lift MT.get
  MT.lift (MT.put (column + 1, List.tail remaining))
  if column >= ncols
    then MT.lift (MT.lift (Errors [SomeException (ColumnOutOfBounds (column + 1))]))
    else do
      let r = List.head remaining
      let fld = Field r column
      MT.lift do
        MT.lift do
          let f = fieldP fld
          case f of
            Errors errs -> do
              let err = FieldErrorContext remaining
              Errors (SomeException err : errs)
            _ -> f

instance FromField JSON.Value where
  fromField = fromJSONField JSON.Null
instance ToField JSON.Value where
  toField = JSON.encode >>> toField

instance FromField JSON.Array where
  fromField = fromJSONField mempty
instance ToField JSON.Array where
  toField = toJSONField

instance JSON.ToJSON a => ToField [a] where
  toField = toJSONField
instance (JSON.FromJSON a, Typeable a) => FromField [a] where
  fromField = fromJSONField []

-- | Uses `JSON.eitherDecodeStrict` and expect the JSON
-- to be stored in an `BLOB` column.
--
-- Beware that SQlite does not enforces `BLOB` columns
-- to contain only `BLOB` data, they could be `TEXT`,
-- so you have to check that the way you `INSERT`
-- is indeed inserting a `BLOB`,
-- eg. in Python `bytes()` must be used:
-- @
-- bytes(json.dumps(value, ensure_ascii=False),'utf-8')
-- @
fromJSONField :: JSON.FromJSON a => Typeable a => a -> Field -> Ok a
fromJSONField empt fld =
  fromField fld & \case
    Errors{} ->
      fromField fld & \case
        Errors err -> Ok empt
        -- returnError Incompatible fld $ show err
        Ok txt -> txt & Text.encodeUtf8 & decodeBS
    Ok bs -> bs & decodeBS
  where
    decodeBS bs =
      case JSON.eitherDecodeStrict bs of
        Left err -> returnError ConversionFailed fld err
        Right val ->
          case JSON.fromJSON val of
            JSON.Error err -> returnError ConversionFailed fld err
            JSON.Success a -> Ok a

toJSONField :: JSON.ToJSON a => a -> SQLData
toJSONField = JSON.toJSON >>> toField

selectors :: forall a. Gen.DataSelectorNames (Gen.Rep a ()) => Query
selectors =
  Gen.dataSelectorNames @(Gen.Rep a ())
    <&> Gen.dropUntilUnderscore
    & List.intercalate ","
    & fromString