aboutsummaryrefslogtreecommitdiff
path: root/spec/src/Thermoprint/API.hs
diff options
context:
space:
mode:
authorGregor Kleen <pngwjpgh@users.noreply.github.com>2016-07-17 19:21:56 +0200
committerGregor Kleen <pngwjpgh@users.noreply.github.com>2016-07-17 19:21:56 +0200
commit2b9ceaead3f3cd80e973cccecb9a3eebc51154f7 (patch)
treedf2378943480647606b6a06f62c0f4b8b2ab406d /spec/src/Thermoprint/API.hs
parentac4cf4a0a494eafe55364f816569c517684fdf32 (diff)
downloadthermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar
thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar.gz
thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar.bz2
thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar.xz
thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.zip
Fixes for GHC 8.0.1
Diffstat (limited to 'spec/src/Thermoprint/API.hs')
-rw-r--r--spec/src/Thermoprint/API.hs32
1 files changed, 14 insertions, 18 deletions
diff --git a/spec/src/Thermoprint/API.hs b/spec/src/Thermoprint/API.hs
index 9e91487..8e98db8 100644
--- a/spec/src/Thermoprint/API.hs
+++ b/spec/src/Thermoprint/API.hs
@@ -100,12 +100,6 @@ instance Exception PrintingError
100 100
101type DraftTitle = Text 101type DraftTitle = Text
102 102
103instance FromText UTCTime where
104 fromText = parseTimeM True defaultTimeLocale "%F_%T%Q" . T.unpack
105
106instance ToText UTCTime where
107 toText = T.pack . formatTime defaultTimeLocale "%F_%T%Q"
108
109data Range a = Min a | Max a | Through a a 103data Range a = Min a | Max a | Through a a
110 deriving (Show, Eq, Generic) 104 deriving (Show, Eq, Generic)
111 105
@@ -121,17 +115,19 @@ contains (Min min) x = min <= x
121contains (Max max) x = max >= x 115contains (Max max) x = max >= x
122contains (Through min max) x = min <= x && x <= max 116contains (Through min max) x = min <= x && x <= max
123 117
124instance ToText a => ToText (Range a) where 118instance ToHttpApiData a => ToHttpApiData (Range a) where
125 toText (Min min) = toText min <> "-" 119 toUrlPiece (Min min) = toUrlPiece min <> "-"
126 toText (Max max) = "-" <> toText max 120 toUrlPiece (Max max) = "-" <> toUrlPiece max
127 toText (Through min max) = toText min <> "-" <> toText max 121 toUrlPiece (Through min max) = toUrlPiece min <> "-" <> toUrlPiece max
128 122
129instance FromText a => FromText (Range a) where 123instance FromHttpApiData a => FromHttpApiData (Range a) where
130 fromText t = listToMaybe $ through <> max <> min 124 parseUrlPiece t = listToEither $ through <> max <> min
131 where 125 where
132 through = [ Through min max | ((fromText -> Just min), (T.uncons -> Just ('-', (fromText -> Just max)))) <- zip (T.inits t) (T.tails t) ] 126 through = [ Through min max | ((parseUrlPiece -> Right min), (T.uncons -> Just ('-', (parseUrlPiece -> Right max)))) <- zip (T.inits t) (T.tails t) ]
133 min = [ Min min | (fromText -> Just min) <- T.inits t ] 127 min = [ Min min | (parseUrlPiece -> Right min) <- T.inits t ]
134 max = [ Max max | (fromText -> Just max) <- T.tails t ] 128 max = [ Max max | (parseUrlPiece -> Right max) <- T.tails t ]
129 listToEither [x] = Right x
130 listToEither _ = Left t
135 131
136type ThermoprintAPI = "printers" :> Get '[JSON] (Map PrinterId PrinterStatus) 132type ThermoprintAPI = "printers" :> Get '[JSON] (Map PrinterId PrinterStatus)
137 :<|> "jobs" :> ( 133 :<|> "jobs" :> (
@@ -144,16 +140,16 @@ type ThermoprintAPI = "printers" :> Get '[JSON] (Map PrinterId PrinterStatus)
144 :<|> "job" :> Capture "jobId" JobId :> ( 140 :<|> "job" :> Capture "jobId" JobId :> (
145 Get '[JSON] Printout 141 Get '[JSON] Printout
146 :<|> "status" :> Get '[JSON] JobStatus 142 :<|> "status" :> Get '[JSON] JobStatus
147 :<|> Delete '[PlainText] () 143 :<|> Delete '[JSON] ()
148 ) 144 )
149 :<|> "drafts" :> ( 145 :<|> "drafts" :> (
150 Get '[JSON] (Map DraftId (Maybe DraftTitle)) 146 Get '[JSON] (Map DraftId (Maybe DraftTitle))
151 :<|> QueryParam "title" DraftTitle :> ReqBody '[JSON] Printout :> Post '[JSON] DraftId 147 :<|> QueryParam "title" DraftTitle :> ReqBody '[JSON] Printout :> Post '[JSON] DraftId
152 ) 148 )
153 :<|> "draft" :> Capture "draftId" DraftId :> ( 149 :<|> "draft" :> Capture "draftId" DraftId :> (
154 QueryParam "title" DraftTitle :> ReqBody '[JSON] Printout :> Put '[PlainText] () 150 QueryParam "title" DraftTitle :> ReqBody '[JSON] Printout :> Put '[JSON] ()
155 :<|> Get '[JSON] (Maybe DraftTitle, Printout) 151 :<|> Get '[JSON] (Maybe DraftTitle, Printout)
156 :<|> Delete '[PlainText] () 152 :<|> Delete '[JSON] ()
157 :<|> QueryParam "printer" PrinterId :> Post '[JSON] JobId 153 :<|> QueryParam "printer" PrinterId :> Post '[JSON] JobId
158 ) 154 )
159 155