{-# 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.Data (Proxy (..))
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import Servant
  ( Delete,
    Description,
    FromHttpApiData,
    Get,
    JSON,
    Post,
    QueryParam,
    Raw,
    ReqBody,
    StdMethod (POST),
    Summary,
    ToHttpApiData,
    Verb,
    parseUrlPiece,
    toUrlPiece,
    (:<|>),
    (:>),
  )
import System.Random (StdGen, uniformList)

type LambdaAPI =
  RegisterUser
    :<|> UnregisterUser
    :<|> GetLeaderboard
    :<|> GetScoreFor
    :<|> GetNextChallenge
    :<|> PostAnswer
    :<|> Raw

type RegisterUser =
  Summary
    "Register given username to participate in the contest and return a token if successful."
    :> Description "Registration fails if the username is already registered"
    :> "api"
    :> "register"
    :> ReqBody '[JSON] User
    :> Verb 'POST 201 '[JSON] Token

type UnregisterUser =
  Summary "Unregister user for given token."
    :> "api"
    :> "register"
    :> QueryParam "token" Token
    :> Delete '[JSON] Score

type GetLeaderboard =
  Summary "Retrieve the current leaderboard as a list of scores for registered players"
    :> "api"
    :> "leaderboard"
    :> Get '[JSON] [Score]

type GetScoreFor =
  Summary "Retrieve current score for user registered with given token"
    :> "api"
    :> "score"
    :> QueryParam "token" Token
    :> Get '[JSON] Score

type GetNextChallenge =
  Summary
    "Retrieve the next challenge for user registered with given token."
    :> Description
         "The challenge is given as a string representing a λ-calculus expression\
         \as expected by this implementation. Check the grammar presented in the /repl.html \
         \page for more details\
         \"
    :> "api"
    :> "challenge"
    :> QueryParam "token" Token
    :> Get '[JSON] Challenge

type PostAnswer =
  Summary
    "Post an answer to the current challenge for the given user." :>
    Description "The answer should be given as JSON string representing the result \
    \of evaluating the current challenge's expression in the untyped λ-calculus. This \
    \textual representation should be consistent with the grammar given in the REPL's \
    \\"Help\" panel. Expect to be surprised 🤔 !\
    \"
    :> "api"
    :> "challenge"
    :> QueryParam "token" Token
    :> ReqBody '[JSON] Text
    :> Post '[JSON] ()

lambdaAPI :: Proxy LambdaAPI
lambdaAPI = Proxy

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)"
  ]