{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

-- | A client library for 'Thermoprint.API'
module Thermoprint.Client
       ( Client(..)
       , mkClient, mkClient'
       , throwNat, ioNat
       -- = Reexports
       , ServantError(..)
       , module Thermoprint.API
       , module Servant.Common.BaseUrl
       , module Control.Monad.Except
       , module Servant.Utils.Enter
       ) where

import Thermoprint.API
import Data.Map (Map)
import Data.Sequence (Seq)
import Data.Time (UTCTime)

import Servant.Client hiding (HasClient(..))
import qualified Servant.Client as S
import Servant.Common.BaseUrl
import Network.HTTP.Client (Manager, ManagerSettings, newManager, defaultManagerSettings)
import Servant.API
import Servant.Utils.Enter
import Control.Monad.Except (ExceptT, runExceptT)

import Control.Monad.Reader (ReaderT, runReaderT, ask)
import Control.Monad.Catch (Exception, MonadThrow(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans (lift)

import Control.Monad
import Control.Category
import Prelude hiding (id, (.))

-- | All 'ThermoprintAPI'-functions as a record
--
-- Use like this:
--
-- > {-# LANGUAGE RecordWildCards #-}
-- > 
-- > main :: IO ()
-- > -- ^ Display a list of printers with their status
-- > main = print =<< printers
-- >   where Client{..} = mkClient' defaultManagerSettings $ Http "localhost" 3000
data Client m = Client
  { printers :: m (Map PrinterId PrinterStatus)
                -- ^ List all printers
  , jobs :: Maybe PrinterId
            -> Maybe (Range (JobId))
            -> Maybe (Range (UTCTime))
            -> m (Seq (JobId, UTCTime, JobStatus))
            -- ^ List a selection of jobs
  , jobCreate :: Maybe PrinterId -> Printout -> m JobId
                 -- ^ Send a 'Printout' to be queued
  , job :: JobId -> m Printout
           -- ^ Retrieve the contents of a job
  , jobStatus :: JobId -> m JobStatus
                 -- ^ Query a jobs status
  , jobDelete :: JobId -> m ()
                 -- ^ Delete a job from the queue (not from history or while it is being printed)
  , drafts :: m (Map DraftId (Maybe DraftTitle))
              -- ^ List all saved drafts
  , draftCreate :: Maybe DraftTitle
                -> Printout
                -> m DraftId
                -- ^ Create a new draft
  , draftReplace :: DraftId
                 -> Maybe DraftTitle
                 -> Printout
                 -> m ()
                 -- ^ Replace the contents and title of an existing draft
  , draft :: DraftId -> m (Maybe DraftTitle, Printout)
             -- ^ Retrieve the contents and title of a draft
  , draftDelete :: DraftId -> m ()
                   -- ^ Delete a draft
  , draftPrint :: DraftId -> Maybe PrinterId -> m JobId
                  -- ^ Send a draft to be printed
  }

withArgs :: (x -> a :<|> b) -> ((x -> a) :<|> (x -> b))
-- ^ Undo factoring of APIs
withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI

mkClientS :: Monad m
          => (ClientM :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can do 'IO' and handle errors
          -> ManagerSettings
          -> BaseUrl
          -> Client m
-- ^ Generate a 'Client'
mkClientS n mgrS url = Client
                       { printers = clientF n printers
                       , jobs = \a b c -> clientF n $ jobs a b c
                       , jobCreate = \a b -> clientF n $ jobCreate a b
                       , job = \a -> clientF n $ job a
                       , jobStatus = \a -> clientF n $ jobStatus a
                       , jobDelete = \a -> clientF n $ jobDelete a
                       , drafts = clientF n drafts
                       , draftCreate = \a b -> clientF n $ draftCreate a b
                       , draftReplace = \a b c -> clientF n $ draftReplace a b c
                       , draft = \a -> clientF n $ draft a
                       , draftDelete = \a -> clientF n $ draftDelete a
                       , draftPrint = \a b -> clientF n $ draftPrint a b
                       }
  where
    clientF :: Monad m => (ClientM :~> m) -> (Manager -> BaseUrl -> m a) -> m a
    clientF n f = do
      mgr <- unNat n $ (liftIO $ newManager mgrS :: ClientM Manager)
      f mgr url
    printers
      :<|> (jobs :<|> jobCreate)
      :<|> (withArgs -> job :<|> (withArgs -> jobStatus :<|> jobDelete))
      :<|> (drafts :<|> draftCreate)
      :<|> (withArgs -> draftReplace :<|> (withArgs -> draft :<|> (withArgs -> draftDelete :<|> draftPrint)))
      = enter n $ client thermoprintAPI

mkClient :: Monad m
         => (ClientM :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can do 'IO' and handle errors
         -> BaseUrl
         -> Client m
mkClient n url = mkClientS n defaultManagerSettings url
  
mkClient' :: (MonadThrow m, MonadIO m) => BaseUrl -> Client m
-- ^ @mkClient' = mkClient $ ioNat . throwNat@
mkClient' = mkClient $ ioNat . throwNat

throwNat :: (Exception e, MonadThrow m) => ExceptT e m :~> m
-- ^ Squash a layer of 'EitherT' into the underlying monad supporting 'throwM'
throwNat = Nat $ either throwM return <=< runExceptT

ioNat :: MonadIO m => IO :~> m
-- ^ @ioNat = Nat liftIO@
ioNat = Nat liftIO

readerNat :: a -> ReaderT a m :~> m
readerNat a = Nat $ flip runReaderT a