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