Switch from sqlite-simple to HDBC-Sqlite3, bump dependency versions

Now it's suitable for building on Debian 11, using dependencies just
from system repositories.

4 files changed, 79 insertions, 35 deletions

diff --git a/ChangeLog.md b/ChangeLog.md
index 227b60a..e75424f 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,10 @@
 # Revision history for dwproxy
 
+## 0.1.1.1  -- 2021-08-17
+
+* Switched from sqlite-simple to HDBC and updated dependency versions.
+
+
 ## 0.1.1.0  -- 2018-12-15
 
 * Item search in shops.
diff --git a/DWProxy.hs b/DWProxy.hs
index 10776c9..ec03a1a 100644
--- a/DWProxy.hs
+++ b/DWProxy.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -7,12 +9,12 @@ import Data.Graph.Inductive.Graph (mkGraph)
 import Data.Graph.Inductive.PatriciaTree (Gr)
 import Data.Graph.Inductive.Query.SP (sp)
 import qualified Data.HashMap.Strict as HM
-import qualified Database.SQLite.Simple as SQLite
-import Data.Maybe (mapMaybe)
+import Database.HDBC
+import Database.HDBC.Sqlite3 as Sqlite3
+import Data.Convertible
 import System.Environment (getArgs)
-import System.FilePath ((</>))
 import Network.Socket.ByteString (sendAll, recv)
-import Network.Socket hiding (send, recv)
+import Network.Socket
 import Control.Concurrent.Async (async, waitAnyCatchCancel)
 import Control.Exception as E
 import Control.Monad (when, forM_, forever)
@@ -24,7 +26,6 @@ import Data.Either (rights)
 import Control.Applicative
 import Data.Aeson (FromJSON, decodeStrict)
 import GHC.Generics (Generic)
-import Data.Monoid
 import Data.List
 import Data.Maybe
 
@@ -47,6 +48,13 @@ data Exit = Exit { exitFrom :: RoomID
                  , exitName :: T.Text }
   deriving (Show, Eq)
 
