From d5f66b27b2cd7c36eb7c2e81b0cdca10c5a5ef90 Mon Sep 17 00:00:00 2001 From: tv Date: Thu, 24 Jan 2019 17:22:03 +0100 Subject: src: ByteString -> Text --- reaktor2.cabal | 2 +- src/Data/Text/Extended.hs | 12 ++++++++++ src/Prelude/Extended.hs | 1 + src/Reaktor.hs | 42 +++++++++++++++++++--------------- src/Reaktor/Internal.hs | 17 +++++++------- src/Reaktor/Nick.hs | 27 +++++++++++----------- src/Reaktor/Parser.hs | 25 ++++++++++---------- src/Reaktor/Plugins/Mention.hs | 6 ++--- src/Reaktor/Plugins/Register.hs | 22 +++++++++--------- src/Reaktor/Plugins/System.hs | 42 +++++++++++++++++----------------- src/Reaktor/Plugins/System/Internal.hs | 9 +++++--- 11 files changed, 114 insertions(+), 91 deletions(-) create mode 100644 src/Data/Text/Extended.hs diff --git a/reaktor2.cabal b/reaktor2.cabal index aced473..d97cad9 100644 --- a/reaktor2.cabal +++ b/reaktor2.cabal @@ -1,5 +1,5 @@ name: reaktor2 -version: 0.1.1 +version: 0.1.2 license: MIT author: tv maintainer: tv diff --git a/src/Data/Text/Extended.hs b/src/Data/Text/Extended.hs new file mode 100644 index 0000000..70eef63 --- /dev/null +++ b/src/Data/Text/Extended.hs @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Data.Text.Extended + ( module Data.Text + , show + ) where + +import Data.Text +import Prelude hiding (show) +import qualified Prelude + +show :: Show a => a -> Text +show = pack . Prelude.show diff --git a/src/Prelude/Extended.hs b/src/Prelude/Extended.hs index 69dc8c8..55bcfe2 100644 --- a/src/Prelude/Extended.hs +++ b/src/Prelude/Extended.hs @@ -7,5 +7,6 @@ import Data.ByteString.Char8.Extended as Export (ByteString) import Data.Default as Export (Default,def) import Data.HashMap.Lazy as Export (HashMap) import Data.Maybe as Export (fromMaybe,isJust,isNothing) +import Data.Text as Export (Text) import Data.Vector as Export (Vector) import Prelude as Export diff --git a/src/Reaktor.hs b/src/Reaktor.hs index 3f968ac..e35792f 100644 --- a/src/Reaktor.hs +++ b/src/Reaktor.hs @@ -10,10 +10,12 @@ module Reaktor import Blessings import Control.Concurrent.Extended import Control.Exception -import Data.Attoparsec.ByteString.Char8 (feed,parse) -import Data.Attoparsec.ByteString.Char8 (IResult(Done,Fail,Partial)) +import Data.Attoparsec.Text (feed,parse) +import Data.Attoparsec.Text (IResult(Done,Fail,Partial)) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8.Extended as BS +import qualified Data.Text.Encoding as T +import qualified Data.Text.Extended as T import Data.Foldable (toList) import Data.Time.Clock.System import Data.Time.Format @@ -92,11 +94,11 @@ run Config{..} getPlugins = putStrLn "" -logger :: System.IO.Handle -> IO (Blessings ByteString) -> IO () +logger :: System.IO.Handle -> IO (Blessings Text) -> IO () logger h takeLog = forever $ do s <- takeLog let s' = if lastChar s == '\n' then s else s <> Plain "\n" - System.IO.hPutStr h $ pp $ fmap BS.unpack s' + System.IO.hPutStr h $ pp $ fmap T.unpack s' pinger :: (Message -> IO ()) -> IO () pinger aSend = forever $ do @@ -109,15 +111,19 @@ receiver :: Actions -> (Message -> IO ()) -> IO (Maybe ByteString) -> IO () receiver Actions{..} putInMsg sockRecv = receive "" where + decode :: ByteString -> Text + decode = T.decodeUtf8With (\_err _c -> Just '?') + + receive :: Text -> IO () receive "" = sockRecv >>= \case Nothing -> logErr "EOL" - Just buf -> receive buf + Just buf -> receive (decode buf) receive buf = go (parse Parser.message buf) where - go :: IResult ByteString Message -> IO () + go :: IResult Text Message -> IO () go = \case Done rest msg -> do logMsg msg @@ -126,11 +132,11 @@ receiver Actions{..} putInMsg sockRecv = p@(Partial _) -> sockRecv >>= \case - Nothing -> logErr ("EOF with partial " <> Plain (BS.show p)) - Just msg -> go (feed p msg) + Nothing -> logErr ("EOF with partial " <> Plain (T.show p)) + Just buf' -> go (feed p (decode buf')) f@(Fail _i _errorContexts _errMessage) -> - logErr ("failed to parse message: " <> Plain (BS.show f)) + logErr ("failed to parse message: " <> Plain (T.show f)) logErr s = aLog $ SGR [31,1] ("! receive: " <> s) @@ -144,7 +150,7 @@ receiver Actions{..} putInMsg sockRecv = sender :: IO Message -> (ByteString -> IO ()) -> IO () sender takeOutMsg sockSend = - forever $ takeOutMsg >>= sockSend . formatMessage + forever $ takeOutMsg >>= sockSend . T.encodeUtf8 . formatMessage splitter :: [Message -> IO ()] -> IO Message -> IO () splitter plugins takeInMsg = @@ -161,24 +167,24 @@ logMsgFilter = \case Just (Message p "PRIVMSG" ["NickServ",xs']) where check = elem cmd ["IDENTIFY","REGAIN"] && length ws > 2 - ws = BS.words xs + ws = T.words xs (cmd:ws') = ws (nick:_) = ws' - xs' = BS.unwords [cmd, nick, ""] + xs' = T.unwords [cmd, nick, ""] msg -> Just msg -privmsg :: ByteString -> [ByteString] -> Message +privmsg :: Text -> [Text] -> Message privmsg msgtarget xs = - Message Nothing "PRIVMSG" (msgtarget:BS.intercalate " " xs:[]) + Message Nothing "PRIVMSG" (msgtarget:T.intercalate " " xs:[]) -lastChar :: Blessings ByteString -> Char -lastChar = BS.last . last . toList +lastChar :: Blessings Text -> Char +lastChar = T.last . last . toList -prefixTimestamp :: Blessings ByteString -> IO (Blessings ByteString) +prefixTimestamp :: Blessings Text -> IO (Blessings Text) prefixTimestamp s = do - t <- SGR [38,5,239] . Plain . BS.pack <$> getTimestamp + t <- SGR [38,5,239] . Plain . T.pack <$> getTimestamp return (t <> " " <> s) stripSGR :: Blessings a -> Blessings a diff --git a/src/Reaktor/Internal.hs b/src/Reaktor/Internal.hs index 48a3f24..e52a347 100644 --- a/src/Reaktor/Internal.hs +++ b/src/Reaktor/Internal.hs @@ -6,8 +6,8 @@ module Reaktor.Internal where import Prelude.Extended import Blessings import Data.Aeson +import qualified Data.Text as T import Network.Socket as Exports (HostName,ServiceName) -import qualified Data.ByteString.Char8.Extended as BS import System.IO @@ -15,10 +15,10 @@ data Actions = Actions { aIsSecure :: Bool , aSend :: Message -> IO () - , aLog :: Blessings ByteString -> IO () + , aLog :: Blessings Text -> IO () - , aSetNick :: ByteString -> IO () - , aGetNick :: IO ByteString + , aSetNick :: Text -> IO () + , aGetNick :: IO Text } @@ -26,10 +26,11 @@ data Config = Config { cUseTLS :: Bool , cHostName :: HostName , cServiceName :: ServiceName - , cNick :: Maybe ByteString + , cNick :: Maybe Text , cLogHandle :: Handle , cLogTime :: Bool } + deriving Show instance Default Config where def = Config False "irc.r" "6667" Nothing stderr True @@ -50,15 +51,15 @@ instance FromJSON Config where tlsPort = "6697" -data Message = Message (Maybe ByteString) ByteString [ByteString] | Start +data Message = Message (Maybe Text) Text [Text] | Start deriving Show -formatMessage :: Message -> ByteString +formatMessage :: Message -> Text formatMessage = \case Message mb_prefix cmd params -> maybe "" ((":"<>) . (<>" ")) mb_prefix <> cmd - <> BS.concat (map (" "<>) (init params)) + <> T.concat (map (" "<>) (init params)) <> if null params then "" else " :" <> last params <> "\r\n" x -> error ("cannot format " <> show x) diff --git a/src/Reaktor/Nick.hs b/src/Reaktor/Nick.hs index 591ea4b..76c98f7 100644 --- a/src/Reaktor/Nick.hs +++ b/src/Reaktor/Nick.hs @@ -1,30 +1,31 @@ module Reaktor.Nick where -import Data.ByteString.Char8.Extended (ByteString) -import qualified Data.ByteString.Char8.Extended as BS -import Data.Char (chr) -import Data.Char (isDigit) -import System.Random (getStdRandom, randomR) +import Data.Char (chr) +import Data.Char (isDigit) +import qualified Data.Text as T +import qualified Data.Text.Read as T (decimal) +import Prelude.Extended +import System.Random (getStdRandom, randomR) -getNext :: ByteString -> ByteString +getNext :: Text -> Text getNext nick_ = nick' where + splitNick :: Text -> (Text, Int) splitNick s = - (prefix, maybe 0 fst (BS.readInt suffix)) + (prefix, either (const 0) fst (T.decimal suffix)) where - prefix = BS.take (BS.length s - BS.length suffix) s - suffix = BS.reverse . BS.takeWhile isDigit . BS.reverse $ s + prefix = T.take (T.length s - T.length suffix) s + suffix = T.reverse . T.takeWhile isDigit . T.reverse $ s (nickPrefix, nickSuffix) = splitNick nick_ - nick' = nickPrefix <> (BS.pack . show $ nickSuffix + 1) + nick' = nickPrefix <> (T.pack . show $ nickSuffix + 1) - -getRandom :: IO ByteString +getRandom :: IO Text getRandom = do h_chr <- getRandomChar nickhead t_len <- getStdRandom (randomR (4,8)) :: IO Int t_str <- mapM (const $ getRandomChar nicktail) [1..t_len] - return $ BS.pack (h_chr:t_str) + return $ T.pack (h_chr:t_str) where getRandomChar cs = (cs!!) <$> getStdRandom (randomR (0, length cs - 1)) diff --git a/src/Reaktor/Parser.hs b/src/Reaktor/Parser.hs index 1b358fc..f226ad5 100644 --- a/src/Reaktor/Parser.hs +++ b/src/Reaktor/Parser.hs @@ -1,37 +1,36 @@ {-# LANGUAGE OverloadedStrings #-} module Reaktor.Parser where +import Prelude.Extended import Control.Applicative -import Data.ByteString (ByteString) -import Data.Attoparsec.ByteString.Char8 ---import qualified Data.ByteString.Char8.Extended as BS -import qualified Data.ByteString.Char8 as BS +import Data.Attoparsec.Text import qualified Data.Char +import qualified Data.Text.Extended as T import Reaktor.Internal -prefix :: Parser ByteString -prefix = BS.pack <$> many (satisfy Data.Char.isAlphaNum <|> +prefix :: Parser Text +prefix = T.pack <$> many (satisfy Data.Char.isAlphaNum <|> satisfy (flip elem (":.-@/!~[]\\`_^{|}" :: String))) -command :: Parser ByteString -command = BS.pack <$> many1 (satisfy Data.Char.isAlphaNum) +command :: Parser Text +command = T.pack <$> many1 (satisfy Data.Char.isAlphaNum) nospcrlfcl :: Parser Char nospcrlfcl = satisfy (flip notElem ("\NUL\CR\LF :" :: String)) "nospcrlfcl" -middle :: Parser ByteString +middle :: Parser Text middle = - BS.pack <$> ((:) <$> nospcrlfcl <*> many (char ':' <|> nospcrlfcl)) + T.pack <$> ((:) <$> nospcrlfcl <*> many (char ':' <|> nospcrlfcl)) "middle" -trailing :: Parser ByteString +trailing :: Parser Text trailing = - BS.pack <$> many (char ':' <|> char ' ' <|> nospcrlfcl) + T.pack <$> many (char ':' <|> char ' ' <|> nospcrlfcl) "trailing" -params :: Parser [ByteString] +params :: Parser [Text] params = (do a <- many (char ' ' *> middle) b <- optional (char ' ' *> char ':' *> trailing) diff --git a/src/Reaktor/Plugins/Mention.hs b/src/Reaktor/Plugins/Mention.hs index 379bd38..b3cdbb8 100644 --- a/src/Reaktor/Plugins/Mention.hs +++ b/src/Reaktor/Plugins/Mention.hs @@ -4,8 +4,8 @@ module Reaktor.Plugins.Mention (new) where import Prelude.Extended -import qualified Data.ByteString.Char8.Extended as BS import qualified Data.Char +import qualified Data.Text as T import Reaktor @@ -19,5 +19,5 @@ new Actions{..} = do _ -> return () where isMention nick text = - not (BS.isPrefixOf (nick <> ":") text) && - any (==nick) (BS.splitWith (not . Data.Char.isAlphaNum) text) + not (T.isPrefixOf (nick <> ":") text) && + any (==nick) (T.split (not . Data.Char.isAlphaNum) text) diff --git a/src/Reaktor/Plugins/Register.hs b/src/Reaktor/Plugins/Register.hs index 0809006..ff420f0 100644 --- a/src/Reaktor/Plugins/Register.hs +++ b/src/Reaktor/Plugins/Register.hs @@ -7,15 +7,15 @@ module Reaktor.Plugins.Register where import Blessings import Prelude.Extended import Data.Aeson -import Data.ByteString.Char8.Extended (ByteString) -import qualified Data.ByteString.Char8.Extended as BS +import qualified Data.Text as T +import qualified Data.Text.IO as T import qualified Reaktor.Nick as Nick import Reaktor import System.Environment (lookupEnv) data ConfigNickServ = ConfigNickServ { cnsPassFile :: FilePath - , cnsPrefix :: ByteString + , cnsPrefix :: Text } instance FromJSON ConfigNickServ where parseJSON = \case @@ -26,10 +26,10 @@ instance FromJSON ConfigNickServ where _ -> undefined data Config = Config - { cNick :: Maybe ByteString - , cUser :: Maybe ByteString - , cReal :: ByteString - , cChannels :: [ByteString] + { cNick :: Maybe Text + , cUser :: Maybe Text + , cReal :: Text + , cChannels :: [Text] , cNickServ :: Maybe ConfigNickServ } instance Default Config where @@ -54,18 +54,18 @@ new Config{..} Actions{..} = do regain nick pass = do aSend (privmsg "NickServ" ["REGAIN", nick, pass]) - channelsArg = BS.intercalate "," cChannels + channelsArg = T.intercalate "," cChannels -- TODO make this similar to privmsg (i.e. don't aSend) join = do -- TODO JOIN only if not already joined -- i.e. not during subsequent nick changes - unless (BS.null channelsArg) $ + unless (T.null channelsArg) $ aSend (Message Nothing "JOIN" [channelsArg]) start = do nick <- maybe aGetNick pure cNick user <- - maybe (maybe nick BS.pack <$> lookupEnv "LOGNAME") pure cUser + maybe (maybe nick T.pack <$> lookupEnv "LOGNAME") pure cUser aSetNick nick aSend (Message Nothing "NICK" [nick]) aSend (Message Nothing "USER" [user, "*", "0", cReal]) @@ -103,7 +103,7 @@ new Config{..} Actions{..} = do else do -- TODO do not fail, but disable NicServ - [pass] <- BS.lines <$> BS.readFile cnsPassFile + [pass] <- T.lines <$> T.readFile cnsPassFile pure $ \case Start -> start Message (Just _self) "NICK" (newnick:[]) -> onNick newnick diff --git a/src/Reaktor/Plugins/System.hs b/src/Reaktor/Plugins/System.hs index 8154423..f31f640 100644 --- a/src/Reaktor/Plugins/System.hs +++ b/src/Reaktor/Plugins/System.hs @@ -9,11 +9,10 @@ import Blessings import Control.Applicative import Control.Concurrent (forkIO) import Control.Exception -import qualified Data.ByteString.Char8.Extended as BS -import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Search as BS import qualified Data.HashMap.Lazy as M import qualified Data.List as L +import qualified Data.Text.Extended as T +import qualified Data.Text.IO as T import qualified Data.Vector as V import Prelude.Extended import Reaktor @@ -42,7 +41,7 @@ new config@Config{..} actions@Actions{..} = do _ -> pure () -run1 :: Config -> Actions -> Hook -> ByteString -> ByteString -> ByteString -> IO () +run1 :: Config -> Actions -> Hook -> Text -> Text -> Text -> IO () run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do nick <- aGetNick @@ -56,16 +55,16 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do Just pat -> let result = RE.scan patternRE text - patternRE = RE.compile pat [] + patternRE = RE.compile pat [RE.utf8] in if null result then Nothing else Just "" Query -> if - | BS.isPrefixOf (nick <> ":") text -> + | T.isPrefixOf (nick <> ":") text -> Just (nick <> ":") - | BS.isPrefixOf "*:" text -> + | T.isPrefixOf "*:" text -> Just "*:" | isQuery -> Just "" @@ -73,7 +72,8 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do Nothing audience = if isQuery then from else msgtarget - from = BS.takeWhile (/='!') prefix + + from = T.takeWhile (/='!') prefix -- TODO check if msgtarget is one of our channels? -- what if our nick has changed? @@ -82,14 +82,14 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do case isActivated of Just trigger -> do let - cmdline = BS.dropWhile (==' ') $ BS.drop (BS.length trigger) text + cmdline = T.dropWhile (==' ') $ T.drop (T.length trigger) text resultPrefix = if isQuery then [] else [from <> ":"] parseCommandLine' pat s = if null result then [] else snd (head result) where result = RE.scan patternRE s - patternRE = RE.compile pat [] + patternRE = RE.compile pat [RE.utf8] captures = V.fromList $ @@ -102,7 +102,7 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do name = case hCommand of Capture i -> fromMaybe "" (capture i) - CaptureOr Command{..} -> BS.pack $ takeBaseName $ commandPath + CaptureOr Command{..} -> T.pack $ takeBaseName $ commandPath command = case hCommand of @@ -110,7 +110,7 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do CaptureOr c -> Just c args = - map (maybe "" BS.unpack) + map (maybe "" T.unpack) $ L.dropWhileEnd isNothing -- $ map getArgument hArguments $ flip map hArguments @@ -124,7 +124,7 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do let onExit code = do - let s = BS.show code + let s = T.show code (sig, col) = if code == ExitSuccess then (SGR [38,5,235] "* ", SGR [38,5,107]) @@ -133,8 +133,8 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do onExcept :: SomeException -> IO () onExcept e = do - let s0 = BS.show e - s = BL.toStrict $ BS.replace (BS.pack commandPath) name s0 + let s0 = T.show e + s = T.replace (T.pack commandPath) name s0 aLog $ SGR [38,5,235] "! " <> SGR [31,1] (Plain $ name <> ": " <> s0) aSend (privmsg audience (resultPrefix <> [s])) @@ -144,8 +144,8 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do onOutLine s = aSend (privmsg audience [s]) extraEnv = - [ ("_prefix", BS.unpack prefix) - , ("_from", BS.unpack from) + [ ("_prefix", T.unpack prefix) + , ("_from", T.unpack from) ] env = @@ -171,8 +171,8 @@ fork :: FilePath -> Maybe FilePath -> Maybe [(String, String)] -> String - -> (ByteString -> IO ()) - -> (ByteString -> IO ()) + -> (Text -> IO ()) + -> (Text -> IO ()) -> (ExitCode -> IO ()) -> IO () fork path args cwd env input onOutLine onErrLine onExit = do @@ -196,7 +196,7 @@ fork path args cwd env input onOutLine onErrLine onExit = do waitForProcess ph >>= onExit -hWithLines :: Handle -> (ByteString -> IO ()) -> IO () +hWithLines :: Handle -> (Text -> IO ()) -> IO () hWithLines h f = do hSetBuffering h LineBuffering go `finally` hClose h @@ -204,4 +204,4 @@ hWithLines h f = do go = hIsEOF h >>= \case True -> return () - False -> BS.hGetLine h >>= f >> go + False -> T.hGetLine h >>= f >> go diff --git a/src/Reaktor/Plugins/System/Internal.hs b/src/Reaktor/Plugins/System/Internal.hs index ac707ae..9b1b8de 100644 --- a/src/Reaktor/Plugins/System/Internal.hs +++ b/src/Reaktor/Plugins/System/Internal.hs @@ -18,6 +18,7 @@ instance FromJSON a => FromJSON (CaptureOr a) where -- TODO query means via direct privmsg and : data Activate = Always | Match | Query + deriving Show instance FromJSON Activate where parseJSON = \case @@ -28,8 +29,9 @@ instance FromJSON Activate where data Config = Config { cWorkDir :: Maybe FilePath - , cHooks :: HashMap ByteString [Hook] + , cHooks :: HashMap Text [Hook] } + deriving Show instance Default Config where def = Config Nothing mempty @@ -46,10 +48,11 @@ data Hook = Hook { hActivate :: Activate , hPattern :: Maybe ByteString , hCommand :: CaptureOr Command - , hArguments :: [CaptureOr ByteString] + , hArguments :: [CaptureOr Text] , hWorkDir :: Maybe FilePath - , hCommands :: HashMap ByteString Command + , hCommands :: HashMap Text Command } + deriving Show instance FromJSON Hook where parseJSON = \case -- cgit v1.2.3