From b2c5bed90d78ac56a64fb068db136a0984ee4354 Mon Sep 17 00:00:00 2001 From: defanor Date: Tue, 17 Aug 2021 15:02:22 +0300 Subject: 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. --- ChangeLog.md | 5 ++++ DWProxy.hs | 88 ++++++++++++++++++++++++++++++++++++++++------------------- README.md | 8 +++++- dwproxy.cabal | 13 +++++---- 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: -- cgit v1.2.3