Add shop search

4 files changed, 61 insertions, 15 deletions

diff --git a/ChangeLog.md b/ChangeLog.md
index d45088b..227b60a 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,11 @@
 # Revision history for dwproxy
 
+## 0.1.1.0  -- 2018-12-15
+
+* Item search in shops.
+* Minor speedwalking adjustments.
+
+
 ## 0.1.0.0  -- 2018-09-30
 
 * First release: Rudimentary GMCP support, basic speedwalking between
diff --git a/DWProxy.hs b/DWProxy.hs
index b177376..6cded01 100644
--- a/DWProxy.hs
+++ b/DWProxy.hs
@@ -24,6 +24,7 @@ import Data.Either (rights)
 import Control.Applicative
 import Data.Aeson (FromJSON, decodeStrict)
 import GHC.Generics (Generic)
+import Data.Monoid
 
 
 type RoomID = T.Text
@@ -155,6 +156,25 @@ c2s c leftover = do
             , "\255\240"
             ]
         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, room_short, item_name, sale_price from shop_items"
+             <> " natural inner join rooms where item_name like ?")
+            (SQLite.Only (concat ["%", query, "%"]))
+            :: IO [(T.Text, T.Text, T.Text, T.Text)]
+          -- cleanup the routes
+          modifyMVar_ (connState c) $ \cst -> pure $ cst { routeOptions = [] }
+          forM_ shops $ \(roomI, roomS, item, price) -> do
+            let p = curRoom >>=
+                    \cr -> either (const Nothing) Just (findPath (cPF c) cr roomI)
+            n <- case p of
+              Nothing -> pure " "
+              Just p' -> modifyMVar (connState c) $ \cst ->
+                pure (cst { routeOptions = routeOptions cst ++ [TE.encodeUtf8 p'] }
+                     , show (length $ routeOptions cst))
+            sendAll (cClient c) $ TE.encodeUtf8 $
+              T.concat ["[", T.pack n, "] ", roomS, ": ", item, " for ", price, "\r\n"]
         SpeedWalk f t -> do
           cs <- readMVar (connState c)
           case (T.pack <$> f) <|> currentRoom cs of
@@ -173,11 +193,20 @@ c2s c leftover = do
                     | from <- fromRooms, to <- toRooms ]
               case routes of
                 [] -> sendAll (cClient c) "No routes found\r\n"
+                [(_from, _to, p)] -> do
+                  sendAll (cServer c) $ BS.concat
+                    ["alias _speedwalk "
+                    , TE.encodeUtf8 p
+                    , "\r\n"
+                    , "_speedwalk"
+                    , "\r\n"
+                    ]
                 _ -> do
-                  sendAll (cClient c) "Routes found:\r\n"
                   forM_ (zip ([0..] :: [Int]) routes) $ \(n, (from, to, _)) ->
                     sendAll (cClient c) $
-                    BS.concat ["[", BS.pack (show n), "] ", from, " to ", to, "\r\n"]
+                    BS.concat ["[", BS.pack (show n), "] "
+                              , maybe "" (const $ from <> " to ") f
+                              , to, "\r\n"]
                   modifyMVar_ (connState c) $ \cst -> pure $
                     cst { routeOptions = map (\(_,_,route) -> TE.encodeUtf8 route) routes }
                   pure ()
@@ -186,7 +215,8 @@ c2s c leftover = do
           if length routes < n
             then sendAll (cClient c) "No such route"
             else sendAll (cServer c) $
-                 BS.concat ["alias _speedwalk ", routes !! n, "\r\n"]
+                 BS.concat ["alias _speedwalk ", routes !! n, "\r\n"
+                           , "_speedwalk", "\r\n"]
       c2s c d
 
 s2c :: Config -> BS.ByteString -> IO ()
@@ -214,6 +244,7 @@ s2c c leftover = do
 data Command = Telnet BS.ByteString
              | TelnetSN BS.ByteString
              | SpeedWalk (Maybe String) String
+             | ShopSearch String
              | RouteChoice Int
   deriving (Show)
 
@@ -243,8 +274,11 @@ pSpeedWalk = do
   to <- manyTill (notChar '\255') "\r\n"
   pure $ SpeedWalk from to
 
+pShopSearch :: Parser Command
+pShopSearch = ShopSearch <$> ("shop " *> manyTill (notChar '\255') "\r\n")
+
 pClientCommand :: Parser Command
-pClientCommand = pSpeedWalk <|> pRouteChoice
+pClientCommand = pSpeedWalk <|> pRouteChoice <|> pShopSearch
 
 pTelnetSN :: Parser Command
 pTelnetSN = do
@@ -288,6 +322,9 @@ main = do
           let c = Config client server db mv pf
           c2s' <- async $ c2s c ""
           s2c' <- async $ s2c c ""
-          waitAnyCatchCancel [c2s', s2c']
+          r <- waitAnyCatchCancel [c2s', s2c']
+          case r of
+            (_, Left e) -> print e
+            _ -> pure ()
     _ -> putStrLn "Usage: dwroute <quow plugins>"
   pure ()
diff --git a/README.md b/README.md
index 897cda9..b4ace02 100644
--- a/README.md
+++ b/README.md
@@ -3,8 +3,10 @@
 This is a client-agnostic proxy for the Discworld MUD, which adds new
 commands:
 
-- `speedwalk [from <location>] to <location>`: find routes
+- `speedwalk [from <location>] to <location>`: find routes, walk if
+  there's only one
 - `route <n>`: select a speedwalk route option
+- `shop <item>`: search shops by items they sell
 
 It uses the database from [Quow's Cow Bar and
 Minimap](http://quow.co.uk/minimap.php), which should be available,
diff --git a/dwproxy.cabal b/dwproxy.cabal
index 940c213..81702a8 100644
--- a/dwproxy.cabal
+++ b/dwproxy.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                dwproxy
-version:             0.1.0.0
+version:             0.1.1.0
 -- synopsis:            
 -- description:         
 license:             BSD3
@@ -19,17 +19,18 @@ executable dwproxy
   main-is:             DWProxy.hs
   -- other-modules:       
   other-extensions:    DeriveGeneric, DeriveAnyClass, OverloadedStrings
-  build-depends:       base >=4.9 && <4.10
-                     , text >=1.2 && <1.3
-                     , fgl >=5.6 && <5.7
-                     , unordered-containers >=0.2 && <0.3
-                     , sqlite-simple >=0.4 && <0.5
-                     , filepath >=1.4 && <1.5
-                     , network >=2.7 && <2.8
+  build-depends:       aeson >=1.4 && <1.5
                      , async >=2.2 && <2.3
                      , attoparsec >=0.13 && <0.14
+                     , base >=4.9 && <4.10
                      , bytestring >=0.10 && <0.11
-                     , aeson >=1.4 && <1.5
+                     , fgl >=5.6 && <5.7
+                     , filepath >=1.4 && <1.5
+                     , hlibev >= 0.4.0
+                     , network >=2.7 && <2.8
+                     , sqlite-simple >=0.4 && <0.5
+                     , text >=1.2 && <1.3
+                     , unordered-containers >=0.2 && <0.3
   -- hs-source-dirs:      
   default-language:    Haskell2010
   ghc-options:       -threaded -O3 -Wall