{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Jon.Server (JonAPI, jonSwaggerDoc, server) where

import Control.Lens
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON(parseJSON), ToJSON(toJSON))
import Data.Text (Text)
import Data.Int (Int32, Int64)
import Data.Scientific (Scientific)
import Data.Swagger
import Database.PostgreSQL.Simple (Connection)
import GHC.Generics (Generic)
import Servant
import Servant.Swagger (toSwagger)

import Jon.Garfield.Types

import qualified Jon.Garfield.Queries as Queries

-- API and types

type JonAPI =
    "rpc" :>
        (    "getUnsoundBarcodes"   :> Summary "Get information on barcodes with at least two items"
                                    :> ReqBody '[JSON] GetUnsoundBarcodesP
                                    :> Post '[JSON] [UnsoundBarcodeDTO]
        :<|> "getOverviewItems"     :> Summary "Get overview of all active items"
                                    :> ReqBody '[JSON] GetOverviewItemsP
                                    :> Post '[JSON] [OverviewItemDTO]
        :<|> "getActiveItems"       :> Summary "Get currently active items for a barcode"
                                    :> ReqBody '[JSON] GetActiveItemsP
                                    :> Post '[JSON] [OverviewItemDTO]
        :<|> "getLocations"         :> Summary "Get a list of all locations"
                                    :> Post '[JSON] [Location]
        :<|> "adjustInventory"      :> ReqBody '[JSON] AdjustInventoryP
                                    :> PostNoContent
        :<|> "transferInventory"    :> Summary "Transfer inventory between items"
                                    :> Description "If `amount` is negative, its absolute value is transferred in the opposite direction."
                                    :> ReqBody '[JSON] TransferInventoryP
                                    :> PostNoContent
        :<|> "disableItems"         :> Summary "Disable inventory items"
                                    :> ReqBody '[JSON] DisableItemsP
                                    :> PostNoContent
        :<|> SnackAPI
        )

type SnackAPI =
             "createSnack"          :> Summary "Create a snack"
                                    :> ReqBody '[JSON] CreateSnackP
                                    :> Post '[JSON] SnackId
        :<|> "getSnacksByItemId"    :> Summary "Get active snacks by item id"
                                    :> ReqBody '[JSON] GetSnacksByItemIdP
                                    :> Post '[JSON] [Snack]
        :<|> "updateSnack"          :> Summary "Update a snack"
                                    :> ReqBody '[JSON] UpdateSnackP
                                    :> Post '[JSON] SnackId
        :<|> "deleteSnack"          :> Summary "Delete a snack"
                                    :> ReqBody '[JSON] DeleteSnackP
                                    :> PostNoContent

data GetUnsoundBarcodesP = GetUnsoundBarcodesP
    { location :: LocationId
    } deriving (Generic, FromJSON, ToSchema)

data UnsoundBarcodeDTO = UnsoundBarcodeDTO
    { barcode   :: Text
    , name      :: Text
    , entries   :: Int
    , unitsLeft :: Int
    } deriving (Generic, ToJSON, ToSchema)

data GetOverviewItemsP = GetOverviewItemsP
    { location :: LocationId
    } deriving (Generic, FromJSON, ToSchema)

data OverviewItemDTO = OverviewItemDTO
    { overview :: Overview
    , item     :: InventoryItem
    } deriving (Generic, ToJSON, ToSchema)

mkOverviewItemDTO = uncurry OverviewItemDTO

data GetActiveItemsP = GetActiveItemsP
    { barcode  :: Text
    , location :: LocationId
    } deriving (Generic, FromJSON, ToSchema)

data AdjustInventoryP = AdjustInventoryP
    { item        :: InventoryItemId
    , amount      :: Int64
    , description :: Text
    } deriving (Generic, FromJSON, ToSchema)

data TransferInventoryP = TransferInventoryP
    { transfers :: [InventoryTransferDTO]
    } deriving (Generic, FromJSON, ToSchema)

data InventoryTransferDTO = InventoryTransfer
    { from   :: InventoryItemId
    , to     :: InventoryItemId
    , amount :: Int64
    } deriving (Generic, FromJSON, ToSchema)

data DisableItemsP = DisableItemsP
    { items :: [InventoryItemId]
    } deriving (Generic, FromJSON, ToSchema)

data CreateSnackP = CreateSnackP
    { name     :: Text
    , barcode  :: Text
    , price    :: Scientific
    , taxGroup :: TaxGroupId
    , location :: LocationId
    } deriving (Generic, FromJSON, ToSchema)

data GetSnacksByItemIdP = GetSnacksByItemIdP
    { item :: InventoryItemId
    } deriving (Generic, FromJSON, ToSchema)

data UpdateSnackP = UpdateSnackP
    { snack    :: SnackId
    , name     :: Text
    , barcode  :: Text
    , price    :: Scientific
    , taxGroup :: TaxGroupId
    } deriving (Generic, FromJSON, ToSchema)

