Added interface for humans.

StatusBot.cabal

@@ -35,6 +35,8 @@ library
       Initialization
       Logger
       Logger.Handle
+      Parsing
+      PrettyPrint
       Status
       Status.Handle
       Status.Implementation

app/Main.hs

@@ -2,16 +2,20 @@
 module Main (main) where
 
 import Control.Concurrent (ThreadId, killThread, forkOS)
-import Control.Monad (when)
+import Data.Text (Text)
 import Data.Maybe (catMaybes)
 
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+import Front.ConsoleHTTP (ConsoleHTTP)
 import Initialization
    ( AppConfig, initApp, withTelegramAPIHandle, withLoggerConfig
    , consoleFrontEnabled, telegramFrontEnabled)
 
 import qualified App
-import qualified Front.ConsoleHTTP as ConsoleHTTP (createHandle) 
-import qualified Front.TelegramHTTP as TelegramHTTP (createHandle)
+import qualified Front.ConsoleHTTP as ConsoleHTTP 
+import qualified Front.TelegramHTTP as TelegramHTTP
 import qualified Logger
 import qualified Status.Implementation as Status
 
@@ -22,37 +26,88 @@ main = do
    print appCfg
    withLoggerConfig appCfg $ \loggerCfg -> do
       print $ Logger.cfgConnectionHandle loggerCfg
-      threads <- runAllFronts appCfg loggerCfg
-      listenCommands
+      let hLogger = Logger.createHandle loggerCfg
+      threads <- runExternalFronts appCfg hLogger
+      if (consoleFrontEnabled appCfg)
+         then runConsoleFront hLogger
+         else listenCommands
       mapM_ killThread threads
 
-runAllFronts :: AppConfig -> Logger.Config IO -> IO [ThreadId]
-runAllFronts appCfg loggerCfg = do
-   tgThread <- if (telegramFrontEnabled appCfg)
-               then fmap Just $ forkOS (runTelegramFront appCfg loggerCfg)
-               else return Nothing
-   when (consoleFrontEnabled appCfg)
-      $ runConsoleFront loggerCfg
+-- | Runs all external fonts that allowed by config 
+-- in separate IO thread. Returns their thread ids.
+runExternalFronts :: AppConfig -> Logger.Handle IO -> IO [ThreadId]
+runExternalFronts appCfg hLogger = do
+   tgThread <-
+      if (telegramFrontEnabled appCfg)
+      then do
+         thread <- forkOS (runTelegramFront appCfg hLogger)
+         T.putStrLn "Telegram bot enabled"
+         return $ Just thread
+      else return Nothing
    return . catMaybes $ tgThread : []
 
-runConsoleFront :: Logger.Config IO -> IO ()
-runConsoleFront loggerCfg = do
-   let hLogger = Logger.createHandle loggerCfg
-       hFront = ConsoleHTTP.createHandle hLogger
-       hStatus = Status.createHandle hLogger
-   App.runAppSimpleForever App.Handle{..}
-
-runTelegramFront :: AppConfig -> Logger.Config IO -> IO ()
-runTelegramFront appCfg loggerCfg = do
-   let hLogger = Logger.createHandle loggerCfg
+-- | Runs telegram front in forever loop.
+runTelegramFront :: AppConfig -> Logger.Handle IO -> IO ()
+runTelegramFront appCfg hLogger = do
    withTelegramAPIHandle appCfg hLogger $ \hAPITg -> do
       let hFront = TelegramHTTP.createHandle hAPITg hLogger
           hStatus = Status.createHandle hLogger
       App.runAppSimpleForever App.Handle{..}
 
+-- | Console is a bit special, sice we want to control over app
+-- and it's functional simultaneously.
+-- So this function listens to console input
+-- and runs console front on getStatus command.
+runConsoleFront :: Logger.Handle IO -> IO ()
+runConsoleFront hLogger = do
+   let front  = ConsoleHTTP.createHandleWithProvidedInput hLogger
+       hStatus = Status.createHandle hLogger
+   T.putStrLn "Console bot enabled"
+   printHelpConsole
+   listenConsoleCommands 
+      $ \input -> let hFront = front input in App.Handle{..}
+-- Dirty hack.
+
+-- | Controlls app throught console input,
+-- and acts as console tool on getStatus command.
+listenConsoleCommands :: (Text -> App.Handle ConsoleHTTP IO) -> IO ()
+listenConsoleCommands hApp = do
+   input <- T.getLine
+   case T.words input of
+      ("stop":_)
+         -> return ()
+      ("help":_)
+         -> printHelpConsole >> listenConsoleCommands hApp
+      ("getStatus":rest)
+         -> App.runAppSimple (hApp $ mconcat rest)
+         >> listenConsoleCommands hApp
+      _
+         -> listenConsoleCommands hApp
+
+-- | Controlls app throught console input.
+-- Useful if console disabled, or we want kind of silent mode.
 listenCommands :: IO ()