+data ShopItem = ShopItem  { siRoomID :: RoomID
+                          , siMapID :: Int
+                          , siRoomShort :: T.Text
+                          , siItemName :: T.Text
+                          , siSalePrice :: T.Text }
+  deriving (Show, Eq)
+
 mapNames :: [T.Text]
 mapNames =
   [ "Ankh-Morpork", "AM Assassins", "AM Buildings", "AM Cruets", "AM Docks"
@@ -73,14 +81,38 @@ elemAtIndex n (_:xs) = elemAtIndex (n - 1) xs
 
 mapNameByID :: Int -> T.Text
 mapNameByID n = fromMaybe "unknown" $ elemAtIndex (n - 1) mapNames
-  
 
-instance SQLite.FromRow Room where
-  fromRow = Room <$> SQLite.field <*> SQLite.field <*> SQLite.field
-            <*> SQLite.field <*> SQLite.field <*> SQLite.field
 
-instance SQLite.FromRow Exit where
-  fromRow = Exit <$> SQLite.field <*> SQLite.field <*> SQLite.field
+instance Convertible [SqlValue] Room where
+  safeConvert [rid, rmid, rx, ry, rs, rt] = do
+    rid' <- safeFromSql rid
+    rmid' <- safeFromSql rmid
+    rx' <- safeFromSql rx
+    ry' <- safeFromSql ry
+    rs' <- safeFromSql rs
+    rt' <- safeFromSql rt
+    pure $ Room rid' rmid' rx' ry' rs' rt'
+  safeConvert other = Left $ ConvertError (show other) "[SqlValue]" "Room" "Unexpected list length"
+
+instance Convertible [SqlValue] Exit where
+  safeConvert [ef, et, en] = do
+    ef' <- safeFromSql ef
+    et' <- safeFromSql et
+    en' <- safeFromSql en
+    pure $ Exit ef' et' en'
+  safeConvert other = Left $ ConvertError (show other) "[SqlValue]" "Exit" "Unexpected list length"
+
+
+instance Convertible [SqlValue] ShopItem where
+  safeConvert [rid, mid, rs, iname, sprice] = do
+    rid' <- safeFromSql rid
+    mid' <- safeFromSql mid
+    rs' <- safeFromSql rs
+    iname' <- safeFromSql iname
+    sprice' <- safeFromSql sprice
+    pure $ ShopItem rid' mid' rs' iname' sprice'
+  safeConvert other = Left $ ConvertError (show other) "[SqlValue]" "ShopItem" "Unexpected list length"
+
 
 data PathFinder = PF { pfGraph :: Gr RoomID Int
                      , pfRoomToNode :: HM.HashMap RoomID Int
@@ -173,14 +205,14 @@ c2s c leftover = do
         Telnet other -> sendAll (cServer c) $ BS.cons '\255' other
         ShopSearch query -> do
           curRoom <- currentRoom <$> readMVar (connState c)
-          shops <- SQLite.query (dbConn c)
-            ("select room_id, map_id, room_short, item_name, sale_price from shop_items"
-             <> " natural inner join rooms where item_name like ?")
-            (SQLite.Only (concat ["%", query, "%"]))
-            :: IO [(RoomID, Int, T.Text, T.Text, T.Text)]
+          shops <- map convert
+                   <$> quickQuery' (dbConn c)
+                   ("select room_id, map_id, room_short, item_name, sale_price from shop_items"
+                    <> " natural inner join rooms where item_name like ?")
+                   [(toSql $ concat ["%", query, "%"])]
           -- cleanup the routes
           modifyMVar_ (connState c) $ \cst -> pure $ cst { routeOptions = [] }
-          forM_ shops $ \(roomI, mapI, roomS, item, price) -> do
+          forM_ shops $ \(ShopItem roomI mapI roomS item price) -> do
             let p = curRoom >>=
                     \cr -> either (const Nothing) Just (findPath (cPF c) cr roomI)
             (n, l) <- case p of
@@ -199,12 +231,12 @@ c2s c leftover = do
             Nothing -> sendAll (cClient c)
               "No source location is given, and none detected"
             Just f' -> do
-              fromRooms <- SQLite.query (dbConn c)
+              fromRooms <- map convert <$> quickQuery' (dbConn c)
                 "select * from rooms where room_short like ? or room_id = ?"
-                ((T.concat ["%", f', "%"]), f')
-              toRooms <- SQLite.query (dbConn c)
+                [(toSql $ T.concat ["%", f', "%"]), toSql f']
+              toRooms <- map convert <$> quickQuery' (dbConn c)
                 "select * from rooms where room_short like ? or room_id = ?"
-                ((concat ["%", t, "%"]), t)
+                [(toSql $ concat ["%", t, "%"]), toSql t]
               let routes = sortOn (\(_, _, p) -> length p) $ rights
                     [ (\p -> (showRoom from, showRoom to, p)) <$>
                     findPath (cPF c) (roomID from) (roomID to)
@@ -269,7 +301,7 @@ data ConnState = CS { routeOptions :: [[T.Text]]
 
 data Config = Config { cClient :: Socket
                      , cServer :: Socket
-                     , dbConn :: SQLite.Connection
+                     , dbConn :: Sqlite3.Connection
                      , connState :: MVar ConnState
                      , cPF :: PathFinder
                      }
@@ -319,13 +351,13 @@ main :: IO ()
 main = do
   args <- getArgs
   case args of
-    [quow] ->
+    [quowmap] ->
       E.bracket
-      (SQLite.open $ quow </> "maps" </> "_quowmap_database.db")
-      (SQLite.close) $ \db -> do
-      rooms <- SQLite.query_ db
-        "select room_id, map_id, xpos, ypos, room_short, room_type from rooms"
-      exits <- SQLite.query_ db "select room_id, connect_id, exit from room_exits"
+      (connectSqlite3 quowmap)
+      (disconnect) $ \db -> do
+      rooms <- map convert <$> quickQuery' db
+        "select room_id, map_id, xpos, ypos, room_short, room_type from rooms" []
+      exits <- map convert <$> quickQuery' db "select room_id, connect_id, exit from room_exits" []
       let pf = pathFinder rooms exits
       mv <- newMVar $ CS [] Nothing
       E.bracket mkServer close $ \serverSocket -> forever $ do
diff --git a/README.md b/README.md
index 534feb8..2644f55 100644
--- a/README.md
+++ b/README.md
@@ -11,6 +11,12 @@ commands:
 It uses the database from [Quow's Cow Bar and
 Minimap](http://quow.co.uk/minimap.php), which should be available,
 and the path to which should be provided as the first argument on
-invocation, e.g.: `dwproxy ~/discworld/quow_cowbar/`.
+invocation, e.g.: `dwproxy _quowmap_database.db`.
 
 The default port is 2000, `telnet localhost 2000` to connect.
+
+Can be built with either cabal (`cabal install`) or plain GHC on
+Debian 11, after installing the compiler and dependencies from system
+repositories (`ghc libghc-fgl-dev libghc-unordered-containers-dev
+libghc-network-dev libghc-async-dev libghc-attoparsec-dev
+libghc-aeson-dev libghc-hdbc-sqlite3-dev`).
diff --git a/dwproxy.cabal b/dwproxy.cabal
index 81702a8..a83fe1e 100644
--- a/dwproxy.cabal
+++ b/dwproxy.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                dwproxy
-version:             0.1.1.0
+version:             0.1.1.1
 -- synopsis:            
 -- description:         
 license:             BSD3
@@ -22,13 +22,14 @@ executable dwproxy
   build-depends:       aeson >=1.4 && <1.5
                      , async >=2.2 && <2.3
                      , attoparsec >=0.13 && <0.14
-                     , base >=4.9 && <4.10
+                     , base >=4.9 && <5
                      , bytestring >=0.10 && <0.11
-                     , fgl >=5.6 && <5.7
+                     , fgl >=5.6 && <6
                      , filepath >=1.4 && <1.5
-                     , hlibev >= 0.4.0
-                     , network >=2.7 && <2.8
-                     , sqlite-simple >=0.4 && <0.5
+                     , network >=2.7 && <4
+                     , HDBC >=2.4 && <3
+                     , HDBC-sqlite3 >=2 && <3
+                     , convertible >= 1 && <2
                      , text >=1.2 && <1.3
                      , unordered-containers >=0.2 && <0.3
   -- hs-source-dirs: