Introduced Range

3 files changed, 37 insertions, 19 deletions

diff --git a/client/src/Thermoprint/Client.hs b/client/src/Thermoprint/Client.hs
index 80045dd..2b99e7e 100644
--- a/client/src/Thermoprint/Client.hs
+++ b/client/src/Thermoprint/Client.hs
@@ -45,10 +45,8 @@ data Client m = Client
   { printers :: EitherT ServantError m (Map PrinterId PrinterStatus)
                 -- ^ List all printers
   , jobs :: Maybe PrinterId
-            -> Maybe JobId
-            -> Maybe JobId
-            -> Maybe UTCTime
-            -> Maybe UTCTime
+            -> Maybe (Range (JobId))
+            -> Maybe (Range (UTCTime))
             -> EitherT ServantError m (Seq (JobId, UTCTime, JobStatus))
             -- ^ @jobs p minId maxId minTime maxTime@ lists a selection of jobs
   , jobCreate :: Maybe PrinterId -> Printout -> EitherT ServantError m JobId
@@ -79,6 +77,7 @@ data Client m = Client
   }
 
 withArgs :: (x -> a :<|> b) -> ((x -> a) :<|> (x -> b))
+-- ^ Undo factoring of APIs
 withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI
 
 mkClient :: (IO :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can be constructed from 'IO'
diff --git a/server/src/Thermoprint/Server/API.hs b/server/src/Thermoprint/Server/API.hs
index cd4326e..3f3ab46 100644
--- a/server/src/Thermoprint/Server/API.hs
+++ b/server/src/Thermoprint/Server/API.hs
@@ -141,16 +141,13 @@ printerStatus = fmap queueToStatus . queue' . snd <=< lookupPrinter . Just
     queueToStatus (Queue _ (Just c) _) = Busy . castId $ jobId c
 
 listJobs :: Maybe PrinterId
-         -> Maybe API.JobId -> Maybe API.JobId
-         -> Maybe UTCTime   -> Maybe UTCTime
+         -> Maybe (Range API.JobId) -> Maybe (Range UTCTime)
          -> Handler (Seq (API.JobId, UTCTime, JobStatus))
-listJobs Nothing minId maxId minTime maxTime = fmap mconcat . mapM (\pId -> listJobs (Just pId) minId maxId minTime maxTime) =<< asks (Map.keys . printers)
-listJobs pId     minId maxId minTime maxTime = fmap (filterJobs . extractJobs) . (\(a, b) -> (,) a <$> queue' b) =<< lookupPrinter pId
+listJobs Nothing idR timeR = fmap mconcat . mapM (\pId -> listJobs (Just pId) idR timeR) =<< asks (Map.keys . printers)
+listJobs pId     idR timeR = fmap (filterJobs . extractJobs) . (\(a, b) -> (,) a <$> queue' b) =<< lookupPrinter pId
   where
-    filterJobs = Seq.filter (\(id, time, _) -> and ([ maybe True (<= id  ) minId
-                                                    , maybe True (>= id  ) maxId
-                                                    , maybe True (<= time) minTime
-                                                    , maybe True (>= time) maxTime
+    filterJobs = Seq.filter (\(id, time, _) -> and ([ maybe True (`contains` id) idR
+                                                    , maybe True (`contains` time) timeR
                                                     ] :: [Bool])
                             )
 
@@ -158,7 +155,7 @@ getJob :: API.JobId -> Handler Printout
 getJob jobId = fmap jobContent . maybe (left err404) return =<< runSqlPool (get $ castId jobId) =<< asks sqlPool
 
 jobStatus :: API.JobId -> Handler JobStatus
-jobStatus jobId = maybe (left err404) return . lookup jobId . map (\(id, _, st) -> (id, st)) . toList =<< listJobs Nothing Nothing Nothing Nothing Nothing
+jobStatus jobId = maybe (left err404) return . lookup jobId . map (\(id, _, st) -> (id, st)) . toList =<< listJobs Nothing Nothing Nothing
 
 abortJob :: API.JobId -> Handler ()
 abortJob needle = do
diff --git a/spec/src/Thermoprint/API.hs b/spec/src/Thermoprint/API.hs
index d854e73..5bfe431 100644
--- a/spec/src/Thermoprint/API.hs
+++ b/spec/src/Thermoprint/API.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE TypeOperators, DataKinds #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- | A specification of an API for interacting with a set of printers
 module Thermoprint.API
@@ -9,6 +10,7 @@ module Thermoprint.API
        , JobStatus(..)
        , PrintingError(..)
        , DraftTitle
+       , Range(..), contains
        , ThermoprintAPI
        , thermoprintAPI
        , module Thermoprint.Identifiers
@@ -21,6 +23,9 @@ import           Thermoprint.Identifiers
 import           Servant.API
 import           Data.Aeson
 
+import           Data.Monoid
+import           Data.Maybe
+
 import           Data.Set (Set)
 import           Data.Map (Map)
 import qualified Data.Map as Map (foldMapWithKey, singleton)
@@ -51,7 +56,6 @@ instance (Integral k, Ord k, ToJSON v) => ToJSON (Map k v) where
 instance (Enum k, Ord k, FromJSON v) => FromJSON (Map k v) where
   parseJSON = fmap (IntMap.foldMapWithKey $ Map.singleton . castId) . parseJSON
        
-
 data PrinterStatus = Busy JobId
                    | Available
                    deriving (Generic, Show, FromJSON, ToJSON)
@@ -81,13 +85,31 @@ instance FromText UTCTime where
 instance ToText UTCTime where
   toText = T.pack . formatTime defaultTimeLocale "%F_%T%Q"
 
+data Range a = Min a | Max a | Through a a
+
+contains :: Ord a => Range a -> a -> Bool
+-- ^ Check if a 'Range' contains a point
+contains (Min min) x = min <= x
+contains (Max max) x = max >= x
+contains (Through min max) x = min <= x && x <= max
+
+instance ToText a => ToText (Range a) where
+  toText (Min min) = toText min <> "-"
+  toText (Max max) = "-" <> toText max
+  toText (Through min max) = toText min <> "-" <> toText max
+  
+instance FromText a => FromText (Range a) where
+  fromText t = listToMaybe $ through <> max <> min
+    where
+      through = [ Through min max | ((fromText -> Just min), (T.uncons -> Just ('-', (fromText -> Just max)))) <- zip (T.inits t) (T.tails t) ]
+      min = [ Min min | (fromText -> Just min) <- T.inits t ]
+      max = [ Max max | (fromText -> Just max) <- T.tails t ]
+
 type ThermoprintAPI = "printers" :> Get '[JSON] (Map PrinterId PrinterStatus)
                       :<|> "jobs" :> (
-                        QueryParam "printer" PrinterId -- TODO: this is silly, introduce data Range a = Range { rMin :: a, rMax :: a }
-                          :> QueryParam "min" JobId
-                          :> QueryParam "max" JobId
-                          :> QueryParam "minTime" UTCTime
-                          :> QueryParam "maxTime" UTCTime
+                        QueryParam "printer" PrinterId
+                          :> QueryParam "jobId" (Range JobId)
+                          :> QueryParam "time" (Range UTCTime)
                           :> Get '[JSON] (Seq (JobId, UTCTime, JobStatus))
                         :<|> QueryParam "printer" PrinterId :> ReqBody '[JSON] Printout :> Post '[JSON] JobId
                       )