ormolu formatting

src/Application.hs

 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Application
-  ( getApplicationDev
-  , appMain
-  , develMain
-  , makeFoundation
-  , makeLogWare
+  ( getApplicationDev,
+    appMain,
+    develMain,
+    makeFoundation,
+    makeLogWare,
     -- * for DevelMain
-  , getApplicationRepl
-  , shutdownApp
+    getApplicationRepl,
+    shutdownApp,
     -- * for GHCI
-  , handler
-  ) where
+    handler
+    )
+where
 
-import qualified Calendar                             as Cal
-import           Control.Monad.Logger                 (liftLoc, logInfoN)
-import qualified FreshCache                           as FC
-import           Handlers
-import           Import
-import           Language.Haskell.TH.Syntax           (qLocation)
-import           Network.HTTP.Client.TLS              (getGlobalManager)
-import           Network.Wai                          (Middleware)
-import           Network.Wai.Handler.Warp             (Settings,
-                                                       defaultSettings,
-                                                       defaultShouldDisplayException,
-                                                       getPort, runSettings,
-                                                       setHost, setOnException,
-                                                       setPort)
-import           Network.Wai.Middleware.RequestLogger (Destination (Logger),
-                                                       IPAddrSource (..),
-                                                       OutputFormat (..),
-                                                       destination,
-                                                       mkRequestLogger,
-                                                       outputFormat)
-import           System.Log.FastLogger                (defaultBufSize,
-                                                       newStdoutLoggerSet,
-                                                       toLogStr)
+import qualified Calendar as Cal
+import Control.Monad.Logger (liftLoc, logInfoN)
+import qualified FreshCache as FC
+import Handlers
+import Import
+import Language.Haskell.TH.Syntax (qLocation)
+import Network.HTTP.Client.TLS (getGlobalManager)
+import Network.Wai (Middleware)
+import Network.Wai.Handler.Warp
+  ( Settings,
+    defaultSettings,
+    defaultShouldDisplayException,
+    getPort,
+    runSettings,
+    setHost,
+    setOnException,
+    setPort
+    )
+import Network.Wai.Middleware.RequestLogger
+  ( Destination (Logger),
+    IPAddrSource (..),
+    OutputFormat (..),
+    destination,
+    mkRequestLogger,
+    outputFormat
+    )
+import System.Log.FastLogger
+  ( defaultBufSize,
+    newStdoutLoggerSet,
+    toLogStr
+    )
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
@@ -57,24 +66,26 @@ makeFoundation appSettings@AppSettings {..} = do
   appHttpManager <- getGlobalManager
   appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
   appStatic <-
-    (if appMutableStatic
-       then staticDevel
-       else static)
+    ( if appMutableStatic
+        then staticDevel
+        else static
+      )
       appStaticDir
   let partialApp = App {..}
         where
           appCalendarCxt = error "partialApp loop: Accessing appCalendarCxt"
           appCalendarCache = error "partialApp loop: Accessing appCalendarCache"
       logFunc loc src lv =
-        whenM (shouldLogIO partialApp "" lv) .
-        messageLoggerSource partialApp appLogger loc src lv
+        whenM (shouldLogIO partialApp "" lv)
+          . messageLoggerSource partialApp appLogger loc src lv
   appCalendarCxt <- Cal.initialize logFunc appHttpManager appCredentials
   appCalendarCache <-
-    unsafeHandler partialApp $
-    FC.newCache appCacheExpiry $ do
-      logInfoN "Refreshing calendar cache"
-      Cal.listAvailMinusBusy appCalendarCxt appFreeCalendarId appBusyCalendarId $
-        fromWeeks appLookaheadWeeks
+    unsafeHandler partialApp
+      $ FC.newCache appCacheExpiry
+      $ do
+        logInfoN "Refreshing calendar cache"
+        Cal.listAvailMinusBusy appCalendarCxt appFreeCalendarId appBusyCalendarId
+          $ fromWeeks appLookaheadWeeks
   return App {..}
 
 -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
@@ -82,7 +93,7 @@ makeFoundation appSettings@AppSettings {..} = do
 makeApplication :: App -> IO Application
 makeApplication foundation = do
   logWare <- makeLogWare foundation
-    -- Create the WAI application and apply middlewares
+  -- Create the WAI application and apply middlewares
   appPlain <- toWaiAppPlain foundation
   return $ logWare $ defaultMiddlewaresNoLogging appPlain
 