-listenCommands = do
-   input <- getLine
-   case input of
-      "stop" -> return ()
-      _      -> listenCommands
+listenCommands = printHelpGeneric >> listenCommands'
+
+listenCommands' :: IO ()
+listenCommands' =  do
+   input <- T.getLine
+   case T.words input of
+      ("stop":_)
+         -> return ()
+      ("help":_)
+         -> printHelpGeneric >> listenCommands'
+      _
+         -> listenCommands'
+
+printHelpConsole :: IO ()
+printHelpConsole =
+   T.putStrLn $ T.unlines 
+      ["getStatus <IP> - asks for server status."]
+
+printHelpGeneric :: IO ()
+printHelpGeneric =
+   T.putStrLn $ T.unlines 
+      [ "help - prints this message"
+      , "stop - to stop app. Note, it may take time to close http calls."
+      ]

src/API/Telegram.hs

@@ -57,9 +57,9 @@ getUpdates h@Handle{..} = do
    case mRes of 
       Nothing -> return Nothing
       Just res -> do
-      let response = getResponseBody res
-      updateOffset h response
-      return $ Just response
+         let json = getResponseBody res
+         updateOffset h json
+         return $ Just json
 
 -- | Parses raw json list of telegram Update
 -- to users and their message texts.

src/App.hs

