hindentHEADmaster

6 files changed, 131 insertions, 128 deletions

diff --git a/src/IRE/Application.hs b/src/IRE/Application.hs
index 530e4a4..bd8c796 100644
--- a/src/IRE/Application.hs
+++ b/src/IRE/Application.hs
@@ -1,16 +1,18 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module IRE.Application (
-  app
-) where
+module IRE.Application
+  ( app
+  ) where
 
 import Control.Monad.Trans (liftIO)
 import Network.Wai (Application)
-import Network.Wai.Middleware.Static (addBase, hasPrefix, staticPolicy, (>->))
+import Network.Wai.Middleware.Static
+       ((>->), addBase, hasPrefix, staticPolicy)
 import Network.Wai.Parse (FileInfo(..))
 import System.FilePath.Posix ((</>))
-import Web.Scotty ( ActionM, ScottyM, file, files, get,
-  json, middleware, post, scottyApp )
+import Web.Scotty
+       (ActionM, ScottyM, file, files, get, json, middleware, post,
+        scottyApp)
 
 import IRE.Application.YOLO (findItems)
 import IRE.YOLO (Detector)
@@ -22,14 +24,11 @@ ire :: FilePath -> Detector -> ScottyM ()
 ire rootDir net = do
   middleware $ staticPolicy (hasPrefix "static" >-> addBase rootDir)
   get "/" $ file (rootDir </> "webui.html")
-
   post "/findItems" $ apiFindItems net
 
-
 apiFindItems :: Detector -> ActionM ()
 apiFindItems net = do
   fs <- files
-  let fc = head [ fileContent fi | (_, fi) <- fs ]
+  let fc = head [fileContent fi | (_, fi) <- fs]
   resp <- liftIO $ findItems net fc
   json resp
-
diff --git a/src/IRE/Application/YOLO.hs b/src/IRE/Application/YOLO.hs
index 1d6ab37..6edace3 100644
--- a/src/IRE/Application/YOLO.hs
+++ b/src/IRE/Application/YOLO.hs
@@ -1,16 +1,14 @@
-module IRE.Application.YOLO (
-  findItems
-) where
+module IRE.Application.YOLO
+  ( findItems
+  ) where
 
 import qualified Data.ByteString.Lazy as LBS
 
-import IRE.YOLO (Detector, Item, detect)
 import qualified IRE.Logging as Log
-
+import IRE.YOLO (Detector, Item, detect)
 
 findItems :: Detector -> LBS.ByteString -> IO [Item]
 findItems d fc = do
   r <- detect d 0.3 0.3 (LBS.toStrict fc)
   Log.debug $ show r
   return r
-
diff --git a/src/IRE/Config.hs b/src/IRE/Config.hs
index c2b90d6..08d89a9 100644
--- a/src/IRE/Config.hs
+++ b/src/IRE/Config.hs
@@ -1,51 +1,47 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module IRE.Config (
-  ConfigFile(..)
-, YOLO(..)
-, defaultConfig
-) where
+module IRE.Config
+  ( ConfigFile(..)
+  , YOLO(..)
+  , defaultConfig
+  ) where
 
 import Control.Applicative (empty)
 import Data.Aeson (FromJSON, parseJSON)
-import Data.Yaml (Value(Object), (.:), (.:?), (.!=))
+import Data.Yaml (Value(Object), (.!=), (.:), (.:?))
 
+data ConfigFile = ConfigFile
+  { cfPort :: Int
+  , cfSocket :: Maybe FilePath
+  , cfYOLO :: YOLO
+  } deriving (Show)
 
-data ConfigFile = ConfigFile {
-  cfPort       :: Int
-, cfSocket     :: Maybe FilePath
-, cfYOLO       :: YOLO
-} deriving (Show)
-
-data YOLO = YOLO {
-  yoloCfg     :: FilePath
-, yoloWeights :: FilePath
-, yoloNames   :: FilePath
-} deriving (Show)
-
+data YOLO = YOLO
+  { yoloCfg :: FilePath
+  , yoloWeights :: FilePath
+  , yoloNames :: FilePath
+  } deriving (Show)
 
 defaultConfig :: ConfigFile
