Skip to content

Commit

Permalink
Formatted and removed some debugging code.
Browse files Browse the repository at this point in the history
  • Loading branch information
applePrincess committed Apr 7, 2018
1 parent 3342323 commit 15ad905
Showing 1 changed file with 36 additions and 85 deletions.
121 changes: 36 additions & 85 deletions app/CommentReader/Main.hs
Original file line number Diff line number Diff line change
@@ -1,26 +1,27 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
-- {-# LANGUAGE CPP #-}
module Main (main) where

import Control.Monad (when)
import qualified Data.ByteString as B
import Control.Monad (when)
import qualified Data.ByteString as B
import Data.IORef
import Data.List (elemIndices)
import Data.Semigroup ((<>))
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.List (elemIndices)
import Data.Semigroup ((<>))
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word
import System.IO (hFlush, stdout, stdin, hSetEcho, hGetEcho)
import System.IO.Unsafe (unsafePerformIO)
import System.Process (createProcess, shell)
import System.IO (hFlush, hGetEcho, hSetEcho, stdin,
stdout)
import System.IO.Unsafe (unsafePerformIO)
import System.Process (createProcess, shell)

import Network.Socket hiding (recv, send)
import Network.Socket.ByteString (send)
import Options.Applicative
import Network.Socket hiding (recv, send)
import Network.Socket.ByteString (send)
import Options.Applicative

import Framework
import Mimizu
import Framework
import Mimizu

data ReadingSystem = Bouyomi | Softalk deriving (Show, Read, Eq)

Expand All @@ -32,10 +33,6 @@ data Options = Options
, identifier :: String
, password :: String
, formatStr :: String
#ifdef DEBUG
, connectTo :: String
, isChatOnly :: Bool
#endif
}

parseOptions :: Parser Options
Expand Down Expand Up @@ -87,32 +84,17 @@ parseOptions = Options
<> metavar "FORMAT"
<> value "%s\t%m"
<> showDefault )
#ifdef DEBUG
<*> option str
( long "game-connect-to"
<> metavar "GAMEIP"
<> short 'g'
<> showDefault
<> value "160.16.82.222"
<> help "IP addres, the game/the chat connecting to")
<*> switch
( long "chat-only"
<> short 'c'
<> help "Specifies whether chat only or not")
#endif

{-# NOINLINE options #-}
options :: IORef Options
options = unsafePerformIO $ newIORef (Options Bouyomi
"softalk.exe"
"127.0.0.1"
50001
""
""
"%s\t%m"
#ifdef DEBUG
"160.16.82.222" False
#endif
options = unsafePerformIO $ newIORef (Options
Bouyomi
"softalk.exe"
"127.0.0.1"
50001
""
""
"%s\t%m"
)

errorHandler :: ErrorHandler
Expand Down Expand Up @@ -184,10 +166,10 @@ getPassword = do


formatMessage :: Chat -> String -> T.Text
formatMessage c fStr = T.replace (T.pack "%s") (T.pack $ sender c) $
formatMessage c fStr = T.replace (T.pack "\\t") (T.pack "\t") $
T.replace (T.pack "%s") (T.pack $ sender c) $
T.replace (T.pack "%m") (T.pack $ message c) (T.pack fStr)

-- これもフォーマット させたいが,今は時間がないので, とりあえず 名前とメッセージだけを送信!
generateBouyomiData :: Chat -> String -> B.ByteString
generateBouyomiData chat fStr = B.pack $ sendCommand ++ defaultSpeed ++ defaultPitch
++ defaultVolume ++ defaultTone ++ defaultEncoding
Expand All @@ -212,52 +194,21 @@ main = do
<> header "chat - a simple comment reader bridge" )
opt <- execParser hdr
atomicModifyIORef' options $ const (opt, ())
#ifdef DEBUG
let host = hFunc . map ((read :: String -> Word8) . T.unpack) $ T.split (== '.') $ T.pack (connectTo opt')
cFunc = if isChatOnly opt' then Just chatReceived else Nothing
#else
let host = (160, 16, 82, 222)
cFunc = Just chatReceived
#endif
opt' <- readIORef options
#ifdef DEBUG
putStr "PID: "
hFlush stdout
pid <- getLine
if not (null pid)
then mainLoop pid errorHandler sampleGameReceive chatCallback chatCallback' False
#else
if False
then undefined
#endif

#ifdef DEBUG
(isChatOnly opt')
#else
True
#endif
(Just host)
Nothing
Nothing
cFunc
else do id' <- if null (identifier opt')
then do putStr "ID: "
hFlush stdout
getLine
else return (identifier opt')
password' <- if null (password opt')
then getPassword
else return (password opt')
mainLoop "" errorHandler sampleGameReceive chatCallback chatCallback' False
#ifdef DEBUG
(isChatOnly opt')
#else
id' <- if null (identifier opt')
then do putStr "ID: "
hFlush stdout
getLine
else return (identifier opt')
password' <- if null (password opt')
then getPassword
else return (password opt')
mainLoop "" errorHandler sampleGameReceive chatCallback chatCallback' False
True
#endif
(Just host)
(Just id')
(Just password')
cFunc
-- chatOnly id' password chatReceived
return ()
where hFunc [a, b, c, d] = (a, b, c, d)

0 comments on commit 15ad905

Please sign in to comment.