@@ -93,29 +104,32 @@ makeLogWare foundation =
       { outputFormat =
           if appDetailedRequestLogging $ appSettings foundation
             then Detailed True
-            else Apache
-                   (if appIpFromHeader $ appSettings foundation
-                      then FromFallback
-                      else FromSocket)
-      , destination = Logger $ loggerSet $ appLogger foundation
-      }
+            else
+              Apache
+                ( if appIpFromHeader $ appSettings foundation
+                    then FromFallback
+                    else FromSocket
+                  ),
+        destination = Logger $ loggerSet $ appLogger foundation
+        }
 
 -- | Warp settings for the given foundation value.
 warpSettings :: App -> Settings
 warpSettings foundation =
-  setPort (appPort $ appSettings foundation) $
-  setHost (appHost $ appSettings foundation) $
-  setOnException
-    (\_req e ->
-       when (defaultShouldDisplayException e) $
-       messageLoggerSource
-         foundation
-         (appLogger foundation)
-         $(qLocation >>= liftLoc)
-         "yesod"
-         LevelError
-         (toLogStr $ "Exception from Warp: " ++ show e))
-    defaultSettings
+  setPort (appPort $ appSettings foundation)
+    $ setHost (appHost $ appSettings foundation)
+    $ setOnException
+        ( \_req e ->
+            when (defaultShouldDisplayException e)
+              $ messageLoggerSource
+                  foundation
+                  (appLogger foundation)
+                  $(qLocation >>= liftLoc)
+                  "yesod"
+                  LevelError
+                  (toLogStr $ "Exception from Warp: " ++ show e)
+          )
+        defaultSettings
 
 -- | For yesod devel, return the Warp settings and WAI Application.
 getApplicationDev :: IO (Settings, Application)
@@ -135,21 +149,21 @@ develMain = develMainHelper getApplicationDev
 
 -- | The @main@ function for an executable running this site.
 appMain :: IO ()
-appMain
-    -- Get the settings from all relevant sources
- = do
-  settings <-
-    loadYamlSettingsArgs
+appMain =
+  -- Get the settings from all relevant sources
+  do
+    settings <-
+      loadYamlSettingsArgs
         -- fall back to compile-time values, set to [] to require values at runtime
-      [configSettingsYmlValue]
+        [configSettingsYmlValue]
         -- allow environment variables to override
-      useEnv
+        useEnv
     -- Generate the foundation from the settings
-  foundation <- makeFoundation settings
+    foundation <- makeFoundation settings
     -- Generate a WAI Application from the foundation
-  app <- makeApplication foundation
+    app <- makeApplication foundation
     -- Run the application with Warp
-  runSettings (warpSettings foundation) app
+    runSettings (warpSettings foundation) app
 
 --------------------------------------------------------------
 -- Functions for DevelMain.hs (a way to run the app from GHCi)

src/BookingForm.hs