@@ -1,16 +1,18 @@
 {-# LANGUAGE RecordWildCards #-}
--- | App
+-- | App behavior defined here.
 module App
    ( Handle(..)
    , runAppSimpleForever
+   , runAppSimple
    ) where
 
 import Control.Concurrent (threadDelay)
 import Control.Monad (forever)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Text (Text)
 
-import Utils ((.<))
+import PrettyPrint
+import Parsing (parseAddress)
 
 import qualified Front as Front
 import qualified Logger as Logger
@@ -27,11 +29,16 @@ runAppSimpleForever
    :: (MonadIO m, Show user)
    => Handle user m
    -> m ()
-runAppSimpleForever h@Handle{..} =
-   forever $ do
-      userMessages <- Front.getMessages hFront
-      mapM_ (uncurry (processUserMessage h)) userMessages
-      liftIO $ threadDelay 100000
+runAppSimpleForever h = forever $ runAppSimple h
+
+runAppSimple
+   :: (MonadIO m, Show user)
+   => Handle user m
+   -> m ()
+runAppSimple h@Handle{..} = do
+   userMessages <- Front.getMessages hFront
+   mapM_ (uncurry (processUserMessage h)) userMessages
+   liftIO $ threadDelay 100000 -- 0.1 sec
 
 processUserMessage
    :: (MonadIO m, Show user)
@@ -40,12 +47,15 @@ processUserMessage
    -> Text
    -> m ()
 processUserMessage Handle{..} user text = do
-   let eAdress = Status.parseAdress text
+   let eAdress = parseAddress text
    case eAdress of
       Left parseErr -> 
          Front.sendMessage hFront user
-            $ "" .< parseErr
-      Right adress -> do
-         serverStatus <- Status.getStatus hStatus adress
+            $ prettyPrint parseErr
+      Right address -> do
+         serverStatus <- Status.getStatus hStatus address
          Front.sendMessage hFront user
-            $ "Server " .< adress <> " is " .< serverStatus
+            $ "Server " 
+            <> (prettyPrint address)
+            <> " is "
+            <> (prettyPrint serverStatus)

src/Front/ConsoleHTTP.hs

@@ -1,10 +1,9 @@
 {-# LANGUAGE RecordWildCards #-}
 -- | Front implementation.
-
--- TO-DO
--- Add user input validation.
 module Front.ConsoleHTTP
-   ( createHandle
+   ( ConsoleHTTP
+   , createHandleWithProvidedInput
+   , createHandle
    ) where
 
 import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -21,6 +20,13 @@ data ConsoleHTTP = ConsoleHTTP
 
 type Handle m = Front.Handle ConsoleHTTP m
 
+createHandleWithProvidedInput
+   :: MonadIO m => Logger.Handle m -> Text -> Handle m
+createHandleWithProvidedInput hLogger msg =
+   let hGetMessages = return [(ConsoleHTTP, msg)]
+       hSendMessage _ text = liftIO $ T.putStrLn text
+   in Front.Handle{..}
+
 createHandle :: MonadIO m => Logger.Handle m -> Handle m
 createHandle hLogger =
    let hGetMessages = getMessages

src/Parsing.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE RecordWildCards #-}
+-- | Different funtions to make life easier.
+module Parsing
+   ( parseAddress
+   ) where
+
+
+import Data.ByteString (ByteString)
+import Data.Text (Text)
+import Network.HTTP.Client (isIpAddress)
+
+import qualified Data.Text.Encoding as T
+
+import PrettyPrint
+import Status (ServerAdress(..))
+
+data ParsingError 
+   = AdressParsingError
+      { parsedText   :: Text
+      , errorMessage :: Text
+      }
+   -- | WhateverParsingError
+   deriving (Show)
+
+instance PrettyPrint ParsingError where
+   prettyPrint AdressParsingError{..} = errorMessage
+
+
+parseAddress
+   :: Text
+   -> Either ParsingError ServerAdress
+parseAddress text =
+   let adress = T.encodeUtf8 text
+   in if isIpAddress adress
+      then Right $ makeHttpAdress adress
+      else Left $ AdressParsingError text
+                $ "\"" <> text <> "\" is not a valid IP address."
+
+makeHttpAdress :: ByteString -> ServerAdress
+makeHttpAdress host =
+   ServerAdress {_host = host, _port = 80}

src/PrettyPrint.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE DefaultSignatures #-}
+-- | Printing data for humans.
+module PrettyPrint
+   ( PrettyPrint(..)
+   ) where
+
+import Data.Text (Text, pack)
+
+class PrettyPrint a where
+   prettyPrint :: a -> Text
+   default prettyPrint :: Show a => a -> Text
+   prettyPrint = pack . show

src/Status.hs

@@ -7,24 +7,12 @@ module Status
     , ServerAdress(..)
     , ServerStatus(..)
     , getStatus
-    , parseAdress
     ) where
 
-import Data.ByteString (ByteString)
-import Data.Text (Text)
-import Network.HTTP.Client (isIpAddress)
-
-import qualified Data.Text.Encoding as T
-
 import Logger (logInfo)
 import Status.Handle (Handle(..), ServerAdress(..), ServerStatus(..))
 import Utils ((.<))
 
-data ParsingError = AdressParsingError
-   { parsedText   :: Text
-   , errorMessage :: Text
-   } deriving (Show)
-
 -- | Returns status and logs action.
 getStatus
    :: (Monad m)
@@ -35,17 +23,4 @@ getStatus Handle{..} adress = do
    logInfo hLogger $ "Scanning " .< adress 
    status <- hGetStatus adress
    logInfo hLogger $ "Status: " .< status
-   return status
-
-parseAdress
-   :: Text
-   -> Either ParsingError ServerAdress
-parseAdress text =
-   let adress = T.encodeUtf8 text
-   in if isIpAddress adress
-      then Right $ Status.makeHttpAdress adress
-      else Left $ AdressParsingError text "Not a valid IP address."
-
-makeHttpAdress :: ByteString -> ServerAdress
-makeHttpAdress host =
-   ServerAdress {_host = host, _port = 80}
+   return status

src/Status/Handle.hs

@@ -8,6 +8,11 @@ module Status.Handle
 
 import Data.ByteString (ByteString)
 
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+
+import PrettyPrint
+
 import qualified Logger
 
 -- | Handle to inject imlementation into logic.
@@ -24,7 +29,13 @@ data ServerAdress = ServerAdress
    , _port :: Int
    } deriving (Show)
 
+instance PrettyPrint ServerAdress where
+   prettyPrint ServerAdress{..} =
+      (T.decodeUtf8 _host) <> ":" <> (T.pack $ show _port)
+
 data ServerStatus
    = Online
    | NotAvaible
-   deriving (Show, Eq)
+   deriving (Show, Eq)
+
+instance PrettyPrint ServerStatus