-defaultConfig = ConfigFile {
-    cfPort = 8080
+defaultConfig =
+  ConfigFile
+  { cfPort = 8080
   , cfSocket = Nothing
-  , cfYOLO = YOLO {
-      yoloCfg = "yolo.cfg"
-    , yoloWeights = "yolo.weights"
-    , yoloNames = "yolo.names"
-    }
+  , cfYOLO =
+      YOLO
+      { yoloCfg = "yolo.cfg"
+      , yoloWeights = "yolo.weights"
+      , yoloNames = "yolo.names"
+      }
   }
 
 instance FromJSON ConfigFile where
-  parseJSON (Object m) = ConfigFile <$>
-        m .:? "port"    .!= cfPort defaultConfig
-    <*> m .:? "socket"  .!= cfSocket defaultConfig
-    <*> m .:? "yolo"    .!= cfYOLO defaultConfig
+  parseJSON (Object m) =
+    ConfigFile <$> m .:? "port" .!= cfPort defaultConfig <*>
+    m .:? "socket" .!= cfSocket defaultConfig <*>
+    m .:? "yolo" .!= cfYOLO defaultConfig
   parseJSON _ = empty
 
 instance FromJSON YOLO where
-  parseJSON (Object m) = YOLO <$>
-        m .: "cfg"
-    <*> m .: "weights"
-    <*> m .: "names"
+  parseJSON (Object m) = YOLO <$> m .: "cfg" <*> m .: "weights" <*> m .: "names"
   parseJSON _ = empty
-
diff --git a/src/IRE/Logging.hs b/src/IRE/Logging.hs
index 3343f0f..006df70 100644
--- a/src/IRE/Logging.hs
+++ b/src/IRE/Logging.hs
@@ -1,12 +1,12 @@
-module IRE.Logging (
-  LogLevel(..)
-, debug
-, error
-, info
-, level
-, start
-, warn
-) where
+module IRE.Logging
+  ( LogLevel(..)
+  , debug
+  , error
+  , info
+  , level
+  , start
+  , warn
+  ) where
 
 import Prelude hiding (error)
 
@@ -15,13 +15,13 @@ import Control.Concurrent (forkIO)
 import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
 import Control.Monad (forever, when)
 import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson as JSON
 import Data.Char (toLower)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import qualified Data.Text as T
 import System.IO (hPrint, stderr)
 import System.IO.Unsafe (unsafePerformIO)
 import Text.Read (readMaybe)
-import qualified Data.Aeson as JSON
-import qualified Data.Text as T
 
 start :: LogLevel -> IO ()
 start None = return ()
@@ -34,16 +34,15 @@ start lvl = do
 info :: String -> IO ()
 info = send . Message Info
 
-warn:: String -> IO ()
+warn :: String -> IO ()
 warn = send . Message Warning
 
-error:: String -> IO ()
+error :: String -> IO ()
 error = send . Message Error
 
 debug :: String -> IO ()
 debug = send . Message Debug
 
-
 send :: Message -> IO ()
 send msg@(Message l _) = do
   lvl <- level
@@ -62,38 +61,46 @@ logLevel = unsafePerformIO (newIORef None)
 level :: IO LogLevel
 level = readIORef logLevel
 
-
-data LogLevel = None | Error | Warning | Info | Debug
+data LogLevel
+  = None
+  | Error
+  | Warning
+  | Info
+  | Debug
   deriving (Enum, Ord, Eq)
 
 instance Show LogLevel where
-  show None    = "NONE"
-  show Error   = "ERROR"
+  show None = "NONE"
+  show Error = "ERROR"
   show Warning = "WARN"
-  show Info    = "INFO"
-  show Debug   = "DEBUG"
+  show Info = "INFO"
+  show Debug = "DEBUG"
 
 instance Read LogLevel where
   readsPrec _ s
-        | l == "none"  = [ (None,    "") ]
-        | l == "error" = [ (Error,   "") ]
-        | l == "warn"  = [ (Warning, "") ]
-        | l == "info"  = [ (Info,    "") ]
-        | l == "debug" = [ (Debug,   "") ]
-        | otherwise = [ ]
-        where l = map toLower s
+    | l == "none" = [(None, "")]
+    | l == "error" = [(Error, "")]
+    | l == "warn" = [(Warning, "")]
+    | l == "info" = [(Info, "")]
+    | l == "debug" = [(Debug, "")]
+    | otherwise = []
+    where
+      l = map toLower s
 
 instance ToJSON LogLevel where
   toJSON = JSON.String . T.pack . show
 
 instance FromJSON LogLevel where
   parseJSON (JSON.String s) =
-    maybe (fail $ "unknown log level: " ++ show s) return (readMaybe . T.unpack $ s)
+    maybe
+      (fail $ "unknown log level: " ++ show s)
+      return
+      (readMaybe . T.unpack $ s)
   parseJSON _ = empty
 
-
-data Message = Message LogLevel String
+data Message =
+  Message LogLevel
+          String
 
 instance Show Message where
   show (Message lvl str) = show lvl ++ ": " ++ str
-
diff --git a/src/IRE/Server.hs b/src/IRE/Server.hs
index 8dabc73..3a095a5 100644
--- a/src/IRE/Server.hs
+++ b/src/IRE/Server.hs
@@ -1,24 +1,28 @@
-module IRE.Server (
-  server
-) where
+module IRE.Server
+  ( server
+  ) where
 
-import Control.Exception.Base (throwIO, catch, bracket)
-import Data.Yaml.Include (decodeFileEither)
+import Control.Exception.Base (bracket, catch, throwIO)
 import Data.Bits ((.|.))
-import Network.Socket (socket, setSocketOption, bind, listen, close,
-  maxListenQueue, getSocketName, inet_addr, Family(AF_UNIX, AF_INET),
-  SocketType(Stream), SocketOption(ReuseAddr), Socket, SockAddr(..))
-import Network.Wai.Handler.Warp (Port, defaultSettings, runSettingsSocket)
+import Data.Yaml.Include (decodeFileEither)
+import Network.Socket
+       (Family(AF_INET, AF_UNIX), SockAddr(..), Socket,
+        SocketOption(ReuseAddr), SocketType(Stream), bind, close,
+        getSocketName, inet_addr, listen, maxListenQueue, setSocketOption,
+        socket)
+import Network.Wai.Handler.Warp
+       (Port, defaultSettings, runSettingsSocket)
 import System.Exit (exitFailure)
 import System.IO (hPutStrLn, stderr)
 import System.IO.Error (isDoesNotExistError)
-import System.Posix.Files ( fileExist, groupReadMode, groupWriteMode,
-  ownerReadMode, ownerWriteMode, removeLink, setFileMode, socketMode )
+import System.Posix.Files
+       (fileExist, groupReadMode, groupWriteMode, ownerReadMode,
+        ownerWriteMode, removeLink, setFileMode, socketMode)
 
 import IRE.Application (app)
 import IRE.Config (ConfigFile(..), defaultConfig)
-import IRE.YOLO (newDetector)
 import qualified IRE.Logging as Log
+import IRE.YOLO (newDetector)
 
 type Listen = Either Port FilePath
 
@@ -29,37 +33,36 @@ server rootDir configFile = do
   Log.start Log.Debug
   let socketSpec =
         case cfSocket cf of
-          Just p  -> Right p
+          Just p -> Right p
           Nothing -> Left $ cfPort cf
   bracket
     (createSocket socketSpec)
     closeSocket
-    ( \sock -> do
-      listen sock maxListenQueue
-      runSettingsSocket defaultSettings sock =<< app rootDir net)
-
+    (\sock -> do
+       listen sock maxListenQueue
+       runSettingsSocket defaultSettings sock =<< app rootDir net)
 
 readConfigFile :: FilePath -> IO ConfigFile
 readConfigFile f = do
   e <- fileExist f
-  if e then do
-    r <- decodeFileEither f
-    case r of
-      Left ex -> do
-        hPutStrLn stderr $ "FATAL: " ++ f ++ ": " ++ show ex
-        exitFailure
-      Right cf -> return cf
-  else return defaultConfig
-
+  if e
+    then do
+      r <- decodeFileEither f
+      case r of
+        Left ex -> do
+          hPutStrLn stderr $ "FATAL: " ++ f ++ ": " ++ show ex
+          exitFailure
+        Right cf -> return cf
+    else return defaultConfig
 
 createSocket :: Listen -> IO Socket
 createSocket (Right path) = do
   removeIfExists path
   sock <- socket AF_UNIX Stream 0
   bind sock $ SockAddrUnix path
-  setFileMode path $ socketMode
-                  .|. ownerWriteMode .|. ownerReadMode
-                  .|. groupWriteMode .|. groupReadMode
+  setFileMode path $
+    socketMode .|. ownerWriteMode .|. ownerReadMode .|. groupWriteMode .|.
+    groupReadMode
   Log.info $ "Listening on UNIX socket `" ++ path ++ "'"
   return sock
 createSocket (Left port) = do
@@ -70,7 +73,6 @@ createSocket (Left port) = do
   Log.info $ "Listening on localhost:" ++ show port
   return sock
 
-
 closeSocket :: Socket -> IO ()
 closeSocket sock = do
   name <- getSocketName sock
@@ -79,10 +81,9 @@ closeSocket sock = do
     SockAddrUnix path -> removeIfExists path
     _ -> return ()
 
-
 removeIfExists :: FilePath -> IO ()
 removeIfExists fileName = removeLink fileName `catch` handleExists
-  where handleExists e
-          | isDoesNotExistError e = return ()
-          | otherwise = throwIO e
-
+  where
+    handleExists e
+      | isDoesNotExistError e = return ()
+      | otherwise = throwIO e
diff --git a/src/Main.hs b/src/Main.hs
index 5070d8d..6527584 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,14 +1,15 @@
 {-# LANGUAGE QuasiQuotes #-}
-module Main (
-  main
-) where
+
+module Main
+  ( main
+  ) where
 
 import Data.Maybe (fromJust)
 import Data.Version (showVersion)
 import Paths_ire (getDataDir, version) -- from cabal
+import qualified System.Console.Docopt.NoTH as O
 import System.Environment (getArgs)
 import Text.InterpolatedString.Perl6 (qc)
-import qualified System.Console.Docopt.NoTH as O
 
 import IRE.Server (server)
 
@@ -16,8 +17,10 @@ usage :: IO String
 usage = do
   dataDir <- getDataDir
   return $
-    "IRE " ++ showVersion version ++
-    " - Watching you!" ++ [qc|
+    "IRE " ++
+    showVersion version ++
+    " - Watching you!" ++
+    [qc|
 
 Usage:
   ire [options]
@@ -39,9 +42,8 @@ main = do
   doco <- O.parseUsageOrExit =<< usage
   args <- O.parseArgsOrExit doco =<< getArgs
   if args `O.isPresent` O.longOption "help"
-  then putStrLn $ O.usage doco
-  else do
-    let configFile = fromJust . O.getArg args $ O.longOption "config"
-        rootDir  = fromJust . O.getArg args $ O.longOption "rootdir"
-    server rootDir configFile
-
+    then putStrLn $ O.usage doco
+    else do
+      let configFile = fromJust . O.getArg args $ O.longOption "config"
+          rootDir = fromJust . O.getArg args $ O.longOption "rootdir"
+      server rootDir configFile