-{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
 
 {-|
 Module: BookingForm
@@ -11,35 +11,38 @@ Description: TODO
 TODO
 -}
 module BookingForm
-  ( Booking(..)
-  , bookingMForm
-  , eventFromBooking
-  , toSession
-  , fromSessionMaybe
-  , fromSession
-  , b3Class
-  , inputSize
-  , labelSize
-  ) where
-
-import           Calendar
-import           Control.Monad.Trans.Maybe
-import           Data.Aeson                ((.!=), (.:?))
-import qualified Data.Aeson                as Js
-import           Data.Function             ((&))
-import           Data.Time.Clock           (addUTCTime)
-import           Data.Time.Zones
-import           Import
-import qualified Network.HTTP.Simple       as H
-import qualified QueryForm                 as QF
-import qualified Yesod.Form.Bootstrap3     as B3
-
-data Booking = Booking
-  { bookName    :: Text
-  , bookEmail   :: Text
-  , bookSubject :: Text
-  , bookContact :: Maybe Text
-  } deriving (Show)
+  ( Booking (..),
+    bookingMForm,
+    eventFromBooking,
+    toSession,
+    fromSessionMaybe,
+    fromSession,
+    b3Class,
+    inputSize,
+    labelSize
+    )
+where
+
+import Calendar
+import Control.Monad.Trans.Maybe
+import Data.Aeson ((.!=), (.:?))
+import qualified Data.Aeson as Js
+import Data.Function ((&))
+import Data.Time.Clock (addUTCTime)
+import Data.Time.Zones
+import Import
+import qualified Network.HTTP.Simple as H
+import qualified QueryForm as QF
+import qualified Yesod.Form.Bootstrap3 as B3
+
+data Booking
+  = Booking
+      { bookName :: Text,
+        bookEmail :: Text,
+        bookSubject :: Text,
+        bookContact :: Maybe Text
+        }
+  deriving (Show)
 
 toSession :: MonadHandler m => Booking -> m ()
 toSession Booking {..} = do
@@ -77,12 +80,12 @@ submit = do
 
 bookingAForm :: Maybe Booking -> AForm Handler Booking
 bookingAForm bOpt =
-  Booking <$> areq textField name (bookName <$> bOpt) <*>
-  areq emailField email (bookEmail <$> bOpt) <*>
-  areq textField subject (bookSubject <$> bOpt) <*>
-  aopt textField contact (bookContact <$> bOpt) <*
-  formToAForm recaptcha <*
-  formToAForm submit
+  Booking <$> areq textField name (bookName <$> bOpt)
+    <*> areq emailField email (bookEmail <$> bOpt)
+    <*> areq textField subject (bookSubject <$> bOpt)
+    <*> aopt textField contact (bookContact <$> bOpt)
+    <* formToAForm recaptcha
+    <* formToAForm submit
   where
     name = bfs "*Name" "Who are you?"
     email = bfs "*Email" "You must use a valid email address"
@@ -90,12 +93,15 @@ bookingAForm bOpt =
       bfs "*Subject" "What course are you in? What do you want to talk about?"
     contact = bfs "Contact" "For online meetings, how do I reach you?"
 
-data RecaptchaResponse = RecaptchaResponse
-  { rrSuccess :: Bool
-  , rrErrors  :: [Text]
-  } deriving (Show)
+data RecaptchaResponse
+  = RecaptchaResponse
+      { rrSuccess :: Bool,
+        rrErrors :: [Text]
+        }
+  deriving (Show)
 
 instance Js.FromJSON RecaptchaResponse where
+
   parseJSON =
     Js.withObject "RecaptchaResponse" $ \o -> do
       rrSuccess <- o .: "success"
@@ -115,11 +121,11 @@ recaptcha =
             H.parseRequest
               "POST https://www.google.com/recaptcha/api/siteverify"
           let req =
-                req' & H.setRequestManager mgr &
-                H.setRequestBodyURLEncoded
-                  [ ("secret", encodeUtf8 secret)
-                  , ("response", encodeUtf8 response)
-                  ]
+                req' & H.setRequestManager mgr
+                  & H.setRequestBodyURLEncoded
+                      [ ("secret", encodeUtf8 secret),
+                        ("response", encodeUtf8 response)
+                        ]
           resp <- H.getResponseBody <$> H.httpJSON req
           if rrSuccess resp
             then return (FormSuccess (), [])
@@ -164,8 +170,8 @@ b3Class g =
     B3.ColMd n -> "col-md-" <> tshow n
     B3.ColLg n -> "col-lg-" <> tshow n
 
-bookingMForm ::
-     Maybe Booking -> Html -> MForm Handler (FormResult Booking, Widget)
+bookingMForm
+  :: Maybe Booking -> Html -> MForm Handler (FormResult Booking, Widget)
 bookingMForm = B3.renderBootstrap3 horiz . bookingAForm
   where
     horiz =

src/FreshCache.hs

-{-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 {-|
@@ -13,32 +13,35 @@ existing one is used. If it is requested after the time is expired, we
 automatically refresh it. Should be thread-safe.
 -}
 module FreshCache
-  ( Cache
-  , newCache
-  , readCache
-  , invalidateCache
-  , cacheDemo
-  ) where
+  ( Cache,
+    newCache,
+    readCache,
+    invalidateCache,
+    cacheDemo
+    )
+where
 
-import           ClassyPrelude.Yesod
-import           Control.Concurrent  (threadDelay)
-import           Data.Time.Clock     (NominalDiffTime, diffUTCTime)
+import ClassyPrelude.Yesod
+import Control.Concurrent (threadDelay)
+import Data.Time.Clock (NominalDiffTime, diffUTCTime)
 
-data CacheData a = CacheData
-  { value       :: a
-  , retrievedAt :: UTCTime
-  }
+data CacheData a
+  = CacheData
+      { value :: a,
+        retrievedAt :: UTCTime
+        }
 
-data CacheMeta m a = CacheMeta
-  { content :: Maybe (CacheData a)
-  , maxAge  :: NominalDiffTime
-  , refresh :: m a
-  }
+data CacheMeta m a
+  = CacheMeta
+      { content :: Maybe (CacheData a),
+        maxAge :: NominalDiffTime,
+        refresh :: m a
+        }
 
 -- | The cache structure. Saves the value 'a' which can be refreshed or
 -- accessed within the monad 'm'.
-newtype Cache m a =
-  Cache (MVar (CacheMeta m a))
+newtype Cache m a
+  = Cache (MVar (CacheMeta m a))
 
 -- | Create a new cache by running the action and saving it with a
 -- timestamp.

src/Handlers.hs

-{-# LANGUAGE NamedFieldPuns    #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE RecordWildCards   #-}
-{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 {-|
 Module: Handlers
@@ -12,53 +12,54 @@ Description: TODO
 TODO
 -}
 module Handlers
-  ( getFaviconR
-  , getRobotsR
-  , getHomeR
-  , getAvailR
-  , postHomeR
-  , getBookR
-  , postBookR
-  , getFinalR
-  , getClearR
-  , getVersionR
-  ) where
+  ( getFaviconR,
+    getRobotsR,
+    getHomeR,
+    getAvailR,
+    postHomeR,
+    getBookR,
+    postBookR,
+    getFinalR,
+    getClearR,
+    getVersionR
+    )
+where
 
-import           BookingForm               (b3Class, inputSize, labelSize)
-import qualified BookingForm               as BF
-import           Calendar
-import           Control.Monad.Trans.Maybe
-import           Data.FileEmbed            (embedFile)
-import qualified Data.SortedList           as SL
-import           Data.Time.Clock           (addUTCTime, getCurrentTime)
-import           Data.Time.Zones           (localTimeToUTCTZ, utcToLocalTimeTZ)
-import qualified FreshCache                as FC
-import           Import
-import qualified QueryForm                 as QF
-import           Text.Hamlet               (shamletFile)
-import           Text.Julius               (RawJS (..))
+import BookingForm (b3Class, inputSize, labelSize)
+import qualified BookingForm as BF
+import Calendar
+import Control.Monad.Trans.Maybe
+import Data.FileEmbed (embedFile)
+import qualified Data.SortedList as SL
+import Data.Time.Clock (addUTCTime, getCurrentTime)
+import Data.Time.Zones (localTimeToUTCTZ, utcToLocalTimeTZ)
+import qualified FreshCache as FC
+import Import
+import qualified QueryForm as QF
+import Text.Hamlet (shamletFile)
+import Text.Julius (RawJS (..))
 
 -- | Home page, which shows query settings. Also has an AJAX facility
 -- to get the available slots and show them as buttons.
 getHomeR :: Handler Html
-getHomeR
+getHomeR =
   -- Start refresh of calendar, but don't wait for result.
- = do
-  App {appCalendarCache} <- getYesod
-  void $ async $ FC.readCache appCalendarCache
-  -- Produce form for query and display parameters: appointment length,
-  -- 12/24-hour time, time zone, location.
-  qOpt <- runMaybeT QF.fromSession
-  bOpt <- runMaybeT BF.fromSessionMaybe
-  (idReset, idSpinner, idAvail, idAlert) <- newIdent4
-  (queryWidget, enctype) <- generateFormPost $ QF.queryForm idReset qOpt
-  defaultLayout $(widgetFile "homepage")
+  do
+    App {appCalendarCache} <- getYesod
+    void $ async $ FC.readCache appCalendarCache
+    -- Produce form for query and display parameters: appointment length,
+    -- 12/24-hour time, time zone, location.
+    qOpt <- runMaybeT QF.fromSession
+    bOpt <- runMaybeT BF.fromSessionMaybe
+    (idReset, idSpinner, idAvail, idAlert) <- newIdent4
+    (queryWidget, enctype) <- generateFormPost $ QF.queryForm idReset qOpt
+    defaultLayout $(widgetFile "homepage")
 
 -- | Ensure a successful form submission, or else throw a 400.
 formSuccess :: MonadHandler m => ((FormResult a, b), c) -> m a
 formSuccess ((formResult, _), _) =
   case formResult of
-    FormMissing        -> invalidArgs ["Missing form data!"]
+    FormMissing -> invalidArgs ["Missing form data!"]
     FormFailure errors -> invalidArgs errors
     FormSuccess result -> return result
 
@@ -70,12 +71,12 @@ getAvailR = do
   App {appSettings = AppSettings {..}, appCalendarCache} <- getYesod
   earliest <- addUTCTime appLeadTime <$> liftIO getCurrentTime
   daysWithSlots <-
-    groupByDay .
-    SL.map (applyTz (tzByLabel queryTzLabel)) .
-    SL.dropWhile ((< earliest) . seStart) .
-    partitionSlots (headMay appApptLengthsMinutes) queryApptLength .
-    SL.filter (summaryMatches (locSearch queryLocation)) <$>
-    FC.readCache appCalendarCache
+    groupByDay
+      . SL.map (applyTz (tzByLabel queryTzLabel))
+      . SL.dropWhile ((< earliest) . seStart)
+      . partitionSlots (headMay appApptLengthsMinutes) queryApptLength
+      . SL.filter (summaryMatches (locSearch queryLocation))
+      <$> FC.readCache appCalendarCache
   return $(shamletFile "templates/avail.hamlet")
 
 postHomeR :: Handler Html
@@ -100,9 +101,10 @@ showWhenWhere = do
   let inOtherZone =
         if queryTzLabel == appDefaultTimeZone
           then Nothing
-          else Just $
-               utcToLocalTimeTZ (tzByLabel appDefaultTimeZone) $
-               localTimeToUTCTZ (tzByLabel queryTzLabel) slotLocal
+          else
+            Just
+              $ utcToLocalTimeTZ (tzByLabel appDefaultTimeZone)
+              $ localTimeToUTCTZ (tzByLabel queryTzLabel) slotLocal
   return (q, s, $(widgetFile "when-where"))
 
 postBookR :: Handler Html
@@ -138,8 +140,9 @@ getClearR = clearSession >> redirect HomeR
 getFaviconR :: Handler TypedContent
 getFaviconR = do
   cacheSeconds $ 60 * 60 * 24 * 30 -- cache for a month
-  return $
-    TypedContent "image/x-icon" $ toContent $(embedFile "config/favicon.ico")
+  return
+    $ TypedContent "image/x-icon"
+    $ toContent $(embedFile "config/favicon.ico")
 
 getRobotsR :: Handler TypedContent
 getRobotsR =

src/Import.hs

 module Import
   ( module Import
-  ) where
+    )
+where
 
-import           Foundation          as Import
-import           Import.NoFoundation as Import
+import Foundation as Import
+import Import.NoFoundation as Import
 
 newIdent2 :: MonadHandler m => m (Text, Text)
 newIdent2 = (,) <$> newIdent <*> newIdent

src/Import/NoFoundation.hs

 {-# LANGUAGE OverloadedStrings #-}
 
 module Import.NoFoundation
-  ( module Import
-  , pluralN
-  , fromWeeks
-  , fromMinutes
-  ) where
+  ( module Import,
+    pluralN,
+    fromWeeks,
+    fromMinutes
+    )
+where
 
-import           Calendar              as Import (CalendarContext,
-                                                  SimpleEventUTC)
-import           ClassyPrelude.Yesod   as Import
-import           Data.Time.Clock       (NominalDiffTime)
-import           Settings              as Import
-import           Settings.StaticFiles  as Import
-import           Yesod.Core.Types      as Import (loggerSet)
-import           Yesod.Default.Config2 as Import
+import Calendar as Import
+  ( CalendarContext,
+    SimpleEventUTC
+    )
+import ClassyPrelude.Yesod as Import
+import Data.Time.Clock (NominalDiffTime)
+import Settings as Import
+import Settings.StaticFiles as Import
+import Yesod.Core.Types as Import (loggerSet)
+import Yesod.Default.Config2 as Import
 
 pluralN :: Int -> Text -> Text -> Text
 pluralN 1 x _ = "1 " <> x

src/QueryForm.hs

-{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase                 #-}
-{-# LANGUAGE NamedFieldPuns             #-}
-{-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE QuasiQuotes                #-}
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NoImplicitPrelude #-}