aboutsummaryrefslogtreecommitdiffstats
path: root/src/Reaktor/Internal.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Reaktor/Internal.hs')
-rw-r--r--src/Reaktor/Internal.hs102
1 files changed, 56 insertions, 46 deletions
diff --git a/src/Reaktor/Internal.hs b/src/Reaktor/Internal.hs
index d3ac9cf..26294b4 100644
--- a/src/Reaktor/Internal.hs
+++ b/src/Reaktor/Internal.hs
@@ -1,58 +1,68 @@
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-module Reaktor.Internal (module Reaktor.Internal, module X) where
-
-import Blessings (Blessings)
-import Control.Monad.Trans.Class as X (lift)
-import Control.Monad.Trans.State as X (gets,modify)
-import Control.Monad.Trans.State (StateT)
-import Data.Aeson
-import Data.Aeson.Types
+{-# LANGUAGE RecordWildCards #-}
+module Reaktor.Internal where
+
+import Blessings
+import Data.Aeson
+import Data.ByteString (ByteString)
+import Network.Socket as Exports (HostName,ServiceName)
+import Prelude.Extended
import qualified Data.ByteString.Char8.Extended as BS
-import Network.Socket as X (HostName,ServiceName)
+import System.IO
-type Prefix = BS.ByteString
+data Actions = Actions
+ { aIsSecure :: Bool
-type Nickname = BS.ByteString
-type Password = BS.ByteString
-type MsgTarget = BS.ByteString
-type Channel = MsgTarget
+ , aSend :: Message -> IO ()
+ , aSendQuiet :: Message -> IO ()
-data PluginState = PluginState {
- s_putLog :: Blessings BS.ByteString -> IO (),
- s_nick :: BS.ByteString,
- s_sendMsg :: Message -> IO (),
- s_sendMsg' :: Message -> Message -> IO ()
- }
-
-setNick :: Nickname -> PluginIO ()
-setNick newnick = modify (\q -> q { s_nick = newnick })
-
-getNick :: PluginIO Nickname
-getNick = gets s_nick
-
-sendMsg :: Message -> PluginIO ()
-sendMsg msg = gets s_sendMsg >>= \f -> lift $ f msg
-
-sendMsg' :: Message -> Message -> PluginIO ()
-sendMsg' msg logMsg = gets s_sendMsg' >>= \f -> lift $ f msg logMsg
+ , aLog :: Blessings ByteString -> IO ()
+ , aLogMsg :: Message -> IO ()
-
-type PluginIO = StateT PluginState IO
-
-type PluginFunc = Message -> PluginIO ()
-
-data Plugin = Plugin {
- pluginFunc :: PluginFunc,
- requireTLS :: Bool
+ , aSetNick :: ByteString -> IO ()
+ , aGetNick :: IO ByteString
}
-simplePlugin :: FromJSON a => (a -> PluginFunc) -> Value -> IO Plugin
-simplePlugin f v =
- either error (\x -> return $ Plugin (f x) False) (parseEither parseJSON v)
+data Config = Config
+ { cUseTLS :: Bool
+ , cHostName :: HostName
+ , cServiceName :: ServiceName
+ , cNick :: Maybe ByteString
+ , cLogHandle :: Handle
+ , cLogTime :: Bool
+ }
-type Param = BS.ByteString
-type Command = BS.ByteString
-data Message = Message (Maybe Prefix) Command [Param]
+instance Default Config where
+ def = Config False "irc.r" "6667" Nothing stderr True
+
+instance FromJSON Config where
+ parseJSON = \case
+ Object v -> do
+ cServiceName <- v .:? "port" .!= cServiceName def
+ cUseTLS <- v .:? "useTLS" .!= (cServiceName == tlsPort)
+ cHostName <- v .:? "hostname" .!= cHostName def
+ cNick <- v .:? "nick"
+ cLogHandle <- pure (cLogHandle def)
+ cLogTime <- v .:? "logTime" .!= cLogTime def
+ pure Config{..}
+ _ -> undefined
+ where
+ tlsPort :: ServiceName
+ tlsPort = "6697"
+
+
+data Message = Message (Maybe ByteString) ByteString [ByteString] | Start
deriving Show
+
+formatMessage :: Message -> ByteString
+formatMessage = \case
+ Message mb_prefix cmd params ->
+ maybe "" ((":"<>) . (<>" ")) mb_prefix
+ <> cmd
+ <> BS.concat (map (" "<>) (init params))
+ <> if null params then "" else " :" <> last params
+ <> "\r\n"
+ x -> error ("cannot format " <> show x)