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.TMVar
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 System.Directory
import System.Plugins.Make
@ -6,14 +7,61 @@ import Data.Maybe
import Control.Concurrent.STM
import Control.Concurrent.STM.TMVar
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 {
getSewageAuthor :: T.Text,
getSewageAutor :: T.Text,
getSewage :: T.Text
}
data Manhole = Manhole {
getInputChan :: TChan Sewage,
getOutputChan :: TChan Sewage}
data InitStatus = GoodInitStatus | BadInitStatus T.Text
srcPluginPath :: IO FilePath
srcPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute