{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeOperators              #-}
{-# OPTIONS_GHC -fno-warn-missing-methods #-}


module Server where


import           Control.Monad.Reader      (MonadIO, MonadReader (..),
                                            ReaderT (..), liftIO)
import           Data.FileEmbed            (embedFile)
import           Data.Proxy                (Proxy (..))
import           Data.Text.Encoding        (decodeUtf8)
import           Database.Beam             (all_, default_, delete, filter_,
                                            insert, insertExpressions,
                                            primaryKey, runDelete,
                                            runSelectReturningList,
                                            runSelectReturningOne, runUpdate,
                                            save, select, val_, (==.))
import           Database.Beam.Sqlite      (SqliteM, runBeamSqlite,
                                            runInsertReturningList)
import           Database.SQLite.Simple    (Connection, Query (..), execute_,
                                            open)
import           Network.Wai               (Application)
import           Network.Wai.Handler.Warp  (run)
import           Options.Applicative       (Parser, ParserInfo, auto,
                                            execParser, fullDesc, header,
                                            helper, info, long, metavar, option,
                                            progDesc, short, showDefault,
                                            strOption, value, (<**>))
import           Servant.API
import           Servant.Server            (Server, hoistServer, serve)

import           Shpadoinkle               (JSM, type (~>))
import           Shpadoinkle.Router        (MonadJSM)
import           Shpadoinkle.Router.Server (serveUI)
import           Shpadoinkle.Run           (Env (Prod))

import           Types
import           View


data Options = Options
  { assets :: FilePath
  , port   :: Int
  }


newtype App a = App { runApp :: ReaderT Connection IO a }
  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader Connection)


toHandler :: MonadIO m => Connection -> App ~> m
toHandler c a = liftIO $ runReaderT (runApp a) c


parser :: Parser Options
parser = Options
  <$> strOption   (long "assets" <> short 'a' <> metavar "FILEPATH")
  <*> option auto (long "port"   <> short 'p' <> metavar "PORT" <> showDefault <> value 8080)


options :: ParserInfo Options
options = info (parser <**> helper) $
    fullDesc <> progDesc "Servant CRUD Example"
             <> header "Space craft manager as an example of Shpadoinkle"


runSql :: (MonadIO m, MonadReader Connection m) => SqliteM ~> m
runSql x = do conn <- ask; liftIO $ runBeamSqlite conn x


newtype Noop a = Noop (JSM a)
  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadJSM)
  deriving anyclass CRUDSpaceCraft


instance CRUDSpaceCraft App where

  listSpaceCraft =
    runSql . runSelectReturningList . select . all_ $ _roster db

  getSpaceCraft i =
    runSql . runSelectReturningOne . select
           . filter_ (\s -> val_ (SpaceCraftKey i) ==. primaryKey s) . all_ $ _roster db

  updateSpaceCraft i SpaceCraftUpdate {..} =
    runSql . runUpdate $ save (_roster db) $
      SpaceCraft i _sku _description _serial _squadron _operable

  deleteSpaceCraft i =
    runSql . runDelete $ delete (_roster db) $ \sc -> val_ (SpaceCraftKey i) ==. primaryKey sc

  createSpaceCraft SpaceCraftUpdate {..} =
    runSql . fmap (_identity . head) . runInsertReturningList . insert (_roster db) $ insertExpressions
        [ SpaceCraft default_ (val_ _sku) (val_ _description) (val_ _serial) (val_ _squadron) (val_ _operable) ]


app :: Env -> Connection -> FilePath -> Application
app ev conn root = serve (Proxy @ (API :<|> SPA App)) $ serveApi :<|> serveSpa
  where

  serveApi :: Server API
  serveApi = hoistServer (Proxy @ API) (toHandler conn)
       $ listSpaceCraft
    :<|> getSpaceCraft
    :<|> updateSpaceCraft
    :<|> createSpaceCraft
    :<|> deleteSpaceCraft

  serveSpa :: Server (SPA App)
  serveSpa = serveUI @ (SPA App) root
    (\r -> toHandler conn $ do
      i <- start r; return . template ev i $ view @ Noop i) routes


application :: Env -> FilePath -> IO Application
application ev assets = do
  conn <- open "roster.db"
  execute_ conn . Query $ decodeUtf8 $(embedFile "./servant-crud/migrate.sql")
  return $ app ev conn assets


main :: IO ()
main = do
  Options {..} <- execParser options
  run port =<< application Prod assets