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/Calendar.hs

-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
-{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
 
 {-|
 Module: Calendar
@@ -14,46 +14,53 @@ calendars and their events. It supports both Google calendars and a
 mock calendar for used for testing and debugging.
 -}
 module Calendar
-  ( CalendarScope
-  , CalendarCredentials
-  , CalendarContext
-  , CalendarId
-  , SimpleEvent(..)
-  , SimpleEventUTC
-  , SimpleEventLocal
-  , Attendee(..)
-  , initialize
-  , applyTz
-  , groupByDay
-  , listAvailMinusBusy
-  , partitionSlots
-  , summaryMatches
-  , isWithin
-  , addEvent
-  ) where
-
-import           ClassyPrelude.Yesod
-import           Control.Lens                           ((.~), (<&>), (^.))
-import           Control.Monad.Logger                   (Loc, LogSource, LogStr,
-                                                         defaultLoc)
-import qualified Data.Aeson                             as Js
-import           Data.ByteString.Builder                (toLazyByteString)
-import           Data.Function                          ((&))
-import qualified Data.Map                               as Map
-import qualified Data.SortedList                        as SL
-import           Data.Time.Clock                        (DiffTime,
-                                                         NominalDiffTime,
-                                                         addUTCTime)
-import           Data.Time.LocalTime                    (LocalTime (..))
-import           Data.Time.Zones                        (TZ, utcToLocalTimeTZ)
-import qualified Network.Google                         as Google
-import           Network.Google.AppsCalendar
-import qualified Network.Google.Auth                    as Google
+  ( CalendarScope,
+    CalendarCredentials,
+    CalendarContext,
+    CalendarId,
+    SimpleEvent (..),
+    SimpleEventUTC,
+    SimpleEventLocal,
+    Attendee (..),
+    initialize,
+    applyTz,
+    groupByDay,
+    listAvailMinusBusy,
+    partitionSlots,
+    summaryMatches,
+    isWithin,
+    addEvent
+    )
+where
+
+import ClassyPrelude.Yesod
+import Control.Lens ((.~), (<&>), (^.))
+import Control.Monad.Logger
+  ( Loc,
+    LogSource,
+    LogStr,
+    defaultLoc
+    )
+import qualified Data.Aeson as Js
+import Data.ByteString.Builder (toLazyByteString)
+import Data.Function ((&))
+import qualified Data.Map as Map
+import qualified Data.SortedList as SL
+import Data.Time.Clock
+  ( DiffTime,
+    NominalDiffTime,
+    addUTCTime
+    )
+import Data.Time.LocalTime (LocalTime (..))
+import Data.Time.Zones (TZ, utcToLocalTimeTZ)
+import qualified Network.Google as Google
+import Network.Google.AppsCalendar
+import qualified Network.Google.Auth as Google
 import qualified Network.Google.Auth.ApplicationDefault as Google
-import           System.Log.FastLogger                  (toLogStr)
+import System.Log.FastLogger (toLogStr)
 
 -- | Google authorization scope representing calendar operations.
-type CalendarScope = '[ "https://www.googleapis.com/auth/calendar"]
+type CalendarScope = '["https://www.googleapis.com/auth/calendar"]
 
 -- | Credentials needed for accessing the calendar.
 data CalendarCredentials
@@ -63,20 +70,24 @@ data CalendarCredentials
 -- | Doesn't reveal the credentials, but simply allows to distinguish
 -- whether they are for Google or mocked.
 instance Show CalendarCredentials where
-  show MockCreds       = "<mock>"
+
+  show MockCreds = "<mock>"
   show (GoogleCreds _) = "<google>"
 
 -- | If the field @client_id@ is just the string @"mock"@, then we use
 -- a mock calender. Otherwise, we attempt to use @client_id@,
 -- @client_secret@, and @refresh_token@ as Google credentials.
 instance FromJSON CalendarCredentials where
+
   parseJSON =
     Js.withObject "CalendarCredentials" $ \o ->
       o .: "client_id" >>= \c ->
         if c == asText "mock"
           then return MockCreds
-          else either fail (return . GoogleCreds) $
-               Google.fromJSONCredentials $ Js.encode o
+          else
+            either fail (return . GoogleCreds)
+              $ Google.fromJSONCredentials
+              $ Js.encode o
 
 -- | This represents a ready-to-use environment for calendar
 -- operations.
@@ -94,8 +105,8 @@ mockFreeId = "mock-free"
 -- calendar operations. The Google environment requires a logging
 -- function and an HTTP manager. If using a mock calendar, a warning is
 -- printed using the logging function.
-initialize ::
-     (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
+initialize
+  :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
   -> Manager
   -> CalendarCredentials
   -> IO CalendarContext
@@ -103,69 +114,74 @@ initialize appLog _ MockCreds = do
   appLog defaultLoc "" LevelWarn "Using mock calendar"
   day <- succ . utctDay <$> getCurrentTime
   let free =
-        SL.toSortedList $
-        map
-          (sampleEvent day)
-          [ ("free1a", fwd 0, 1100, 1155)
-          , ("free1b #office", fwd 0, 1300, 1450)
-          , ("free1c #office", fwd 0, 1530, 1800)
-          , ("free2a #home", fwd 1, 1200, 1600)
-          , ("free2b #office", fwd 1, 1700, 1800)
-          , ("free3a #office", fwd 2, 1000, 1200)
-          , ("free3b #home", fwd 2, 1500, 1930)
-          ]
+        SL.toSortedList
+          $ map
+              (sampleEvent day)
+              [ ("free1a", fwd 0, 1100, 1155),
+                ("free1b #office", fwd 0, 1300, 1450),
+                ("free1c #office", fwd 0, 1530, 1800),
+                ("free2a #home", fwd 1, 1200, 1600),
+                ("free2b #office", fwd 1, 1700, 1800),
+                ("free3a #office", fwd 2, 1000, 1200),
+                ("free3b #home", fwd 2, 1500, 1930)
+                ]
       busy =
-        SL.toSortedList $
-        map
-          (sampleEvent day)
-          [ ("busy1a", fwd 0, 1210, 1300)
-          , ("busy1b", fwd 0, 1330, 1430)
-          , ("busy1c", fwd 0, 1500, 1550)
-          , ("busy1d", fwd 0, 1730, 1830)
-          , ("busy2a", fwd 1, 1130, 1215)
-          , ("busy2b", fwd 1, 1330, 1400)
-          , ("busy2c", fwd 1, 1430, 1500)
-          , ("busy2d", fwd 1, 1610, 1650)
-          , ("busy3a", fwd 2, 1100, 1400)
-          , ("busy3b", fwd 2, 1900, 2100)
-          ]
+        SL.toSortedList
+          $ map
+              (sampleEvent day)
+              [ ("busy1a", fwd 0, 1210, 1300),
+                ("busy1b", fwd 0, 1330, 1430),
+                ("busy1c", fwd 0, 1500, 1550),
+                ("busy1d", fwd 0, 1730, 1830),
+                ("busy2a", fwd 1, 1130, 1215),
+                ("busy2b", fwd 1, 1330, 1400),
+                ("busy2c", fwd 1, 1430, 1500),
+                ("busy2d", fwd 1, 1610, 1650),
+                ("busy3a", fwd 2, 1100, 1400),
+                ("busy3b", fwd 2, 1900, 2100)
+                ]
   MockCxt <$> newMVar (Map.fromList [(mockFreeId, free), (mockBusyId, busy)])
 initialize appLog manager (GoogleCreds creds) =
-  GoogleCxt <$>
-  (Google.newEnvWith creds gooLog manager <&> Google.envScopes .~ calendarScope)
+  GoogleCxt
+    <$> (Google.newEnvWith creds gooLog manager <&> Google.envScopes .~ calendarScope)
   where
     gooLog level builder =
       appLog defaultLoc "" lv (toLogStr (toLazyByteString builder))
       where
         lv =
           case level of
-            Google.Info  -> LevelInfo
+            Google.Info -> LevelInfo
             Google.Error -> LevelError
             Google.Debug -> LevelDebug
             Google.Trace -> LevelOther "trace"
 
 -- | A record containing just the essential event data, abstracted over
 -- the type of the time-stamp.
-data SimpleEvent t = SimpleEvent
-  { seSummary   :: Text
-  , seStart     :: t
-  , seEnd       :: t
-  , seDescr     :: Text
-  , seLocation  :: Text
-  , seAttendees :: [Attendee]
-  } deriving (Eq, Show)
+data SimpleEvent t
+  = SimpleEvent
+      { seSummary :: Text,
+        seStart :: t,
+        seEnd :: t,
+        seDescr :: Text,
+        seLocation :: Text,
+        seAttendees :: [Attendee]
+        }
+  deriving (Eq, Show)
 
 instance Ord t => Ord (SimpleEvent t) where
+
   compare x y = compare (seStart x) (seStart y)
 
 type SimpleEventUTC = SimpleEvent UTCTime
 
 type SimpleEventLocal = SimpleEvent LocalTime
 
-data Attendee = Attendee
-  { atName  :: Text
-  , atEmail :: Text
-  } deriving (Show, Eq)
+data Attendee
+  = Attendee
+      { atName :: Text,
+        atEmail :: Text
+        }
+  deriving (Show, Eq)
 
 -- | Extract essential event data from a Google @Event@ object.
 simplifyEvent :: Event -> Maybe SimpleEventUTC
@@ -180,22 +196,29 @@ simplifyEvent e = do
 
 expandEvent :: SimpleEventUTC -> Event