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) | ||
