{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}

import Thermoprint
import Thermoprint.Api
import PrintOut

import qualified Data.Text.Lazy             as TL
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Lazy.Char8 as Lazy (ByteString)
import qualified Data.Text                  as T    (pack)
import           Data.ByteString                    (ByteString)
import qualified Data.ByteString            as BS
  
import Data.Aeson
import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import GHC.Generics

import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Control.Monad.Trans.Either

import Control.Monad.Logger

import Options.Applicative

import System.IO hiding (print)

import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH

import Data.Int (Int64)

import Prelude hiding (print)

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Draft
  title String
  content PrintOut
  deriving Show
|]
                     

print :: Options -> Integer -> Block String -> EitherT ServantErr IO ()
print Options{..} printerNo printOut = do
  printerPath <- case genericIndex printers printerNo of
    Just path -> return path
    Nothing -> left $ err404 { errBody = "printerId out of bounds" }
  liftIO $ withFile printerPath WriteMode doPrint
  where
    doPrint handle = do
      hSetBuffering handle NoBuffering
      LBS.hPut handle $ render' printOut
    genericIndex :: Integral i => [a] -> i -> Maybe a
    genericIndex (x:_)  0 = Just x
    genericIndex (_:xs) n
      | n > 0     = genericIndex xs (n - 1)
      | otherwise = Nothing
    genericIndex _ _ = Nothing

withPool = flip runSqlPool

queryDrafts :: Options -> ConnectionPool -> EitherT ServantErr IO [(Int64, String)]
queryDrafts Options{..} cPool = withPool cPool $ do
  drafts <- selectList [] []
  return $ map deSQLify drafts
  where
    deSQLify :: Entity Draft -> (Int64, String)
    deSQLify (Entity k (Draft title _)) = (fromSqlKey k, title)

getDraft :: Options -> ConnectionPool -> Int64 -> EitherT ServantErr IO (String, Block String)
getDraft Options{..} cPool draftId = withPool cPool $ do
  draft <- get $ toSqlKey draftId
  case draft of
    Nothing -> lift $ left $ err404 { errBody = "no such draftId" }
    Just (Draft title content) -> return (title, content)

writeDraft :: Options -> ConnectionPool -> Int64 -> (String, Block String) -> EitherT ServantErr IO ()
writeDraft Options{..} cPool draftId (draftName, draft) = withPool cPool $ repsert (toSqlKey draftId) (Draft draftName draft)

addDraft :: Options -> ConnectionPool -> (String, Block String) -> EitherT ServantErr IO Int64
addDraft Options{..} cPool (draftName, draft) = withPool cPool $ (fromSqlKey <$> insert (Draft draftName draft))

delDraft :: Options -> ConnectionPool -> Int64 -> EitherT ServantErr IO ()
delDraft Options{..} cPool draftId = withPool cPool $ delete (toSqlKey draftId :: Key Draft)

data Options = Options
               { port :: Int
               , connStr :: String
               , connNmbr :: Int
               , printers :: [FilePath]
               }

server :: Options -> ConnectionPool -> Server ThermoprintApi
server opts cPool = print opts
               :<|> queryDrafts opts cPool
               :<|> addDraft opts cPool
               :<|> getDraft opts cPool
               :<|> writeDraft opts cPool
               :<|> delDraft opts cPool

options :: Parser Options
options = Options
          <$> option auto (
            long "port"
            <> short 'p'
            <> metavar "PORT"
            <> help "The port we'll run the server on"
            <> value 8080
            <> showDefault
            )
          <*> strOption (
            long "database"
            <> short 'd'
            <> metavar "STRING"
            <> help "The sqlite connection string to use (can inlude some options)"
            <> value "./storage.sqlite"
            <> showDefault
            )
          <*> option auto (
            long "database-connections"
            <> metavar "INT"
            <> help "The number of parallel sqlite connections to maintain"
            <> value 2
            <> showDefault
            )
          <*> some (strArgument (
                        metavar "PATH [...]"
                        <> help "Path to one of the printers to use"
                                ))

thermoprintApi :: Proxy ThermoprintApi
thermoprintApi = Proxy

main :: IO ()
main = do
  execParser opts >>= runNoLoggingT . main'
  where
    opts = info (helper <*> options) (
      fullDesc
      <> header "thermoprint-servant - A REST server for interacting with a cheap thermoprinter"
                                     )
    main' args@(Options{..}) = withSqlitePool (T.pack connStr) connNmbr $ main''
      where
        main'' cPool = do
          runSqlPool (runMigration migrateAll) cPool
          liftIO $ run port $ serve thermoprintApi (server args cPool)