From 9db2c42f4880362cf098358de830415c14f6878c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 25 Dec 2015 17:56:13 +0000
Subject: Cleaned tree for rewrite

---
 servant/src/Main.hs | 158 ----------------------------------------------------
 1 file changed, 158 deletions(-)
 delete mode 100644 servant/src/Main.hs

(limited to 'servant/src/Main.hs')

diff --git a/servant/src/Main.hs b/servant/src/Main.hs
deleted file mode 100644
index 0aa9eeb..0000000
--- a/servant/src/Main.hs
+++ /dev/null
@@ -1,158 +0,0 @@
-{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
-{-# LANGUAGE EmptyDataDecls             #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE GADTs                      #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE QuasiQuotes                #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeFamilies               #-}
-
-import Thermoprint
-import Thermoprint.Api
-import PrintOut
-
-import qualified Data.Text.Lazy             as TL
-import qualified Data.ByteString.Lazy.Char8 as LBS
-import qualified Data.ByteString.Lazy.Char8 as Lazy (ByteString)
-import qualified Data.Text                  as T    (pack)
-import           Data.ByteString                    (ByteString)
-import qualified Data.ByteString            as BS
-  
-import Data.Aeson
-import Network.Wai
-import Network.Wai.Handler.Warp
-import Servant
-import GHC.Generics
-
-import Control.Monad
-import Control.Monad.Trans.Class
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Either
-
-import Control.Monad.Logger
-
-import Options.Applicative
-
-import System.IO hiding (print)
-
-import Database.Persist
-import Database.Persist.Sqlite
-import Database.Persist.TH
-
-import Data.Int (Int64)
-
-import Prelude hiding (print)
-
-share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
-Draft
-  title String
-  content PrintOut
-  deriving Show
-|]
-                     
-
-print :: Options -> Integer -> Block String -> EitherT ServantErr IO ()
-print 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
-      LBS.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
-
-withPool = flip runSqlPool
-
-queryDrafts :: Options -> ConnectionPool -> EitherT ServantErr IO [(Int64, String)]
-queryDrafts Options{..} cPool = withPool cPool $ do
-  drafts <- selectList [] []
-  return $ map deSQLify drafts
-  where
-    deSQLify :: Entity Draft -> (Int64, String)
-    deSQLify (Entity k (Draft title _)) = (fromSqlKey k, title)
-
-getDraft :: Options -> ConnectionPool -> Int64 -> EitherT ServantErr IO (String, Block String)
-getDraft Options{..} cPool draftId = withPool cPool $ do
-  draft <- get $ toSqlKey draftId
-  case draft of
-    Nothing -> lift $ left $ err404 { errBody = "no such draftId" }
-    Just (Draft title content) -> return (title, content)
-
-writeDraft :: Options -> ConnectionPool -> Int64 -> (String, Block String) -> EitherT ServantErr IO ()
-writeDraft Options{..} cPool draftId (draftName, draft) = withPool cPool $ repsert (toSqlKey draftId) (Draft draftName draft)
-
-addDraft :: Options -> ConnectionPool -> (String, Block String) -> EitherT ServantErr IO Int64
-addDraft Options{..} cPool (draftName, draft) = withPool cPool $ (fromSqlKey <$> insert (Draft draftName draft))
-
-delDraft :: Options -> ConnectionPool -> Int64 -> EitherT ServantErr IO ()
-delDraft Options{..} cPool draftId = withPool cPool $ delete (toSqlKey draftId :: Key Draft)
-
-data Options = Options
-               { port :: Int
-               , connStr :: String
-               , connNmbr :: Int
-               , printers :: [FilePath]
-               }
-
-server :: Options -> ConnectionPool -> Server ThermoprintApi
-server opts cPool = print opts
-               :<|> queryDrafts opts cPool
-               :<|> addDraft opts cPool
-               :<|> getDraft opts cPool
-               :<|> writeDraft opts cPool
-               :<|> delDraft opts cPool
-
-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
-            )
-          <*> strOption (
-            long "database"
-            <> short 'd'
-            <> metavar "STRING"
-            <> help "The sqlite connection string to use (can inlude some options)"
-            <> value "./storage.sqlite"
-            <> showDefault
-            )
-          <*> option auto (
-            long "database-connections"
-            <> metavar "INT"
-            <> help "The number of parallel sqlite connections to maintain"
-            <> value 2
-            <> showDefault
-            )
-          <*> some (strArgument (
-                        metavar "PATH [...]"
-                        <> help "Path to one of the printers to use"
-                                ))
-
-thermoprintApi :: Proxy ThermoprintApi
-thermoprintApi = Proxy
-
-main :: IO ()
-main = do
-  execParser opts >>= runNoLoggingT . main'
-  where
-    opts = info (helper <*> options) (
-      fullDesc
-      <> header "thermoprint-servant - A REST server for interacting with a cheap thermoprinter"
-                                     )
-    main' args@(Options{..}) = withSqlitePool (T.pack connStr) connNmbr $ main''
-      where
-        main'' cPool = do
-          runSqlPool (runMigration migrateAll) cPool
-          liftIO $ run port $ serve thermoprintApi (server args cPool)
-- 
cgit v1.2.3