{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}

-- | A client library for 'Thermoprint.API'
module Thermoprint.Client
       ( Client(..)
       , mkClient, mkClient'
       , throwNat, ioNat
       -- = Reexports
       , ServantError(..)
       , module Servant.Common.BaseUrl
       , module Control.Monad.Trans.Either
       , module Servant.Server.Internal.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 Servant.API
import Servant.Server.Internal.Enter
import Control.Monad.Trans.Either

import Control.Monad.Catch (Exception, MonadThrow(..))
import Control.Monad.IO.Class (MonadIO(..))

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

instance Exception ServantError

-- | 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' $ 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))
            -- ^ @jobs p minId maxId minTime maxTime@ lists 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

mkClient :: (EitherT ServantError IO :~> 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
-- ^ Generate a 'Client'
mkClient n url = Client{..}
  where
    printers
      :<|> (jobs :<|> jobCreate)
      :<|> (withArgs -> job :<|> (withArgs -> jobStatus :<|> jobDelete))
      :<|> (drafts :<|> draftCreate)
      :<|> (withArgs -> draftReplace :<|> (withArgs -> draft :<|> (withArgs -> draftDelete :<|> draftPrint)))
      = enter n $ client thermoprintAPI url

mkClient' :: (MonadThrow m, MonadIO m) => BaseUrl -> Client m
-- ^ @mkClient' = mkClient $ ioNat . throwNat@
mkClient' = mkClient $ ioNat . throwNat

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

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