Working prototype

4 files changed, 129 insertions, 6 deletions

diff --git a/servant/api/Thermoprint/Api.hs b/servant/api/Thermoprint/Api.hs
new file mode 100644
index 0000000..bd5744b
--- /dev/null
+++ b/servant/api/Thermoprint/Api.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE DataKinds, TypeOperators, DeriveGeneric #-}
+
+module Thermoprint.Api
+       ( ThermoprintApi
+       ) where
+
+import Thermoprint
+import Data.Aeson
+import Servant.API
+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
+
+instance ToJSON ByteString where
+  toJSON = toJSON . Text.pack . ByteString.unpack
+instance FromJSON ByteString where
+  parseJSON value = (ByteString.pack . Text.unpack) `liftM` parseJSON value
+
+instance ToJSON c => ToJSON (Inline c)
+instance FromJSON c => FromJSON (Inline c)
+
+instance ToJSON c => ToJSON (Block c)
+instance FromJSON c => FromJSON (Block c)
+
+type ThermoprintApi = "print" :> Capture "printerId" Integer :> ReqBody '[JSON] (Block String) :> Post '[JSON] ()
diff --git a/servant/servant.cabal b/servant/servant.cabal
index b509dbc..b877196 100644
--- a/servant/servant.cabal
+++ b/servant/servant.cabal
@@ -16,11 +16,36 @@ build-type:          Simple
 -- extra-source-files:  
 cabal-version:       >=1.10
 
+library
+  exposed-modules:     Thermoprint.Api
+  hs-source-dirs:      api
+  default-language:    Haskell2010
+  other-extensions:    DataKinds
+                     , TypeOperators
+                     , DeriveGeneric
+  build-depends:       base >=4.8 && <4.9
+                     , thermoprint
+                     , aeson >=0.9.0 && <0.10
+                     , servant >=0.4.4 && <0.5
+                     , text >=1.2.1 && <4.5
+                     , bytestring >=0.10.6 && <0.11
+
 executable thermoprint
   main-is:             Main.hs
+  hs-source-dirs:      src
+  default-language:    Haskell2010
   -- other-modules:       
-  -- other-extensions:    
+  other-extensions:    RecordWildCards
+                     , OverloadedStrings
   build-depends:       base >=4.8 && <4.9
                      , thermoprint
-  hs-source-dirs:      src
-  default-language:    Haskell2010
\ No newline at end of file
+                     , thermoprint-servant
+                     , aeson >=0.9.0 && <0.10
+                     , wai >=3.0.3 && <3.1
+                     , servant-server >=0.4.4 && <0.5
+                     , warp >=3.1.3 && <3.2
+                     , text >=1.2.1 && <1.3
+                     , bytestring >=0.10.6 && <0.11
+                     , either >=4.4.1 && <4.5
+                     , optparse-applicative >=0.11.0 && <0.12
+                     , transformers >=0.4.2 && <0.5
\ No newline at end of file
diff --git a/servant/servant.nix b/servant/servant.nix
index 6c90a4f..a84fc77 100644
--- a/servant/servant.nix
+++ b/servant/servant.nix
@@ -2,16 +2,17 @@
 , stdenv
 , base
 , thermoprint
+, aeson, wai, servant-server, warp, optparse-applicative
 }:
 
 mkDerivation {
   pname = "thermoprint-servant";
   version = "0.0.0";
   src = ./.; 
-  isLibrary = false;
+  isLibrary = true;
   isExecutable = true;
   executableHaskellDepends = [
-    base thermoprint
+    base thermoprint aeson wai servant-server warp optparse-applicative
   ];
   homepage = "git://git.yggdrasil.li/thermoprint";
   description = "Server for interfacing to cheap thermoprinters";
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)