data DeleteSnackP = DeleteSnackP
    { snack :: SnackId
    } deriving (Generic, FromJSON, ToSchema)

-- Orphan instances for database types
-- needed for serialization and swagger doc

instance ToJSON InventoryItemId where
    toJSON = toJSON . (.unInventoryItemId)
instance FromJSON InventoryItemId where
    parseJSON = fmap mkInventoryItemId . parseJSON
instance ToSchema InventoryItemId where
    declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)

instance ToJSON InventoryItemGroupId where
    toJSON = toJSON . (.unInventoryItemGroupId)
instance ToSchema InventoryItemGroupId where
    declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)

instance ToJSON TaxGroupId where
    toJSON = toJSON . (.unTaxGroupId)
instance FromJSON TaxGroupId where
    parseJSON = fmap mkTaxGroupId . parseJSON
instance ToSchema TaxGroupId where
    declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)

instance ToJSON LocationId where
    toJSON = toJSON . (.unLocationId)
instance FromJSON LocationId where
    parseJSON = fmap mkLocationId . parseJSON
instance ToSchema LocationId where
    declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)

instance ToJSON SnackId where
    toJSON = toJSON . (.unSnackId)
instance FromJSON SnackId where
    parseJSON = fmap mkSnackId . parseJSON
instance ToSchema SnackId where
    declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)

deriving instance ToJSON Overview
deriving instance ToSchema Overview

deriving instance ToJSON InventoryItem
deriving instance ToSchema InventoryItem

deriving instance ToJSON Location
deriving instance ToSchema Location

deriving instance ToJSON Snack
deriving instance ToSchema Snack

-- server

server :: Connection -> Server JonAPI
server conn =
    getUnsoundBarcodes
    :<|> getOverviewItems
    :<|> getActiveItems
    :<|> getLocations
    :<|> adjustInventory
    :<|> transferInventory
    :<|> disableItems
    :<|> createSnack
    :<|> getSnacksByItemId
    :<|> updateSnack
    :<|> deleteSnack
    where
        getUnsoundBarcodes :: GetUnsoundBarcodesP -> Handler [UnsoundBarcodeDTO]
        getUnsoundBarcodes params = do
            rows <- liftIO $ Queries.runSelect conn $ Queries.unsoundBarcodes params.location
            pure $ map mkUnsoundBarcodeDTO rows
            where
                mkUnsoundBarcodeDTO (a, b, c, d) = UnsoundBarcodeDTO a b (fromIntegral c) (fromIntegral d)

        getOverviewItems :: GetOverviewItemsP -> Handler [OverviewItemDTO]
        getOverviewItems params = do
            rows <- liftIO $ Queries.runSelect conn $ Queries.overviewItemsByLocation params.location
            pure $ map mkOverviewItemDTO rows
        
        getActiveItems :: GetActiveItemsP -> Handler [OverviewItemDTO]
        getActiveItems params = do
            rows <- liftIO $ Queries.runSelect conn $ Queries.activeItems params.barcode params.location
            pure $ map mkOverviewItemDTO rows

        getLocations :: Handler [Location]
        getLocations = do
            liftIO $ Queries.runSelect conn Queries.locations
        
        adjustInventory params = do
            liftIO $ Queries.runInserts conn [Queries.adjustInventory params.item params.amount params.description]
            pure NoContent

        transferInventory :: TransferInventoryP -> Handler NoContent
        transferInventory params = do
            liftIO $ Queries.runInserts conn $ map (\t -> Queries.transfer t.from t.to t.amount) params.transfers
            pure NoContent
        
        disableItems :: DisableItemsP -> Handler NoContent
        disableItems params = do
            liftIO $ Queries.runUpdates conn $ map Queries.disableItem params.items
            pure NoContent
        
        createSnack params = do
            liftIO $ Queries.runFunction conn $ Queries.snackCreate
                params.name
                params.barcode
                params.price
                params.taxGroup
                params.location
        
        getSnacksByItemId params = do
            liftIO $ Queries.runSelect conn $ Queries.getSnacksByItemId params.item
        
        updateSnack params = do
            liftIO $ Queries.runFunction conn $ Queries.snackUpdate
                params.snack
                params.name
                params.barcode
                params.price
                params.taxGroup

        deleteSnack params = do
            liftIO $ Queries.runFunction conn $ Queries.snackDelete params.snack
            pure NoContent

jonSwaggerDoc :: Swagger
jonSwaggerDoc = toSwagger (Proxy :: Proxy JonAPI)
    & info . title   .~ "jon API"
    & info . version .~ "0.1.1"
    & applyTags [Tag "jon RPC" (Just "Crudely improvised Garfield API") Nothing]
    -- Doesn't work :(
    -- & applyTagsFor (operationsOf $ toSwagger (Proxy :: Proxy SnackAPI)) [Tag "Snacks" Nothing Nothing]