let the sau raus

This commit is contained in:
Jon Doe 2020-09-18 22:22:43 +02:00 committed by Maciej Bonin
parent a2586e865a
commit 3a6a218a83
2 changed files with 51 additions and 3 deletions

View File

@ -1,4 +1,4 @@
module GypsFulvus(execMain, Manhole(..), Sewage(..), InitStatus(..)) where module GypsFulvus(execMain, Manhole(..), Sewage(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor) where
import Control.Concurrent.STM (atomically, retry) import Control.Concurrent.STM (atomically, retry)
import Control.Concurrent.STM.TMVar import Control.Concurrent.STM.TMVar
import Control.Concurrent.STM.TChan import Control.Concurrent.STM.TChan

View File

@ -1,4 +1,5 @@
module GypsFulvus.PluginStuff(loadCommsPlugins, Sewage(..), Manhole(..), InitStatus(..)) where {-# LANGUAGE OverloadedStrings #-}
module GypsFulvus.PluginStuff(loadCommsPlugins, Sewage(..), Manhole(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor) where
import Control.Monad import Control.Monad
import System.Directory import System.Directory
import System.Plugins.Make import System.Plugins.Make
@ -6,14 +7,61 @@ import Data.Maybe
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Concurrent.STM.TMVar import Control.Concurrent.STM.TMVar
import qualified Data.Text as T import qualified Data.Text as T
() :: T.Text -> T.Text -> T.Text
a b = (T.append) a b
tooTeToSt :: T.Text -> T.Text -> String
tooTeToSt a b = tup $ a "@" b
tp :: String -> T.Text
tp = T.pack
tup :: T.Text -> String
tup = T.unpack
data IrcMask = IrcMask {
getIdent:: T.Text,
getHostname :: T.Text}
instance Show IrcMask where
show (IrcMask a b) = tooTeToSt a b
data SewageAutorInfo = NetworkIdentStyleAutor {
getNick :: T.Text,
getMask :: IrcMask,
getChannel :: T.Text}
| GenericStyleAutor {getName :: T.Text,
getLocation :: T.Text,
getContext :: T.Text}
instance Show SewageAutorInfo where
show (NetworkIdentStyleAutor a b c) = tup (c ":" a "!" tp (show b))
show (GenericStyleAutor a b c) = tup $ c ":" (tp $ tooTeToSt a b)
genericAutorToNSAutor :: SewageAutorInfo -> SewageAutorInfo
genericAutorToNSAutor (GenericStyleAutor a b c) = NetworkIdentStyleAutor a (IrcMask a b) c
genericAutorToNSAutor b = b
nsAutorToGenericAutor :: SewageAutorInfo -> SewageAutorInfo
nsAutorToGenericAutor (NetworkIdentStyleAutor a (IrcMask _ b') c) = GenericStyleAutor a b' c
nsAutorToGenericAutor b = b
type Nickname = T.Text
type NetworkIdent = T.Text
type NetworkHostname = T.Text
type NetworkChannel = T.Text
makeNetworkIdentStyleAutor
:: Nickname -> NetworkIdent -> NetworkHostname -> NetworkChannel -> SewageAutorInfo
makeNetworkIdentStyleAutor n i h c = NetworkIdentStyleAutor n (IrcMask i h) c
data Sewage = Sewage { data Sewage = Sewage {
getSewageAuthor :: T.Text, getSewageAutor :: T.Text,
getSewage :: T.Text getSewage :: T.Text
} }
data Manhole = Manhole { data Manhole = Manhole {
getInputChan :: TChan Sewage, getInputChan :: TChan Sewage,
getOutputChan :: TChan Sewage} getOutputChan :: TChan Sewage}
data InitStatus = GoodInitStatus | BadInitStatus T.Text data InitStatus = GoodInitStatus | BadInitStatus T.Text
srcPluginPath :: IO FilePath srcPluginPath :: IO FilePath
srcPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute srcPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute