Add getUnsoundBarcodes route

src/Jon/Garfield/Queries.hs

@@ -18,6 +18,13 @@ import Jon.Garfield.Types
 
 -- Selects
 
+runSelect
+    :: (FromBackendRow Postgres (QExprToIdentity e), Projectible Postgres e)
+    => Connection
+    -> Q Postgres db QBaseScope e
+    -> IO [QExprToIdentity e]
+runSelect conn q = runBeamPostgresDebug putStrLn conn $ runSelectReturningList $ select q
+
 overviewItems
     :: Q Postgres GarfieldDb s (OverviewT (QExpr Postgres s), InventoryItemT (QExpr Postgres s))
 overviewItems = do

src/Jon/Main.hs

@@ -7,36 +7,37 @@ module Jon.Main
     , runIns
     ) where
 
+import Control.Exception (bracket)
 import Database.Beam
 import Database.Beam.Postgres
+import Servant (Proxy(..), serve)
 import System.Environment
+import Network.Wai.Handler.Warp (run)
 
 import qualified Data.ByteString.Char8 as BS8
 
+import Jon.Server (JonAPI, server)
+
 main :: IO ()
-main = pure ()
+main = withGarfieldConn (run 8080 . serve (Proxy :: Proxy JonAPI) . server)
+
+withGarfieldConn = bracket
+    (do pass <- getEnv "JON_PASS"
+        connectPostgreSQL $ BS8.pack $ "host=localhost dbname=garfield password=" ++ pass)
+    close
 
 runQuery
     :: (FromBackendRow Postgres (QExprToIdentity e), Projectible Postgres e)
     => Q Postgres db QBaseScope e
     -> IO [QExprToIdentity e]
-runQuery q = do
-    pass <- getEnv "JON_PASS"
-    conn <- connectPostgreSQL $ BS8.pack $ "host=localhost dbname=garfield password=" ++ pass
-    runBeamPostgresDebug putStrLn conn $ runSelectReturningList $ select q
+runQuery q = withGarfieldConn $ \conn -> runBeamPostgresDebug putStrLn conn $ runSelectReturningList $ select q
 
 runIns
     :: SqlInsert Postgres table
     -> IO ()
-runIns i = do
-    pass <- getEnv "JON_PASS"
-    conn <- connectPostgreSQL $ BS8.pack $ "host=localhost dbname=garfield password=" ++ pass
-    runBeamPostgresDebug putStrLn conn $ runInsert i
+runIns i = withGarfieldConn $ \conn -> runBeamPostgresDebug putStrLn conn $ runInsert i
 
 runFunction
     :: (Connection -> IO a)
     -> IO a
-runFunction f = do
-    pass <- getEnv "JON_PASS"
-    conn <- connectPostgreSQL $ BS8.pack $ "host=localhost dbname=garfield password=" ++ pass
-    f conn
+runFunction = withGarfieldConn

src/Jon/Server.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Jon.Server where
+
+import Control.Monad.IO.Class (liftIO)
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Text (Text)
+import Data.Int (Int32)
+import Database.PostgreSQL.Simple (Connection)
+import GHC.Generics (Generic)
+import Servant
+
+import Jon.Garfield.Types
+
+import qualified Jon.Garfield.Queries as Queries
+
+-- API and types
+
+type JonAPI = "getUnsoundBarcodes" :> ReqBody '[JSON] GetUnsoundBarcodesP :> Post '[JSON] GetUnsoundBarcodesR
+
+data GetUnsoundBarcodesP = GetUnsoundBarcodesP
+    { location :: Int32
+    } deriving (Show, Generic, FromJSON)
+
+data GetUnsoundBarcodesR = GetUnsoundBarcodesR
+    { unsoundBarcodes :: [UnsoundBarcode]
+    } deriving (Show, Generic, ToJSON)
+
+data UnsoundBarcode = UnsoundBarcode
+    { barcode :: Text
+    , name :: Text
+    , entries :: Int
+    , unitsLeft :: Int
+    } deriving (Show, Generic, ToJSON)
+
+-- server
+
+server :: Connection -> Server JonAPI
+server conn = getUnsoundBarcodes
+    where
+        getUnsoundBarcodes :: GetUnsoundBarcodesP -> Handler GetUnsoundBarcodesR
+        getUnsoundBarcodes params = do
+            rows <- liftIO $ Queries.runSelect conn $ Queries.unsoundBarcodes $ mkLocationId params.location
+            pure $ GetUnsoundBarcodesR $ map mkUnsoundBarcode rows
+            where
+                mkUnsoundBarcode (a, b, c, d) = UnsoundBarcode a b (fromIntegral c) (fromIntegral d)