Working prototype

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 @@
+{-# 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 = undefined
+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)