1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE DoAndIfThenElse #-}
7 import Control.Concurrent (threadDelay)
8 import Control.Exception.Base (bracket)
9 import Control.Monad (forever, when)
10 import Data.List (isPrefixOf)
11 import Data.Maybe (isNothing)
12 import Data.Monoid ((<>))
16 import System.Console.CmdArgs (def)
17 import System.Directory (doesFileExist)
18 import System.Exit (ExitCode(..), exitWith)
19 import System.FilePath ((</>))
21 BufferMode (NoBuffering),
30 import System.IO.Error (catchIOError)
32 import CommandLine (get_args)
33 import Configuration (Configuration(..), merge_optional)
38 import FeedHosts (FeedHosts(..))
39 import qualified OptionalConfiguration as OC (
40 OptionalConfiguration(..),
42 import Terminal (hPutRedLn, putGreenLn)
43 import TSN.Xml (parse_xmlfid, xml_prologue)
46 report_error :: String -> IO ()
47 report_error = hPutRedLn stderr
50 recv_line :: Handle -> IO String
57 save_document :: Configuration -> String -> IO ()
58 save_document cfg doc = do
61 report_error "ERROR: document missing XML_File_ID element."
63 already_exists <- doesFileExist path
64 when already_exists $ do
65 let msg = "WARNING: file " ++ path ++ " already exists. Overwriting."
69 xmlfid = fmap show (parse_xmlfid doc)
70 filename = fmap (++ ".xml") xmlfid
71 maybe_path = fmap ((output_directory cfg) </>) filename
73 -- | Loop forever, writing the buffer to file whenever a new XML
75 loop :: Configuration -> Handle -> [String] -> IO ()
76 loop !cfg !h !buffer = do
79 if (xml_prologue `isPrefixOf` line && not (null buffer))
81 -- This is the beginning of a new document, and we have an "old"
82 -- one to save. The buffer is in reverse (newest first) order,
83 -- though, so we have to reverse it first. We then concatenate all
84 -- of its lines into one big string.
85 let document = concat $ reverse buffer
86 save_document cfg document
87 loop cfg h [line] -- empty the buffer before looping again
89 loop cfg h (line : buffer) -- append line to the head of the buffer and loop
92 log_in :: Configuration -> Handle -> IO ()
94 prompt1 <- recv_prompt h
96 if prompt1 /= username_prompt then
97 report_error "ERROR: didn't receive username prompt."
99 send_line h (username cfg)
100 prompt2 <- recv_prompt h
102 if prompt2 /= password_prompt then
103 report_error "ERROR: didn't receive password prompt."
105 send_line h (password cfg)
106 _ <- recv_line h -- "The Sports Network"
109 username_prompt = "Username: "
110 password_prompt = "Password: "
112 send_line :: Handle -> String -> IO ()
114 hPutStr h' (s ++ "\r\n")
117 recv_chars :: Int -> Handle -> IO String
119 s <- sequence [ hGetChar h' | _ <- [1..n] ]
123 recv_prompt :: Handle -> IO String
124 recv_prompt = recv_chars 10
126 connect_and_loop :: Configuration -> IO ()
127 connect_and_loop cfg =
128 bracket acquire_handle release_handle action
130 --acquire_handle = connectTo "feed1.sportsnetwork.com" (PortNumber 4500)
131 acquire_handle = connectTo "feed2.sportsnetwork.com" (PortNumber 4500)
132 --acquire_handle = connectTo "127.0.0.1" (PortNumber 13337)
133 release_handle = hClose
135 -- No buffering anywhere.
136 hSetBuffering h NoBuffering
141 -- | A wrapper around threadDelay which takes seconds instead of
142 -- microseconds as its argument.
143 thread_sleep :: Int -> IO ()
144 thread_sleep seconds = do
145 let microseconds = seconds * (10 ^ (6 :: Int))
146 threadDelay microseconds
154 -- Merge the config file options with the command-line ones,
155 -- prefering the command-line ones.
156 let opt_config = rc_cfg <> cmd_cfg
158 when (null $ get_feed_hosts (OC.feed_hosts opt_config)) $ do
159 report_error "ERROR: no feed hosts supplied."
160 exitWith (ExitFailure exit_no_feed_hosts)
162 when (isNothing (OC.password opt_config)) $ do
163 report_error "ERROR: no password supplied."
164 exitWith (ExitFailure exit_no_password)
166 when (isNothing (OC.username opt_config)) $ do
167 report_error "ERROR: no username supplied."
168 exitWith (ExitFailure exit_no_username)
170 -- Finally, update a default config with any options that have been
171 -- set in either the config file or on the command-line.
172 let cfg = (def :: Configuration) `merge_optional` opt_config
174 hSetBuffering stderr NoBuffering
175 hSetBuffering stdout NoBuffering
178 catchIOError (connect_and_loop cfg) (report_error . show)
179 thread_sleep 10 -- Wait 10s before attempting to reconnect.