module Lambdabot.Plugin.Reference.Dict.DictLookup ( simpleDictLookup, QueryConfig(..), LookupResult) where
import Data.List
import System.IO
import Control.Exception (SomeException, handle)
import Network.Socket
import Lambdabot.Util.Network
data QueryConfig = QC { QueryConfig -> String
host :: String, QueryConfig -> Int
port :: Int }
type DictConnection = Handle
data DictCommand = Quit | Define DictName String
type DictName = String
type LookupResult = Either String String
simpleDictLookup :: QueryConfig -> DictName -> String -> IO LookupResult
simpleDictLookup :: QueryConfig -> String -> String -> IO LookupResult
simpleDictLookup QueryConfig
config String
dictnm String
query =
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\SomeException
e -> (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show (SomeException
e :: SomeException)))) forall a b. (a -> b) -> a -> b
$ do
DictConnection
conn <- QueryConfig -> IO DictConnection
openDictConnection QueryConfig
config
LookupResult
result <- DictConnection -> String -> String -> IO LookupResult
queryDict DictConnection
conn String
dictnm String
query
DictConnection -> IO ()
closeDictConnection DictConnection
conn
forall (m :: * -> *) a. Monad m => a -> m a
return LookupResult
result
openDictConnection :: QueryConfig -> IO DictConnection
openDictConnection :: QueryConfig -> IO DictConnection
openDictConnection QueryConfig
config = do
DictConnection
hDictServer <- String -> PortNumber -> IO DictConnection
connectTo' (QueryConfig -> String
host QueryConfig
config) (Int -> PortNumber
mkPortNumber forall a b. (a -> b) -> a -> b
$ QueryConfig -> Int
port QueryConfig
config)
DictConnection -> BufferMode -> IO ()
hSetBuffering DictConnection
hDictServer BufferMode
LineBuffering
String
_ <- DictConnection -> IO String
readResponseLine DictConnection
hDictServer
forall (m :: * -> *) a. Monad m => a -> m a
return DictConnection
hDictServer
where
mkPortNumber :: Int -> PortNumber
mkPortNumber = forall a b. (Integral a, Num b) => a -> b
fromIntegral
closeDictConnection :: DictConnection -> IO ()
closeDictConnection :: DictConnection -> IO ()
closeDictConnection DictConnection
conn = do
DictConnection -> DictCommand -> IO ()
sendCommand DictConnection
conn DictCommand
Quit
String
_ <- DictConnection -> IO String
readResponseLine DictConnection
conn
DictConnection -> IO ()
hClose DictConnection
conn
queryDict :: DictConnection -> DictName -> String -> IO LookupResult
queryDict :: DictConnection -> String -> String -> IO LookupResult
queryDict DictConnection
conn String
dictnm String
query = do
DictConnection -> DictCommand -> IO ()
sendCommand DictConnection
conn (String -> String -> DictCommand
Define String
dictnm String
query)
String
response <- DictConnection -> IO String
readResponseLine DictConnection
conn
case String
response of
Char
'1':Char
'5':String
_ -> IO [String]
readDefinition forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [String] -> Either a String
formatDefinition
Char
'5':Char
'5':Char
'2':String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (String
"No match for \"" forall a. [a] -> [a] -> [a]
++ String
query forall a. [a] -> [a] -> [a]
++ String
"\".\n")
Char
'5':String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
response
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String
"Bogus response: " forall a. [a] -> [a] -> [a]
++ String
response)
where
readDefinition :: IO [String]
readDefinition = do
String
line <- DictConnection -> IO String
readResponseLine DictConnection
conn
case String
line of
Char
'2':Char
'5':Char
'0':String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
String
_ -> IO [String]
readDefinition forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
lineforall a. a -> [a] -> [a]
:)
formatDefinition :: [String] -> Either a String
formatDefinition = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
formater
formater :: String -> [String]
formater (Char
'1':Char
'5':Char
'1':String
rest) = [String
"", String
"***" forall a. [a] -> [a] -> [a]
++ String
rest]
formater String
"." = []
formater String
line = [String
line]
readResponseLine :: DictConnection -> IO String
readResponseLine :: DictConnection -> IO String
readResponseLine DictConnection
conn = do
String
line <- DictConnection -> IO String
hGetLine DictConnection
conn
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Char
'\r') String
line)
sendCommand :: DictConnection -> DictCommand -> IO ()
sendCommand :: DictConnection -> DictCommand -> IO ()
sendCommand DictConnection
conn DictCommand
cmd =
DictConnection -> String -> IO ()
hSendLine DictConnection
conn forall a b. (a -> b) -> a -> b
$ case DictCommand
cmd of
DictCommand
Quit -> String
"QUIT"
Define String
db String
target -> forall a. [a] -> [[a]] -> [a]
join String
" " [String
"DEFINE", String
db, String
target]
join :: [a] -> [[a]] -> [a]
join :: forall a. [a] -> [[a]] -> [a]
join = (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concatforall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse
hSendLine :: Handle -> String -> IO ()
hSendLine :: DictConnection -> String -> IO ()
hSendLine DictConnection
h String
line = DictConnection -> String -> IO ()
hPutStr DictConnection
h (String
line forall a. [a] -> [a] -> [a]
++ String
"\r\n")