diff options
Diffstat (limited to 'spec')
| -rw-r--r-- | spec/src/Thermoprint/API.hs | 34 | 
1 files changed, 28 insertions, 6 deletions
| 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 @@ | |||
| 2 | {-# LANGUAGE TypeOperators, DataKinds #-} | 2 | {-# LANGUAGE TypeOperators, DataKinds #-} | 
| 3 | {-# LANGUAGE StandaloneDeriving #-} | 3 | {-# LANGUAGE StandaloneDeriving #-} | 
| 4 | {-# LANGUAGE OverloadedStrings #-} | 4 | {-# LANGUAGE OverloadedStrings #-} | 
| 5 | {-# LANGUAGE ViewPatterns #-} | ||
| 5 | 6 | ||
| 6 | -- | A specification of an API for interacting with a set of printers | 7 | -- | A specification of an API for interacting with a set of printers | 
| 7 | module Thermoprint.API | 8 | module Thermoprint.API | 
| @@ -9,6 +10,7 @@ module Thermoprint.API | |||
| 9 | , JobStatus(..) | 10 | , JobStatus(..) | 
| 10 | , PrintingError(..) | 11 | , PrintingError(..) | 
| 11 | , DraftTitle | 12 | , DraftTitle | 
| 13 | , Range(..), contains | ||
| 12 | , ThermoprintAPI | 14 | , ThermoprintAPI | 
| 13 | , thermoprintAPI | 15 | , thermoprintAPI | 
| 14 | , module Thermoprint.Identifiers | 16 | , module Thermoprint.Identifiers | 
| @@ -21,6 +23,9 @@ import Thermoprint.Identifiers | |||
| 21 | import Servant.API | 23 | import Servant.API | 
| 22 | import Data.Aeson | 24 | import Data.Aeson | 
| 23 | 25 | ||
| 26 | import Data.Monoid | ||
| 27 | import Data.Maybe | ||
| 28 | |||
| 24 | import Data.Set (Set) | 29 | import Data.Set (Set) | 
| 25 | import Data.Map (Map) | 30 | import Data.Map (Map) | 
| 26 | import qualified Data.Map as Map (foldMapWithKey, singleton) | 31 | import qualified Data.Map as Map (foldMapWithKey, singleton) | 
| @@ -51,7 +56,6 @@ instance (Integral k, Ord k, ToJSON v) => ToJSON (Map k v) where | |||
| 51 | instance (Enum k, Ord k, FromJSON v) => FromJSON (Map k v) where | 56 | instance (Enum k, Ord k, FromJSON v) => FromJSON (Map k v) where | 
| 52 | parseJSON = fmap (IntMap.foldMapWithKey $ Map.singleton . castId) . parseJSON | 57 | parseJSON = fmap (IntMap.foldMapWithKey $ Map.singleton . castId) . parseJSON | 
| 53 | 58 | ||
| 54 | |||
| 55 | data PrinterStatus = Busy JobId | 59 | data PrinterStatus = Busy JobId | 
| 56 | | Available | 60 | | Available | 
| 57 | deriving (Generic, Show, FromJSON, ToJSON) | 61 | deriving (Generic, Show, FromJSON, ToJSON) | 
| @@ -81,13 +85,31 @@ instance FromText UTCTime where | |||
| 81 | instance ToText UTCTime where | 85 | instance ToText UTCTime where | 
| 82 | toText = T.pack . formatTime defaultTimeLocale "%F_%T%Q" | 86 | toText = T.pack . formatTime defaultTimeLocale "%F_%T%Q" | 
| 83 | 87 | ||
| 88 | data Range a = Min a | Max a | Through a a | ||
| 89 | |||
| 90 | contains :: Ord a => Range a -> a -> Bool | ||
| 91 | -- ^ Check if a 'Range' contains a point | ||
| 92 | contains (Min min) x = min <= x | ||
| 93 | contains (Max max) x = max >= x | ||
| 94 | contains (Through min max) x = min <= x && x <= max | ||
| 95 | |||
| 96 | instance ToText a => ToText (Range a) where | ||
| 97 | toText (Min min) = toText min <> "-" | ||
| 98 | toText (Max max) = "-" <> toText max | ||
| 99 | toText (Through min max) = toText min <> "-" <> toText max | ||
| 100 | |||
| 101 | instance FromText a => FromText (Range a) where | ||
| 102 | fromText t = listToMaybe $ through <> max <> min | ||
| 103 | where | ||
| 104 | through = [ Through min max | ((fromText -> Just min), (T.uncons -> Just ('-', (fromText -> Just max)))) <- zip (T.inits t) (T.tails t) ] | ||
| 105 | min = [ Min min | (fromText -> Just min) <- T.inits t ] | ||
| 106 | max = [ Max max | (fromText -> Just max) <- T.tails t ] | ||
| 107 | |||
| 84 | type ThermoprintAPI = "printers" :> Get '[JSON] (Map PrinterId PrinterStatus) | 108 | type ThermoprintAPI = "printers" :> Get '[JSON] (Map PrinterId PrinterStatus) | 
| 85 | :<|> "jobs" :> ( | 109 | :<|> "jobs" :> ( | 
| 86 | QueryParam "printer" PrinterId -- TODO: this is silly, introduce data Range a = Range { rMin :: a, rMax :: a } | 110 | QueryParam "printer" PrinterId | 
| 87 | :> QueryParam "min" JobId | 111 | :> QueryParam "jobId" (Range JobId) | 
| 88 | :> QueryParam "max" JobId | 112 | :> QueryParam "time" (Range UTCTime) | 
| 89 | :> QueryParam "minTime" UTCTime | ||
| 90 | :> QueryParam "maxTime" UTCTime | ||
| 91 | :> Get '[JSON] (Seq (JobId, UTCTime, JobStatus)) | 113 | :> Get '[JSON] (Seq (JobId, UTCTime, JobStatus)) | 
| 92 | :<|> QueryParam "printer" PrinterId :> ReqBody '[JSON] Printout :> Post '[JSON] JobId | 114 | :<|> QueryParam "printer" PrinterId :> ReqBody '[JSON] Printout :> Post '[JSON] JobId | 
| 93 | ) | 115 | ) | 
