1 files changed, 33 insertions, 0 deletions

diff --git a/Presence/ConsoleWriter.hs b/Presence/ConsoleWriter.hs
index 2a77394f..5ed4f1df 100644
--- a/Presence/ConsoleWriter.hs
+++ b/Presence/ConsoleWriter.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 module ConsoleWriter
     ( ConsoleWriter(cwPresenceChan)
     , newConsoleWriter
@@ -43,19 +44,31 @@ import ClientState
 
 data ConsoleWriter = ConsoleWriter
     { cwPresenceChan :: TMVar (ClientState,Stanza)
+    -- ^ tty switches and logins are announced on this mvar
     , csActiveTTY :: TVar Word8
     , csUtmp :: TVar (Map Text (TVar (Maybe UtmpRecord)))
     , cwClients :: TVar (Map Text ClientState)
+    -- ^ This 'TVar' holds a map from resource id (tty name)
+    --   to ClientState for all active TTYs and PTYs.
     }
 
+tshow :: forall a. Show a => a -> Text
 tshow x = Text.pack . show $ x
 
+retryWhen :: forall b. STM b -> (b -> Bool) -> STM b
 retryWhen var pred = do
     value <- var
     if pred value then retry
                   else return value
 
 
+onLogin ::
+    forall t.
+    ConsoleWriter
+    -> (STM (Word8, Maybe UtmpRecord)
+        -> TVar (Maybe UtmpRecord) -> IO ())
+    -> t
+    -> IO ()
 onLogin cs start = \e -> do
     us <- UTmp.users2
     let (m,cruft) =
@@ -93,6 +106,9 @@ onLogin cs start = \e -> do
         forkIO . start getActive
     -- forM_ (Map.elems dead   ) $ putStrLn . ("gone: "++) . show
 
+-- | Sets up threads to monitor tty switches and logins that are
+-- written to the system utmp file and returns a 'ConsoleWriter'
+-- object for interacting with that information.
 newConsoleWriter :: IO ConsoleWriter
 newConsoleWriter = do
     chan <- atomically $ newEmptyTMVar
@@ -137,6 +153,7 @@ newConsoleWriter = do
 -- Transforms a string of form language[_territory][.codeset][@modifier]
 -- typically used in LC_ locale variables into the BCP 47
 -- language codes used in xml:lang attributes.
+toBCP47 :: [Char] -> [Char]
 toBCP47 lang = map hyphen $ takeWhile (/='.') lang
  where hyphen '_' = '-'
        hyphen  c  =  c
@@ -155,10 +172,14 @@ getPreferedLang = do
         return $ lc_all `mplus` lc_messages `mplus` lang
     return $ maybe "en" (Text.pack . toBCP47) lang
 
+cimatch :: Text -> Text -> Bool
 cimatch w t = Text.toLower w == Text.toLower t
+
+cimatches :: Text -> [Text] -> [Text]
 cimatches w ts = dropWhile (not . cimatch w) ts
 
 -- rfc4647 lookup of best match language tag
+lookupLang :: [Text] -> [Text] -> Maybe Text
 lookupLang (w:ws) tags
     | Text.null w = lookupLang ws tags
     | otherwise   = case cimatches w tags of
@@ -201,6 +222,11 @@ readEnvFile var file = fmap parse $ readFile file
      where
         gs = groupBy (\_ x -> pred x) xs
 
+-- | Delivers an XMPP message stanza to the currently active
+-- tty.  If that is a linux console, it will write to it similar
+-- to the manner of the BSD write command.  If that is an X11
+-- display, it will attempt to notify the user via a libnotify
+-- interface.
 writeActiveTTY :: ConsoleWriter -> Stanza -> IO Bool
 writeActiveTTY cw msg = do
     putStrLn $ "writeActiveTTY"
@@ -218,6 +244,8 @@ writeActiveTTY cw msg = do
         Just True -> deliverGUIMessage cw tty utmp msg
         _ -> deliverTerminalMessage cw tty utmp msg
 
+deliverGUIMessage ::
+    forall t t1. t -> t1 -> UtmpRecord -> Stanza -> IO Bool
 deliverGUIMessage cw tty utmp msg = do
     text <- do
         t <- messageText msg
@@ -243,6 +271,8 @@ crlf t = Text.unlines $ map cr (Text.lines t)
     cr t | Text.last t == '\r'  = t
          | otherwise            = t <> "\r"
 
+deliverTerminalMessage ::
+    forall t t1. t -> Text -> t1 -> Stanza -> IO Bool
 deliverTerminalMessage cw tty utmp msg = do
     mode <- fmap fileMode (getFileStatus $ Text.unpack tty)
     let mesgy = mode .&. 0o020 /= 0 -- verify mode g+w
@@ -256,6 +286,7 @@ deliverTerminalMessage cw tty utmp msg = do
     writeFile (Text.unpack tty) text
     return True -- return True if a message was delivered
 
+-- | Deliver the given message to all a user's PTYs.
 writeAllPty :: ConsoleWriter -> Stanza -> IO Bool
 writeAllPty cw msg = do
     us <- atomically $ readTVar (csUtmp cw)
@@ -275,8 +306,10 @@ resource u =
  where
     escapeR s = s
 
+textHostName :: IO Text
 textHostName = fmap Text.pack BSD.getHostName
 
+ujid :: UtmpRecord -> IO Text
 ujid u = do
     h <- textHostName
     return $ utmpUser u <> "@" <> h <> "/" <> resource u