{-# LANGUAGE LambdaCase, BlockArguments #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
module Server
    ( server
    )
    where
--------------------------------------------------------------------------------
import GHC.Generics                 (Generic, Generically(..))
import Data.Text.Encoding           qualified as T
import Data.Text                    (Text)
import Data.Text                    qualified as T
import Data.Text.IO                 qualified as T
import Data.Pretty                  hiding (annotate, empty)
import Data.Aeson                   ( ToJSON(..), Value, (.:)
                                    , FromJSON(..), encode, withObject
                                    , decodeStrictText)
import Data.Function
import Control.Arrow
import Control.Applicative
import Control.Monad
import Control.Concurrent
import Network.WebSockets           qualified as WS
import Control.Exception
import GHC.IO
import Control.Lens                 hiding ((.=))

-- import Control.Comonad
-- import Data.Functor.Foldable

import Compiler.RLPC
import Compiler.JustRun

-- import Misc.CofreeF
-- import Rlp.AltSyntax
-- import Rlp.HindleyMilner
-- import Rlp.AltParse
--------------------------------------------------------------------------------

server :: IO ()
server = do
    T.putStrLn "rlpc server started at 127.0.0.1:9002"
    WS.runServer "127.0.0.1" 9002 application

application :: WS.ServerApp
application pending = do
    WS.acceptRequest pending >>= talk

data Command = Annotate Text
             | PartiallyAnnotate Text
             | Evaluate Text
             deriving Show

instance FromJSON Command where
    parseJSON = withObject "command object" $ \v -> do
        cmd :: Text <- v .: "command"
        case cmd of
            "evaluate"           -> Evaluate <$> v .: "source"
            "annotate"           -> Annotate <$> v .: "source"
            "partially-annotate" -> PartiallyAnnotate <$> v .: "source"
            _                    -> empty

data Response = Annotated Value
              | PartiallyAnnotated Value
              | Evaluated Value
              | Error Value
              deriving (Generic)
              deriving (ToJSON)
                via Generically Response

talk :: WS.Connection -> IO ()
talk conn = (`catchAny` print) . forever $ do
    msg <- WS.receiveData @Text conn
    T.putStrLn $ "received: " <> msg
    doCommand conn `traverse` decodeStrictText msg

doCommand :: WS.Connection -> Command -> IO ()
doCommand conn c = do
    putStr "sending: "
    let r = encode . respond $ c
    print r
    WS.sendTextData conn r

respond :: Command -> Response
respond (Annotate s)
    = error "i'm a shitty programmer! try again with the dev branch lmfao"

respond (Evaluate s)
    = justLexParseGmEval (T.unpack s)
    & either (Error . toJSON) (Evaluated . toJSON)