From a805783f4bb2868e63ba49a911775fff30df5a07 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 18 Feb 2016 15:04:19 +0100
Subject: Introduced Range

---
 spec/src/Thermoprint/API.hs | 34 ++++++++++++++++++++++++++++------
 1 file changed, 28 insertions(+), 6 deletions(-)

(limited to 'spec/src/Thermoprint/API.hs')

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
                       )
-- 
cgit v1.2.3