blob: 9d885596dcc9cbde2cdfedbe651113f9b1b18d28 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
import Thermoprint
import Thermoprint.Api
import Data.Aeson
import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import qualified Data.Text.Lazy as Text
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Data.ByteString.Lazy.Char8 (ByteString)
import GHC.Generics
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Either
import Options.Applicative
import System.IO
server :: Options -> Integer -> Block String -> EitherT ServantErr IO ()
server Options{..} printerNo printOut = do
printerPath <- case genericIndex printers printerNo of
Just path -> return path
Nothing -> left $ err404 { errBody = "printerId out of bounds" }
liftIO $ withFile printerPath WriteMode doPrint
where
doPrint handle = do
hSetBuffering handle NoBuffering
ByteString.hPut handle $ render' printOut
genericIndex :: Integral i => [a] -> i -> Maybe a
genericIndex (x:_) 0 = Just x
genericIndex (_:xs) n
| n > 0 = genericIndex xs (n - 1)
| otherwise = Nothing
genericIndex _ _ = Nothing
data Options = Options
{ port :: Int
, printers :: [FilePath]
}
options :: Parser Options
options = Options
<$> option auto (
long "port"
<> short 'p'
<> metavar "PORT"
<> help "The port we'll run the server on"
<> value 8080
<> showDefault
)
<*> some (strArgument (
metavar "PATH [...]"
<> help "Path to one of the printers to use"
))
thermoprintApi :: Proxy ThermoprintApi
thermoprintApi = Proxy
main :: IO ()
main = do
execParser opts >>= main'
where
opts = info (helper <*> options) (
fullDesc
<> header "thermoprint-servant - A REST server for interacting with a cheap thermoprinter"
)
main' args@(Options{..}) = run port $ serve thermoprintApi (server args)
|
