{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Tedious.Entity where

import Control.Exception (Exception)
import Control.Lens (makeLenses, (&), (.~), (<&>), (?~), (^.))
import Data.Aeson (ToJSON (..), FromJSON (..))
import Data.Aeson qualified as A
import Data.Aeson.TH (deriveJSON)
import Data.Default (Default (..))
import Data.HashMap.Strict.InsOrd (fromList)
import Data.Int (Int64)
import Data.OpenApi (HasExample (..), HasProperties (..), HasRequired (..), HasTitle (..), HasType (..), OpenApiType (..), ToSchema, declareSchemaRef, genericDeclareNamedSchema)
import Data.OpenApi qualified as O
import Data.OpenApi.Internal.Schema (named)
import Data.Profunctor.Product
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Data.Time (UTCTime)
import Effectful (Eff)
import Effectful.Error.Dynamic (Error, runErrorWith)
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import Opaleye (Field, FieldNullable, SqlInt8, SqlText, SqlTimestamptz)
import Tedious.Quasi (tedious)
import Tedious.Util (schemaOptions, toJSONOptions, trimPrefixName_)

[tedious|
Page
  index `页码` Natural `1`
  size `每页条数` Natural `10`

PageO
  page `分页` Page
  total `总数` Natural
  data `数据` a

PageI
  page `分页` Page?
  filter `过滤` a?

Rep
  code `错误码` Natural
  message `消息` Text
  data `数据` a?

Err deriving Exception
  code Natural
  message Text

SysAdmin
  name Text
  pass Text

SysUser
  name Text (Field SqlText)
  pass Text (Field SqlText)

SysOper
  id `ID` Int64 (Maybe (Field SqlInt8), Field SqlInt8)
  user `人员` Text? (Maybe (FieldNullable SqlText), FieldNullable SqlText)
  name `名称` Text (Field SqlText) SysOper'
  target `目标` Text (Field SqlText) SysOper'
  content `内容` Text? (Maybe (FieldNullable SqlText), FieldNullable SqlText) SysOper'
  time `时间` UTCTime (Maybe (Field SqlTimestamptz), Field SqlTimestamptz) default=`CURRENT_TIMESTAMP`
|]

fillPage :: Page -> Natural -> b -> PageO b
fillPage :: forall a. Page -> Natural -> a -> PageO a
fillPage Page
page Natural
total b
v =
  PageO
    { _pageOPage :: Page
_pageOPage = Page
page,
      _pageOTotal :: Natural
_pageOTotal = Natural
total,
      _pageOData :: b
_pageOData = b
v
    }

--

repOk :: Rep a
repOk :: forall a. Rep a
repOk = Natural -> Text -> Maybe a -> Rep a
forall a. Natural -> Text -> Maybe a -> Rep a
Rep Natural
0 Text
"ok" Maybe a
forall a. Maybe a
Nothing

rep :: a -> Rep a
rep :: forall a. a -> Rep a
rep a
d = Natural -> Text -> Maybe a -> Rep a
forall a. Natural -> Text -> Maybe a -> Rep a
Rep Natural
0 Text
"ok" (a -> Maybe a
forall a. a -> Maybe a
Just a
d)

repErr :: Natural -> Text -> Rep a
repErr :: forall a. Natural -> Text -> Rep a
repErr Natural
c Text
m = Natural -> Text -> Maybe a -> Rep a
forall a. Natural -> Text -> Maybe a -> Rep a
Rep Natural
c Text
m Maybe a
forall a. Maybe a
Nothing

repErr' :: Err -> Rep a
repErr' :: forall a. Err -> Rep a
repErr' Err
e = Natural -> Text -> Maybe a -> Rep a
forall a. Natural -> Text -> Maybe a -> Rep a
Rep (Err
e Err -> Getting Natural Err Natural -> Natural
forall s a. s -> Getting a s a -> a
^. Getting Natural Err Natural
Lens' Err Natural
errCode) (Err
e Err -> Getting Text Err Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Err Text
Lens' Err Text
errMessage) Maybe a
forall a. Maybe a
Nothing

repErrNotSupport :: Rep a
repErrNotSupport :: forall a. Rep a
repErrNotSupport = Natural -> Text -> Rep a
forall a. Natural -> Text -> Rep a
repErr Natural
500 Text
"not supported yet"

catchRep :: Eff (Error Err : es) (Rep a) -> Eff es (Rep a)
catchRep :: forall (es :: [(* -> *) -> * -> *]) a.
Eff (Error Err : es) (Rep a) -> Eff es (Rep a)
catchRep = (CallStack -> Err -> Eff es (Rep a))
-> Eff (Error Err : es) (Rep a) -> Eff es (Rep a)
forall e (es :: [(* -> *) -> * -> *]) a.
(CallStack -> e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
runErrorWith ((Err -> Eff es (Rep a)) -> CallStack -> Err -> Eff es (Rep a)
forall a b. a -> b -> a
const ((Err -> Eff es (Rep a)) -> CallStack -> Err -> Eff es (Rep a))
-> (Err -> Eff es (Rep a)) -> CallStack -> Err -> Eff es (Rep a)
forall a b. (a -> b) -> a -> b
$ Rep a -> Eff es (Rep a)
forall a. a -> Eff es a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rep a -> Eff es (Rep a))
-> (Err -> Rep a) -> Err -> Eff es (Rep a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err -> Rep a
forall a. Err -> Rep a
repErr')

--

type SysOperTargetName = Text