Reformatting

Now I'm using ormolu instead of brittany for Haskell formatting
now. Figured I should just make all of these big changes at once.

2 files changed, 195 insertions, 166 deletions

diff --git a/Que/Server.hs b/Que/Server.hs
index 841cbfa..b0f3fbd 100644
--- a/Que/Server.hs
+++ b/Que/Server.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
 -- | Interprocess communication
 --
@@ -22,68 +22,82 @@
 -- : dep unagi-chan
 -- : dep unordered-containers
 module Que.Server
-  ( main
+  ( main,
   )
 where
 
-import           Alpha                   hiding ( Text
-                                                , get
-                                                , gets
-                                                , modify
-                                                , poll
-                                                )
-import qualified Control.Concurrent.Go         as Go
-import qualified Control.Concurrent.STM        as STM
-import qualified Control.Exception             as Exception
-import           Control.Monad.Reader           ( MonadTrans )
+import Alpha hiding
+  ( Text,
+    get,
+    gets,
+    modify,
+    poll,
+  )
+import qualified Control.Concurrent.Go as Go
+import qualified Control.Concurrent.STM as STM
+import qualified Control.Exception as Exception
+import Control.Monad.Reader (MonadTrans)
 import qualified Data.ByteString.Builder.Extra as Builder
-import qualified Data.ByteString.Lazy          as BSL
-import           Data.HashMap.Lazy              ( HashMap )
-import qualified Data.HashMap.Lazy             as HashMap
-import qualified Data.Text.Encoding            as Encoding
-import           Data.Text.Lazy                 ( Text
-                                                , fromStrict
-                                                )
-import qualified Data.Text.Lazy.IO             as Text
-import qualified Network.HTTP.Types.Status     as Http
-import qualified Network.Wai                   as Wai
-import qualified Network.Wai.Handler.Warp      as Warp
-import           Network.Wai.Middleware.RequestLogger
-                                                ( logStdout )
-import qualified System.Envy                   as Envy
-import qualified System.Exit                   as Exit
-import qualified Web.Scotty.Trans              as Scotty
+import qualified Data.ByteString.Lazy as BSL
+import Data.HashMap.Lazy (HashMap)
+import qualified Data.HashMap.Lazy as HashMap
+import qualified Data.Text.Encoding as Encoding
+import Data.Text.Lazy
+  ( Text,
+    fromStrict,
+  )
+import qualified Data.Text.Lazy.IO as Text
+import qualified Network.HTTP.Types.Status as Http
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Handler.Warp as Warp
+import Network.Wai.Middleware.RequestLogger
+  ( logStdout,
+  )
+import qualified System.Envy as Envy
+import qualified System.Exit as Exit
+import qualified Web.Scotty.Trans as Scotty
 
 main :: IO ()
 main = Exception.bracket startup shutdown <| uncurry Warp.run
- where
-  startup = Envy.decodeEnv >>= \case
-    Left  e -> Exit.die e
-    Right c -> do
-      sync <- STM.newTVarIO initialAppState
-      let runActionToIO m = runReaderT (runApp m) sync
-      waiapp <- Scotty.scottyAppT runActionToIO routes
-      putText <| "port:" <> (show <| quePort c)
-      return (quePort c, waiapp)
-  shutdown :: a -> IO a
-  shutdown = pure . identity
-
-newtype App a = App
-  { runApp :: ReaderT (STM.TVar AppState) IO a
-  }
-  deriving (Applicative, Functor, Monad, MonadIO, MonadReader
-    (STM.TVar AppState))
-
-data AppState = AppState
-  { ques :: HashMap Namespace Quebase
-  }
+  where
+    startup = Envy.decodeEnv >>= \case
+      Left e -> Exit.die e
+      Right c -> do
+        sync <- STM.newTVarIO initialAppState
+        let runActionToIO m = runReaderT (runApp m) sync
+        waiapp <- Scotty.scottyAppT runActionToIO routes
+        putText <| "port:" <> (show <| quePort c)
+        return (quePort c, waiapp)
+    shutdown :: a -> IO a
+    shutdown = pure . identity
+
+newtype App a
+  = App
+      { runApp :: ReaderT (STM.TVar AppState) IO a
+      }
+  deriving
+    ( Applicative,
+      Functor,
+      Monad,
+      MonadIO,
+      MonadReader
+        (STM.TVar AppState)
+    )
+
+data AppState
+  = AppState
+      { ques :: HashMap Namespace Quebase
+      }
 
 initialAppState :: AppState
-initialAppState = AppState { ques = mempty }
+initialAppState = AppState {ques = mempty}
 
-data Config = Config
-  { quePort :: Warp.Port -- ^ QUE_PORT
-  } deriving (Generic, Show)
+data Config
+  = Config
+      { -- | QUE_PORT
+        quePort :: Warp.Port
+      }
+  deriving (Generic, Show)
 
 instance Envy.DefConfig Config where
   defConfig = Config 3000
@@ -93,17 +107,15 @@ instance Envy.FromEnv Config
 routes :: Scotty.ScottyT Text App ()
 routes = do
   Scotty.middleware logStdout
-
-  let quepath   = "^\\/([[:alnum:]_]+)\\/([[:alnum:]._/]*)$"
+  let quepath = "^\\/([[:alnum:]_]+)\\/([[:alnum:]._/]*)$"
   let namespace = "^\\/([[:alnum:]_]+)\\/?$" -- matches '/ns' and '/ns/' but not '/ns/path'
 
-  -- | GET /index.html
+  -- GET /index.html
   Scotty.get (Scotty.literal "/index.html") <| Scotty.redirect "/_/index"
   Scotty.get (Scotty.literal "/") <| Scotty.redirect "/_/index"
-
-  -- | GET /_/dash
+  -- GET /_/dash
   Scotty.get (Scotty.literal "/_/dash") <| do
-    authkey  <- fromMaybe "" </ Scotty.header "Authorization"
+    authkey <- fromMaybe "" </ Scotty.header "Authorization"
     adminkey <- liftIO <| lchomp </ Text.readFile "/run/keys/que-admin"
     if authkey == adminkey
       then do
@@ -112,14 +124,11 @@ routes = do
       else do
         Scotty.status Http.methodNotAllowed405
         Scotty.text "not allowed"
-
-
-  -- | Namespace management
+  -- Namespace management
   Scotty.matchAny (Scotty.regex namespace) <| do
     Scotty.status Http.notImplemented501
     Scotty.text "namespace management coming soon"
-
-  -- | GET que
+  -- GET que
   --
   -- Receive a value from a que. Blocks until a value is received,
   -- then returns. If 'poll=true', then stream data from the Que to the
@@ -127,20 +136,19 @@ routes = do
   Scotty.get (Scotty.regex quepath) <| do
     (ns, qp) <- extract
     app . modify <| upsertNamespace ns
-    q    <- app <| que ns qp
+    q <- app <| que ns qp
     poll <- Scotty.param "poll" !: (pure . const False)
     guardNs ns ["pub", "_"]
     case poll of
       True -> Scotty.stream $ streamQue q
-      _    -> do
+      _ -> do
         r <- liftIO <| Go.read q
         Scotty.html <| fromStrict <| Encoding.decodeUtf8 r
-
-  -- | POST que
+  -- POST que
   --
   -- Put a value on a que. Returns immediately.
   Scotty.post (Scotty.regex quepath) <| do
-    authkey  <- fromMaybe "" </ Scotty.header "Authorization"
+    authkey <- fromMaybe "" </ Scotty.header "Authorization"
     adminkey <- liftIO <| lchomp </ Text.readFile "/run/keys/que-admin"
     (ns, qp) <- extract
     -- Only allow my IP or localhost to publish to '_' namespace
@@ -151,9 +159,9 @@ routes = do
     guardNs ns ["pub", "_"]
     -- passed all auth checks
     app . modify <| upsertNamespace ns
-    q     <- app <| que ns qp
+    q <- app <| que ns qp
     qdata <- Scotty.body
-    _     <- liftIO <| Go.write q <| BSL.toStrict qdata
+    _ <- liftIO <| Go.write q <| BSL.toStrict qdata
     return ()
 
 -- | Given `guardNs ns whitelist`, if `ns` is not in the `whitelist`
@@ -168,21 +176,23 @@ guardNs ns whitelist = when (not <| ns `elem` whitelist) <| do
   Scotty.finish
 
 -- | recover from a scotty-thrown exception.
-(!:)
-  :: Scotty.ActionT Text App a -- ^ action that might throw
-  -> (Text -> Scotty.ActionT Text App a) -- ^ a function providing a default response instead
-  -> Scotty.ActionT Text App a
+(!:) ::
+  -- | action that might throw
+  Scotty.ActionT Text App a ->
+  -- | a function providing a default response instead
+  (Text -> Scotty.ActionT Text App a) ->
+  Scotty.ActionT Text App a
 (!:) = Scotty.rescue
 
 -- | Forever write the data from 'Que' to 'Wai.StreamingBody'.
 streamQue :: Que -> Wai.StreamingBody
 streamQue q write _ = Go.mult q >>= loop
- where
-  loop c =
-    Go.tap c
-      >>= (write . Builder.byteStringInsert)
-      >>  (write <| Builder.byteStringInsert "\n")
-      >>  loop c
+  where
+    loop c =
+      Go.tap c
+        >>= (write . Builder.byteStringInsert)
+        >> (write <| Builder.byteStringInsert "\n")
+        >> loop c
 
 -- | Gets the thing from the Hashmap. Call's 'error' if key doesn't exist.
 grab :: (Eq k, Hashable k) => k -> HashMap k v -> v
@@ -190,20 +200,21 @@ grab = flip (HashMap.!)
 
 -- | Inserts the namespace in 'AppState' if it doesn't exist.
 upsertNamespace :: Namespace -> AppState -> AppState
-upsertNamespace ns as = if HashMap.member ns (ques as)
-  then as
-  else as { ques = HashMap.insert ns mempty (ques as) }
+upsertNamespace ns as =
+  if HashMap.member ns (ques as)
+    then as
+    else as {ques = HashMap.insert ns mempty (ques as)}
 
 -- | Inserts the que at the proper 'Namespace' and 'Quepath'.
 insertQue :: Namespace -> Quepath -> Que -> AppState -> AppState
-insertQue ns qp q as = as { ques = newQues }
- where
-  newQues  = HashMap.insert ns newQbase (ques as)
-  newQbase = HashMap.insert qp q <| grab ns <| ques as
+insertQue ns qp q as = as {ques = newQues}
+  where
+    newQues = HashMap.insert ns newQbase (ques as)
+    newQbase = HashMap.insert qp q <| grab ns <| ques as
 
 extract :: Scotty.ActionT Text App (Namespace, Quepath)
 extract = do
-  ns   <- Scotty.param "1"
+  ns <- Scotty.param "1"
   path <- Scotty.param "2"
   return (ns, path)
 
@@ -220,17 +231,26 @@ gets f = ask >>= liftIO . STM.readTVarIO >>= return . f
 modify :: (AppState -> AppState) -> App ()
 modify f = ask >>= liftIO . atomically . flip STM.modifyTVar' f
 
-type Namespace = Text -- ^ housing for a set of que paths
-type Que = Go.Channel Message -- ^ a que is just a channel of bytes
-type Quepath = Text -- ^ any path can serve as an identifier for a que
-type Message = ByteString -- ^ any opaque data
-type Quebase = HashMap Quepath Que -- ^ a collection of ques
+-- | housing for a set of que paths
+type Namespace = Text
+
+-- | a que is just a channel of bytes
+type Que = Go.Channel Message
+
+-- | any path can serve as an identifier for a que
+type Quepath = Text
+
+-- | any opaque data
+type Message = ByteString
+
+-- | a collection of ques
+type Quebase = HashMap Quepath Que
 
 -- | Lookup or create a que
 que :: Namespace -> Quepath -> App Que
 que ns qp = do
   _ques <- gets ques
-  let qbase     = grab ns _ques
+  let qbase = grab ns _ques
       queExists = HashMap.member qp qbase
   if queExists
     then return <| grab qp qbase
diff --git a/Que/Website.hs b/Que/Website.hs
index e75f2bd..cfb860c 100644
--- a/Que/Website.hs
+++ b/Que/Website.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE LambdaCase #-}
 
 -- | spawns a few processes that serve the que.run website
 --
@@ -13,39 +13,41 @@
 -- : dep protolude
 -- : dep req
 module Que.Website
-  ( main
+  ( main,
   )
 where
 
-import           Alpha
-import qualified Control.Concurrent.Async      as Async
-import qualified Data.ByteString.Char8         as BS
-import qualified Data.Ini.Config               as Config
-import qualified Data.Text                     as Text
-import           Data.Text.Encoding             ( encodeUtf8 )
-import qualified Data.Text.IO                  as Text
-import           Network.HTTP.Req
-import qualified System.Directory              as Directory
-import           System.Environment            as Environment
-import qualified System.Exit                   as Exit
-import           System.FilePath                ( (</>) )
-import qualified System.Process                as Process
+import Alpha
+import qualified Control.Concurrent.Async as Async
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Ini.Config as Config
+import qualified Data.Text as Text
+import Data.Text.Encoding (encodeUtf8)
+import qualified Data.Text.IO as Text
+import Network.HTTP.Req
+import qualified System.Directory as Directory
+import System.Environment as Environment
+import qualified System.Exit as Exit
+import System.FilePath ((</>))
+import qualified System.Process as Process
 
 main :: IO ()
 main = do
   (src, ns) <- Environment.getArgs >>= \case
-    [src]     -> return (src, "_") -- default to _ ns which is special
+    [src] -> return (src, "_") -- default to _ ns which is special
     [src, ns] -> return (src, Text.pack ns)
-    _         -> Exit.die "usage: que-website <srcdir> [namespace]"
+    _ -> Exit.die "usage: que-website <srcdir> [namespace]"
   mKey <- getKey ns
   putText $ "serving " <> Text.pack src <> " at " <> ns
-  run mKey ns $ Sources { index      = src </> "index.md"
-                        , client     = src </> "client.py"
-                        , quescripts = src </> "quescripts.md"
-                        , style      = src </> "style.css"
-                        , apidocs    = src </> "apidocs.md"
-                        , tutorial   = src </> "tutorial.md"
-                        }
+  run mKey ns $
+    Sources
+      { index = src </> "index.md",
+        client = src </> "client.py",
+        quescripts = src </> "quescripts.md",
+        style = src </> "style.css",
+        apidocs = src </> "apidocs.md",
+        tutorial = src </> "tutorial.md"
+      }
 
 getKey :: Namespace -> IO (Maybe Key)
 getKey ns = do
@@ -63,64 +65,71 @@ getKey ns = do
 errorParsingConf :: error
 errorParsingConf = panic "could not parse ~/.config/que.conf"
 
-data Sources = Sources
-  { index :: FilePath
-  , quescripts :: FilePath
-  , client :: FilePath
-  , style :: FilePath
-  , tutorial :: FilePath
-  , apidocs :: FilePath
-  }
+data Sources
+  = Sources
+      { index :: FilePath,
+        quescripts :: FilePath,
+        client :: FilePath,
+        style :: FilePath,
+        tutorial :: FilePath,
+        apidocs :: FilePath
+      }
 
 type Namespace = Text
+
 type Key = Text
 
 auth :: Namespace -> Config.IniParser (Maybe Key)
 auth "pub" = pure Nothing
-auth ns    = Config.sectionMb ns <| Config.field "key"
+auth ns = Config.sectionMb ns <| Config.field "key"
 
 run :: Maybe Key -> Text -> Sources -> IO ()
 run key ns Sources {..} = Async.runConcurrently actions >> return ()
- where
-  actions = traverse
-    Async.Concurrently
-    [ forever <| toHtml index >>= serve key ns "index"
-    , forever <| toHtml quescripts >>= serve key ns "quescripts"
-    , forever <| BS.readFile client >>= serve key ns "client"
-    , forever <| toHtml tutorial >>= serve key ns "tutorial"
-    , forever <| toHtml apidocs >>= serve key ns "apidocs"
-    ]
-  toHtml :: FilePath -> IO ByteString
-  toHtml md =
-    BS.pack
-      <$> Process.readProcess
-            "pandoc"
-            [ "--include-in-header"
-            , style
-            , "-i"
-            , md
-            , "--from"
-            , "markdown"
-            , "--to"
-            , "html"
-            ]
-            []
+  where
+    actions =
+      traverse
+        Async.Concurrently
+        [ forever <| toHtml index >>= serve key ns "index",
+          forever <| toHtml quescripts >>= serve key ns "quescripts",
+          forever <| BS.readFile client >>= serve key ns "client",
+          forever <| toHtml tutorial >>= serve key ns "tutorial",
+          forever <| toHtml apidocs >>= serve key ns "apidocs"
+        ]
+    toHtml :: FilePath -> IO ByteString
+    toHtml md =
+      BS.pack
+        <$> Process.readProcess
+          "pandoc"
+          [ "--include-in-header",
+            style,
+            "-i",
+            md,
+            "--from",
+            "markdown",
+            "--to",
+            "html"
+          ]
+          []
 
 serve :: Maybe Key -> Namespace -> Text -> ByteString -> IO ()
 serve Nothing "pub" path content = runReq defaultHttpConfig $ do
-  _ <- req POST
-           (http "que.run" /: "pub" /: path)
-           (ReqBodyBs content)
-           ignoreResponse
-           mempty
+  _ <-
+    req
+      POST
+      (http "que.run" /: "pub" /: path)
+      (ReqBodyBs content)
+      ignoreResponse
+      mempty
   liftIO $ return ()
-serve Nothing    p  _    _       = panic <| "no auth key provided for ns: " <> p
+serve Nothing p _ _ = panic <| "no auth key provided for ns: " <> p
 serve (Just key) ns path content = runReq defaultHttpConfig $ do
   let options =
         header "Authorization" (encodeUtf8 key) <> responseTimeout maxBound
-  _ <- req POST
-           (http "que.run" /: ns /: path)
-           (ReqBodyBs content)
-           ignoreResponse
-           options
+  _ <-
+    req
+      POST
+      (http "que.run" /: ns /: path)
+      (ReqBodyBs content)
+      ignoreResponse
+      options
   liftIO $ return ()