let the sau raus
This commit is contained in:
parent
a2586e865a
commit
3a6a218a83
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user