{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use newtype instead of data" #-}

module Minilang.API where

import Data.Aeson (FromJSON, ToJSON)
import Data.Bifunctor (first)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import Servant
  ( Delete,
    FromHttpApiData,
    Get,
    JSON,
    Post,
    QueryParam,
    Raw,
    ReqBody,
    StdMethod (POST),
    ToHttpApiData,
    Verb,
    parseUrlPiece,
    toUrlPiece,
    (:<|>),
    (:>),
  )
import System.Random (StdGen, uniformList)

type LambdaAPI =
  "api" :> "register" :> ReqBody '[JSON] User :> Verb 'POST 201 '[JSON] Token
    :<|> "api" :> "register" :> QueryParam "token" Token :> Delete '[JSON] Score
    :<|> "api" :> "leaderboard" :> Get '[JSON] [Score]
    :<|> "api" :> "score" :> QueryParam "token" Token :> Get '[JSON] Score
    :<|> "api" :> "challenge" :> QueryParam "token" Token :> Get '[JSON] Challenge
    :<|> "api" :> "challenge" :> QueryParam "token" Token :> ReqBody '[JSON] Text :> Post '[JSON] ()
    :<|> Raw

data Score = Score
  { user :: User,
    grade :: Int,
    lastTest :: Maybe UTCTime,
    lastResult :: Maybe Bool
  }
  deriving (Eq, Show, Generic, ToJSON, FromJSON)

newtype User = User {username :: Text}
  deriving newtype (Eq, Show, ToJSON, FromJSON)

newtype Token = Token {unToken :: Text}
  deriving newtype (Eq, Ord, Show, ToJSON, FromJSON)

instance ToHttpApiData Token where
  toUrlPiece (Token t) = t

instance FromHttpApiData Token where
  parseUrlPiece t = Right (Token t)

newToken :: StdGen -> (ByteString, StdGen)
newToken = first LBS.pack . uniformList 16

data Challenge = Challenge
  { level :: Int,
    expr :: Text
  }
  deriving (Eq, Show, Generic, ToJSON, FromJSON)

defaultChallenges :: [Challenge]
defaultChallenges =
  [ Challenge 0 "x",
    Challenge 1 "y",
    Challenge 2 "(lam (x) x)"
  ]