From a00da57346c195b1b15d1c6aca2891483901aae6 Mon Sep 17 00:00:00 2001 From: tv Date: Mon, 21 Jan 2019 19:44:39 +0100 Subject: src: Types -> Internal --- src/Reaktor.hs | 2 +- src/Reaktor/Config.hs | 2 +- src/Reaktor/Internal.hs | 58 ++++++++++++++++++++++++++ src/Reaktor/Message.hs | 2 +- src/Reaktor/Parser.hs | 2 +- src/Reaktor/Plugins.hs | 2 +- src/Reaktor/Plugins/Mention.hs | 2 +- src/Reaktor/Plugins/NickServ.hs | 2 +- src/Reaktor/Plugins/Ping.hs | 2 +- src/Reaktor/Plugins/Register.hs | 2 +- src/Reaktor/Plugins/System.hs | 4 +- src/Reaktor/Plugins/System/Internal.hs | 75 ++++++++++++++++++++++++++++++++++ src/Reaktor/Plugins/System/Types.hs | 75 ---------------------------------- src/Reaktor/Types.hs | 58 -------------------------- src/Reaktor/Utils.hs | 2 +- 15 files changed, 145 insertions(+), 145 deletions(-) create mode 100644 src/Reaktor/Internal.hs create mode 100644 src/Reaktor/Plugins/System/Internal.hs delete mode 100644 src/Reaktor/Plugins/System/Types.hs delete mode 100644 src/Reaktor/Types.hs diff --git a/src/Reaktor.hs b/src/Reaktor.hs index 5f1e709..fd943c7 100644 --- a/src/Reaktor.hs +++ b/src/Reaktor.hs @@ -20,9 +20,9 @@ import Data.Time.Format import qualified Network.Simple.TCP as TCP import qualified Network.Simple.TCP.TLS as TLS import Reaktor.Config +import Reaktor.Internal import Reaktor.Parser (message) import qualified Reaktor.Plugins -import Reaktor.Types import System.IO (BufferMode(LineBuffering),hSetBuffering) import System.IO (Handle) import System.IO (hIsTerminalDevice) diff --git a/src/Reaktor/Config.hs b/src/Reaktor/Config.hs index 8330be9..908f9a8 100644 --- a/src/Reaktor/Config.hs +++ b/src/Reaktor/Config.hs @@ -4,8 +4,8 @@ module Reaktor.Config where import Data.Aeson import qualified Data.HashMap.Lazy as HML import qualified Data.Text as T +import Reaktor.Internal import qualified Reaktor.Plugins -import Reaktor.Types instance FromJSON Config where diff --git a/src/Reaktor/Internal.hs b/src/Reaktor/Internal.hs new file mode 100644 index 0000000..d3ac9cf --- /dev/null +++ b/src/Reaktor/Internal.hs @@ -0,0 +1,58 @@ +{-# 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 +import qualified Data.ByteString.Char8.Extended as BS +import Network.Socket as X (HostName,ServiceName) + + +type Prefix = BS.ByteString + +type Nickname = BS.ByteString +type Password = BS.ByteString +type MsgTarget = BS.ByteString +type Channel = MsgTarget + +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 + + +type PluginIO = StateT PluginState IO + +type PluginFunc = Message -> PluginIO () + +data Plugin = Plugin { + pluginFunc :: PluginFunc, + requireTLS :: Bool + } + +simplePlugin :: FromJSON a => (a -> PluginFunc) -> Value -> IO Plugin +simplePlugin f v = + either error (\x -> return $ Plugin (f x) False) (parseEither parseJSON v) + + +type Param = BS.ByteString +type Command = BS.ByteString +data Message = Message (Maybe Prefix) Command [Param] + deriving Show diff --git a/src/Reaktor/Message.hs b/src/Reaktor/Message.hs index c1c7ced..c679d78 100644 --- a/src/Reaktor/Message.hs +++ b/src/Reaktor/Message.hs @@ -2,7 +2,7 @@ module Reaktor.Message where import qualified Data.ByteString.Char8.Extended as BS -import Reaktor.Types +import Reaktor.Internal privmsg :: BS.ByteString -> [BS.ByteString] -> Message diff --git a/src/Reaktor/Parser.hs b/src/Reaktor/Parser.hs index 3baaad7..12d5ace 100644 --- a/src/Reaktor/Parser.hs +++ b/src/Reaktor/Parser.hs @@ -5,7 +5,7 @@ import Control.Applicative import Data.Attoparsec.ByteString.Char8 import qualified Data.ByteString.Char8.Extended as BS import qualified Data.Char -import Reaktor.Types +import Reaktor.Internal prefix :: Parser Prefix diff --git a/src/Reaktor/Plugins.hs b/src/Reaktor/Plugins.hs index 83677bb..86e1f2a 100644 --- a/src/Reaktor/Plugins.hs +++ b/src/Reaktor/Plugins.hs @@ -9,7 +9,7 @@ import qualified Reaktor.Plugins.NickServ import qualified Reaktor.Plugins.Ping import qualified Reaktor.Plugins.Register import qualified Reaktor.Plugins.System -import Reaktor.Types (Plugin) +import Reaktor.Internal (Plugin) get :: T.Text -> Value -> IO Plugin diff --git a/src/Reaktor/Plugins/Mention.hs b/src/Reaktor/Plugins/Mention.hs index a08604c..75de87c 100644 --- a/src/Reaktor/Plugins/Mention.hs +++ b/src/Reaktor/Plugins/Mention.hs @@ -6,8 +6,8 @@ import Control.Monad (when) import Data.Aeson import qualified Data.ByteString.Char8.Extended as BS import qualified Data.Char +import Reaktor.Internal import Reaktor.Message -import Reaktor.Types plugin :: Value -> IO Plugin diff --git a/src/Reaktor/Plugins/NickServ.hs b/src/Reaktor/Plugins/NickServ.hs index caa2301..36b8917 100644 --- a/src/Reaktor/Plugins/NickServ.hs +++ b/src/Reaktor/Plugins/NickServ.hs @@ -9,8 +9,8 @@ import Data.Aeson import Data.Aeson.Types (parseEither) import qualified Data.ByteString.Char8.Extended as BS import GHC.Generics +import Reaktor.Internal import Reaktor.Message -import Reaktor.Types import Reaktor.Utils (randomNick) diff --git a/src/Reaktor/Plugins/Ping.hs b/src/Reaktor/Plugins/Ping.hs index 83b3ac4..de3fe53 100644 --- a/src/Reaktor/Plugins/Ping.hs +++ b/src/Reaktor/Plugins/Ping.hs @@ -3,7 +3,7 @@ module Reaktor.Plugins.Ping (plugin) where import Control.Monad (when) import Data.Aeson (Value(Null)) -import Reaktor.Types +import Reaktor.Internal plugin :: Value -> IO Plugin diff --git a/src/Reaktor/Plugins/Register.hs b/src/Reaktor/Plugins/Register.hs index 48c3ff2..5e987a7 100644 --- a/src/Reaktor/Plugins/Register.hs +++ b/src/Reaktor/Plugins/Register.hs @@ -8,7 +8,7 @@ import Control.Monad (when) import Data.Aeson import qualified Data.ByteString.Char8.Extended as BS import GHC.Generics -import Reaktor.Types +import Reaktor.Internal import Reaktor.Utils (nextNick,randomNick) diff --git a/src/Reaktor/Plugins/System.hs b/src/Reaktor/Plugins/System.hs index 4e659d1..781409b 100644 --- a/src/Reaktor/Plugins/System.hs +++ b/src/Reaktor/Plugins/System.hs @@ -12,8 +12,8 @@ import Data.Aeson import qualified Data.ByteString.Char8.Extended as BS import qualified Data.Map as M import Reaktor.Message -import Reaktor.Plugins.System.Types -import Reaktor.Types +import Reaktor.Internal +import Reaktor.Plugins.System.Internal import System.Environment (getEnvironment) import System.FilePath.Posix (takeBaseName) import System.IO (Handle,hClose,hPutStr,hIsEOF) diff --git a/src/Reaktor/Plugins/System/Internal.hs b/src/Reaktor/Plugins/System/Internal.hs new file mode 100644 index 0000000..4a64e0b --- /dev/null +++ b/src/Reaktor/Plugins/System/Internal.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} +module Reaktor.Plugins.System.Internal where + +import Data.Aeson +import qualified Data.ByteString.Char8.Extended as BS +import qualified Data.Map as M +import Reaktor.Internal () + + +-- TODO this needs better names :) +data CaptureOr a = Capture Integer | CaptureOr a + deriving Show -- TODO killme + +instance FromJSON a => FromJSON (CaptureOr a) where + parseJSON o@(Number _) = Capture <$> parseJSON o -- TODO don't parse twice + parseJSON o = CaptureOr <$> parseJSON o + +-- TODO query means via direct privmsg and : +data Activate = Always | Match | Query + +instance FromJSON Activate where + parseJSON (String "always") = pure Always + parseJSON (String "match") = pure Match + parseJSON (String "query") = pure Query + parseJSON _ = undefined + +data SystemConfig = SystemConfig { + defaultWorkDir :: Maybe FilePath, + -- TODO IrcCommand as key for map + hooks :: M.Map BS.ByteString [SystemParams] +} + +instance FromJSON SystemConfig where + parseJSON (Object v) = + SystemConfig + <$> v .:? "workdir" + <*> v .:? "hooks" .!= M.empty + parseJSON _ = pure undefined + +data SystemParams = SystemParams { + activate :: Activate, + pattern :: Maybe BS.ByteString, -- TODO RE + command :: CaptureOr SystemCommand, + arguments :: [CaptureOr BS.ByteString], + workDir :: Maybe FilePath, + commands :: M.Map BS.ByteString SystemCommand +} + +instance FromJSON SystemParams where + parseJSON (Object v) = + SystemParams + <$> v .:? "activate" .!= Query + <*> v .:? "pattern" + <*> v .: "command" + <*> v .:? "arguments" .!= [] + <*> v .:? "workdir" + <*> v .:? "commands" .!= M.empty + parseJSON _ = pure undefined + + +data SystemCommand = SystemCommand { + commandPath :: FilePath, + commandWorkDir :: Maybe FilePath, + commandEnv :: Maybe (M.Map String String) + } + deriving Show -- TODO killme + +instance FromJSON SystemCommand where + parseJSON (Object v) = + SystemCommand + <$> v .: "filename" + <*> v .:? "workdir" + <*> v .:? "env" + parseJSON _ = pure undefined + diff --git a/src/Reaktor/Plugins/System/Types.hs b/src/Reaktor/Plugins/System/Types.hs deleted file mode 100644 index 39d2f75..0000000 --- a/src/Reaktor/Plugins/System/Types.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Reaktor.Plugins.System.Types where - -import Data.Aeson -import qualified Data.ByteString.Char8.Extended as BS -import qualified Data.Map as M -import Reaktor.Types () - - --- TODO this needs better names :) -data CaptureOr a = Capture Integer | CaptureOr a - deriving Show -- TODO killme - -instance FromJSON a => FromJSON (CaptureOr a) where - parseJSON o@(Number _) = Capture <$> parseJSON o -- TODO don't parse twice - parseJSON o = CaptureOr <$> parseJSON o - --- TODO query means via direct privmsg and : -data Activate = Always | Match | Query - -instance FromJSON Activate where - parseJSON (String "always") = pure Always - parseJSON (String "match") = pure Match - parseJSON (String "query") = pure Query - parseJSON _ = undefined - -data SystemConfig = SystemConfig { - defaultWorkDir :: Maybe FilePath, - -- TODO IrcCommand as key for map - hooks :: M.Map BS.ByteString [SystemParams] -} - -instance FromJSON SystemConfig where - parseJSON (Object v) = - SystemConfig - <$> v .:? "workdir" - <*> v .:? "hooks" .!= M.empty - parseJSON _ = pure undefined - -data SystemParams = SystemParams { - activate :: Activate, - pattern :: Maybe BS.ByteString, -- TODO RE - command :: CaptureOr SystemCommand, - arguments :: [CaptureOr BS.ByteString], - workDir :: Maybe FilePath, - commands :: M.Map BS.ByteString SystemCommand -} - -instance FromJSON SystemParams where - parseJSON (Object v) = - SystemParams - <$> v .:? "activate" .!= Query - <*> v .:? "pattern" - <*> v .: "command" - <*> v .:? "arguments" .!= [] - <*> v .:? "workdir" - <*> v .:? "commands" .!= M.empty - parseJSON _ = pure undefined - - -data SystemCommand = SystemCommand { - commandPath :: FilePath, - commandWorkDir :: Maybe FilePath, - commandEnv :: Maybe (M.Map String String) - } - deriving Show -- TODO killme - -instance FromJSON SystemCommand where - parseJSON (Object v) = - SystemCommand - <$> v .: "filename" - <*> v .:? "workdir" - <*> v .:? "env" - parseJSON _ = pure undefined - diff --git a/src/Reaktor/Types.hs b/src/Reaktor/Types.hs deleted file mode 100644 index 7b5e8fa..0000000 --- a/src/Reaktor/Types.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Reaktor.Types (module Reaktor.Types, 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 -import qualified Data.ByteString.Char8.Extended as BS -import Network.Socket as X (HostName,ServiceName) - - -type Prefix = BS.ByteString - -type Nickname = BS.ByteString -type Password = BS.ByteString -type MsgTarget = BS.ByteString -type Channel = MsgTarget - -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 - - -type PluginIO = StateT PluginState IO - -type PluginFunc = Message -> PluginIO () - -data Plugin = Plugin { - pluginFunc :: PluginFunc, - requireTLS :: Bool - } - -simplePlugin :: FromJSON a => (a -> PluginFunc) -> Value -> IO Plugin -simplePlugin f v = - either error (\x -> return $ Plugin (f x) False) (parseEither parseJSON v) - - -type Param = BS.ByteString -type Command = BS.ByteString -data Message = Message (Maybe Prefix) Command [Param] - deriving Show diff --git a/src/Reaktor/Utils.hs b/src/Reaktor/Utils.hs index 725775e..a31cd15 100644 --- a/src/Reaktor/Utils.hs +++ b/src/Reaktor/Utils.hs @@ -3,7 +3,7 @@ module Reaktor.Utils where import qualified Data.ByteString.Char8.Extended as BS import Data.Char (chr) import Data.Char (isDigit) -import Reaktor.Types +import Reaktor.Internal import System.Random (getStdRandom, randomR) -- cgit v1.2.3