From 005dc408dc09c3b479398ebe3e92efa2cd54846e Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 17 Oct 2015 02:26:25 +0200 Subject: Working prototype --- servant/api/Thermoprint/Api.hs | 28 +++++++++++++++++ servant/servant.cabal | 31 ++++++++++++++++-- servant/servant.nix | 5 +-- servant/src/Main.hs | 71 +++++++++++++++++++++++++++++++++++++++++- 4 files changed, 129 insertions(+), 6 deletions(-) create mode 100644 servant/api/Thermoprint/Api.hs (limited to 'servant') 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) -- cgit v1.2.3