Reformat w/newer ormolu; leaner nix closure

app/DevelMain.hs

@@ -29,16 +29,15 @@
 -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
 module DevelMain where
 
-import           Application              (getApplicationRepl, shutdownApp)
-import           Prelude
-
-import           Control.Concurrent
-import           Control.Exception        (finally)
-import           Control.Monad            ((>=>))
-import           Data.IORef
-import           Foreign.Store
-import           GHC.Word
-import           Network.Wai.Handler.Warp
+import Application (getApplicationRepl, shutdownApp)
+import Control.Concurrent
+import Control.Exception (finally)
+import Control.Monad ((>=>))
+import Data.IORef
+import Foreign.Store
+import GHC.Word
+import Network.Wai.Handler.Warp
+import Prelude
 
 -- | Start or restart the server.
 -- newStore is from foreign-store.
@@ -46,15 +45,15 @@ import           Network.Wai.Handler.Warp
 update :: IO ()
 update = do
   mtidStore <- lookupStore tidStoreNum
-  case mtidStore
-      -- no server running
-        of
+  case mtidStore of
+    -- no server running
+
     Nothing -> do
       done <- storeAction doneStore newEmptyMVar
       tid <- start done
       _ <- storeAction (Store tidStoreNum) (newIORef tid)
       return ()
-      -- server is already running
+    -- server is already running
     Just tidStore -> restartAppInNewThread tidStore
   where
     doneStore :: Store (MVar ())
@@ -66,27 +65,28 @@ update = do
         killThread tid
         withStore doneStore takeMVar
         readStore doneStore >>= start
-    -- | Start the server in a separate thread.
     start ::
-         MVar () -- ^ Written to when the thread is killed.
-      -> IO ThreadId
+      -- | Written to when the thread is killed.
+      MVar () ->
+      IO ThreadId
     start done = do
       (port, site, app) <- getApplicationRepl
       forkIO
-        (finally
-           (runSettings (setPort port defaultSettings) app)
-                        -- Note that this implies concurrency
-                        -- between shutdownApp and the next app that is starting.
-                        -- Normally this should be fine
-           (putMVar done () >> shutdownApp site))
+        ( finally
+            (runSettings (setPort port defaultSettings) app)
+            -- Note that this implies concurrency
+            -- between shutdownApp and the next app that is starting.
+            -- Normally this should be fine
+            (putMVar done () >> shutdownApp site)
+        )
 
 -- | kill the server
 shutdown :: IO ()
 shutdown = do
   mtidStore <- lookupStore tidStoreNum
-  case mtidStore
-      -- no server running
-        of
+  case mtidStore of
+    -- no server running
+
     Nothing -> putStrLn "no Yesod app running"
     Just tidStore -> do
       withStore tidStore $ readIORef >=> killThread

app/auth.hs

-import           Prelude       (IO)
-import           Settings.Auth (authorizeMain)
+import Settings.Auth (authorizeMain)
+import Prelude (IO)
 
 main :: IO ()
 main = authorizeMain

app/devel.hs

 {-# LANGUAGE PackageImports #-}
+
 import "bookme" Application (develMain)
 import Prelude (IO)
 

app/main.hs

-import           Application (appMain)
-import           Prelude     (IO)
+import Application (appMain)
+import Prelude (IO)
 
 main :: IO ()
 main = appMain

default.nix

@@ -12,9 +12,18 @@ let
     && ! (lib.elem (baseNameOf name) ignore)
     && ! (lib.hasPrefix ".ghc.environment" (baseNameOf name))
     && ! (lib.hasPrefix "autogen-" (baseNameOf name));
+
+  hp = haskellPackages.override {
+    overrides = self: super: {
+      mkDerivation = args: super.mkDerivation (args // {
+        doHaddock = false;
+        enableLibraryProfiling = false;
+      });
+    };
+  };
 in
 haskell.lib.overrideCabal
-  (haskellPackages.callPackage ./bookme.nix { })
+  (hp.callPackage ./bookme.nix { })
   (drv: {
     doCheck = false;
     doHaddock = false;

src/Application.hs

 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Application
@@ -12,12 +12,14 @@ module Application
     develMain,
     makeFoundation,
     makeLogWare,
+
     -- * for DevelMain
     getApplicationRepl,
     shutdownApp,
+
     -- * for GHCI
-    handler
-    )
+    handler,
+  )
 where
 
 import qualified Calendar as Cal
@@ -36,21 +38,21 @@ import Network.Wai.Handler.Warp
     runSettings,
     setHost,
     setOnException,
-    setPort
-    )
+    setPort,
+  )
 import Network.Wai.Middleware.RequestLogger
   ( Destination (Logger),
     IPAddrSource (..),
     OutputFormat (..),
     destination,
     mkRequestLogger,
-    outputFormat
-    )
+    outputFormat,
+  )
 import System.Log.FastLogger
   ( defaultBufSize,
     newStdoutLoggerSet,
-    toLogStr
-    )
+    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
@@ -84,8 +86,8 @@ makeFoundation appSettings@AppSettings {..} = do
       $ FC.newCache appCacheExpiry
       $ do
         logInfoN "Refreshing calendar cache"
-        Cal.listAvailMinusBusy appCalendarCxt appFreeCalendarId appBusyCalendarId
-          $ fromWeeks appLookaheadWeeks
+        Cal.listAvailMinusBusy appCalendarCxt appFreeCalendarId appBusyCalendarId $
+          fromWeeks appLookaheadWeeks
   return App {..}
 
 -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
@@ -109,9 +111,9 @@ makeLogWare foundation =
                 ( if appIpFromHeader $ appSettings foundation
                     then FromFallback
                     else FromSocket
-                  ),
+                ),
         destination = Logger $ loggerSet $ appLogger foundation
-        }
+      }
 
 -- | Warp settings for the given foundation value.
 warpSettings :: App -> Settings
@@ -119,17 +121,17 @@ 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
+      ( \_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)
@@ -182,6 +184,7 @@ shutdownApp _ = return ()
 ---------------------------------------------
 -- Functions for use in development with GHCi
 ---------------------------------------------
+
 -- | Run a handler
 handler :: Handler a -> IO a
 handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h

src/BookingForm.hs

 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
-{-|
-Module: BookingForm
-Description: TODO
-
-TODO
--}
+-- |
+-- Module: BookingForm
+-- Description: TODO
+--
+-- TODO
 module BookingForm
   ( Booking (..),
     bookingMForm,
@@ -19,8 +18,8 @@ module BookingForm
     fromSession,
     b3Class,
     inputSize,
-    labelSize
-    )
+    labelSize,
+  )
 where
 
 import Calendar
@@ -41,7 +40,7 @@ data Booking
         bookEmail :: Text,
         bookSubject :: Text,
         bookContact :: Maybe Text
-        }
+      }
   deriving (Show)
 
 toSession :: MonadHandler m => Booking -> m ()
@@ -97,11 +96,10 @@ data RecaptchaResponse
   = RecaptchaResponse
       { rrSuccess :: Bool,
         rrErrors :: [Text]
-        }
+      }
   deriving (Show)
 
 instance Js.FromJSON RecaptchaResponse where
-
   parseJSON =
     Js.withObject "RecaptchaResponse" $ \o -> do
       rrSuccess <- o .: "success"
@@ -123,9 +121,9 @@ recaptcha =
           let req =
                 req' & H.setRequestManager mgr
                   & H.setRequestBodyURLEncoded
-                      [ ("secret", encodeUtf8 secret),
-                        ("response", encodeUtf8 response)
-                        ]
+                    [ ("secret", encodeUtf8 secret),
+                      ("response", encodeUtf8 response)
+                    ]
           resp <- H.getResponseBody <$> H.httpJSON req
           if rrSuccess resp
             then return (FormSuccess (), [])
@@ -170,8 +168,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/Foundation.hs

@@ -3,11 +3,11 @@
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
 module Foundation
   ( App (..),
@@ -16,8 +16,8 @@ module Foundation
     Form,
     Route (..),
     resourcesApp,
-    unsafeHandler
-    )
+    unsafeHandler,
+  )
 where
 
 import qualified Control.Monad.Catch as MC
@@ -40,15 +40,16 @@ import Yesod.Default.Util (addStaticContentExternal)
 data App
   = App
       { appSettings :: AppSettings,
-        appStatic :: Static, -- ^ Settings for static file serving.
+        -- | Settings for static file serving.
+        appStatic :: Static,
         appHttpManager :: Manager,
         appLogger :: Logger,
         appCalendarCxt :: CalendarContext,
-        appCalendarCache :: FC.Cache (HandlerFor App) (SL.SortedList SimpleEventUTC)
-        -- ^ Fetch latest available times from the calendars. Return cached
+        -- | Fetch latest available times from the calendars. Return cached
         -- version if it's less than given age, which defaults to
         -- 'appCacheExpiry'.
-        }
+        appCalendarCache :: FC.Cache (HandlerFor App) (SL.SortedList SimpleEventUTC)
+      }
 
 -- This is where we define all of the routes in our application. For a full
 -- explanation of the syntax, please see:
@@ -68,7 +69,6 @@ mkYesodData "App" $(parseRoutesFile "config/routes")
 type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
 
 instance MC.MonadCatch (HandlerFor App) where
-
   catch = Pre.catch
 
 addStylesheetL :: Route App -> Text -> [(Text, Text)] -> Widget
@@ -86,7 +86,6 @@ addScriptL route cdn attrs =
 -- Please see the documentation for the Yesod typeclass. There are a number
 -- of settings which can be configured by overriding methods here.
 instance Yesod App where
-
   approot :: Approot App
   approot =
     ApprootRequest $ \app req ->
@@ -100,8 +99,8 @@ instance Yesod App where
   makeSessionBackend _ =
     Just
       <$> defaultClientSessionBackend
-            120 -- timeout in minutes
-            "config/client_session_key.aes"
+        120 -- timeout in minutes
+        "config/client_session_key.aes"
 
   -- Yesod Middleware allows you to run code before and after each handler function.
   -- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
@@ -126,7 +125,7 @@ instance Yesod App where
           "https://code.jquery.com/jquery-3.3.1.min.js"
           [ ("integrity", "sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8="),
             ("crossorigin", "anonymous")
-            ]
+          ]
         addScriptL
           (StaticR js_js_cookie_2_2_0_min_js)
           "https://cdn.jsdelivr.net/npm/js-cookie@2.2.0/src/js.cookie.min.js"
@@ -138,16 +137,18 @@ instance Yesod App where
           "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css"
           [ ( "integrity",
               "sha384-BVYiiSIFeK1dGmJRAkycuHAHRg32OmUcww7on3RYdg4Va+PmSTsz/K68vbdEjh4u"
-              ),
+            ),
             ("crossorigin", "anonymous")
-            ]
+          ]
         $(widgetFile "default-layout")
     withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 
-  isAuthorized
-    :: Route App -- ^ The route the user is visiting.
-    -> Bool -- ^ Whether or not this is a "write" request.
-    -> Handler AuthResult
+  isAuthorized ::
+    -- | The route the user is visiting.
+    Route App ->
+    -- | Whether or not this is a "write" request.
+    Bool ->
+    Handler AuthResult
   -- Routes not requiring authenitcation.
   isAuthorized FaviconR _ = return Authorized
   isAuthorized RobotsR _ = return Authorized
@@ -158,11 +159,14 @@ instance Yesod App where
   -- and names them based on a hash of their content. This allows
   -- expiration dates to be set far in the future without worry of
   -- users receiving stale content.
-  addStaticContent
-    :: Text -- ^ The file extension
-    -> Text -- ^ The MIME content type
-    -> LByteString -- ^ The contents of the file
-    -> Handler (Maybe (Either Text (Route App, [(Text, Text)])))
+  addStaticContent ::
+    -- | The file extension
+    Text ->
+    -- | The MIME content type
+    Text ->
+    -- | The contents of the file
+    LByteString ->
+    Handler (Maybe (Either Text (Route App, [(Text, Text)])))
   addStaticContent ext mime content = do
     master <- getYesod
     let staticDir = appStaticDir $ appSettings master
@@ -182,32 +186,31 @@ instance Yesod App where
   -- in development, and warnings and errors in production.
   shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
   shouldLogIO app _source level =
-    return
-      $ appShouldLogAll (appSettings app)
-      || level
-      == LevelWarn
-      || level
-      == LevelError
+    return $
+      appShouldLogAll (appSettings app)
+        || level
+        == LevelWarn
+        || level
+        == LevelError
 
   makeLogger :: App -> IO Logger
   makeLogger = return . appLogger
 
 -- Define breadcrumbs.
 instance YesodBreadcrumbs App where
-
   -- Takes the route that the user is currently on, and returns a tuple
   -- of the 'Text' that you want the label to display, and a previous
   -- breadcrumb route.
-  breadcrumb
-    :: Route App -- ^ The route the user is visiting currently.
-    -> Handler (Text, Maybe (Route App))
+  breadcrumb ::
+    -- | The route the user is visiting currently.
+    Route App ->
+    Handler (Text, Maybe (Route App))
   breadcrumb HomeR = return ("Home", Nothing)
   breadcrumb _ = return ("home", Nothing)
 
 -- This instance is required to use forms. You can modify renderMessage to
 -- achieve customized and internationalized form validation messages.
 instance RenderMessage App FormMessage where
-
   renderMessage :: App -> [Lang] -> FormMessage -> Text
   renderMessage _ _ = defaultFormMessage
 
@@ -215,7 +218,6 @@ instance RenderMessage App FormMessage where
 -- An example is background jobs that send email.
 -- This can also be useful for writing code that works across multiple Yesod applications.
 instance HasHttpManager App where
-
   getHttpManager :: App -> Manager
   getHttpManager = appHttpManager
 

src/FreshCache.hs

-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
-{-|
-Module: FreshCache
-Description: Cache the result of an expensive action
-
-This utility caches the result of an expensive action for a specified
-amount of time. If the result is requested again within that time, the
-existing one is used. If it is requested after the time is expired, we
-automatically refresh it. Should be thread-safe.
--}
+-- |
+-- Module: FreshCache
+-- Description: Cache the result of an expensive action
+--
+-- This utility caches the result of an expensive action for a specified
+-- amount of time. If the result is requested again within that time, the
+-- 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
-    )
+    cacheDemo,
+  )
 where
 
 import ClassyPrelude.Yesod
@@ -29,14 +28,14 @@ data CacheData a
   = CacheData
       { value :: a,
         retrievedAt :: UTCTime
-        }
+      }
 
 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'.

src/Handlers.hs

 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
-{-|
-Module: Handlers
-Description: TODO
-
-TODO
--}
+-- |
+-- Module: Handlers
+-- Description: TODO
+--
+-- TODO
 module Handlers
   ( getFaviconR,
     getRobotsR,
@@ -21,8 +20,8 @@ module Handlers
     postBookR,
     getFinalR,
     getClearR,
-    getVersionR
-    )
+    getVersionR,
+  )
 where
 
 import BookingForm (b3Class, inputSize, labelSize)

src/Import.hs

 module Import
-  ( module Import
-    )
+  ( module Import,
+  )
 where
 
 import Foundation as Import

src/Import/NoFoundation.hs

@@ -4,14 +4,14 @@ module Import.NoFoundation
   ( module Import,
     pluralN,
     fromWeeks,
-    fromMinutes
-    )
+    fromMinutes,
+  )
 where
 
 import Calendar as Import
   ( CalendarContext,
-    SimpleEventUTC
-    )
+    SimpleEventUTC,
+  )
 import ClassyPrelude.Yesod as Import
 import Data.Time.Clock (NominalDiffTime)
 import Settings as Import

src/QueryForm.hs

@@ -2,20 +2,19 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
-{-|
-Module: QueryForm
-Description: Form for front page, to query available times
-
-Form for front page, to query available times. Consists of the
-location, appointment length, time format, and time zone.
--}
+-- |
+-- Module: QueryForm
+-- Description: Form for front page, to query available times
+--
+-- Form for front page, to query available times. Consists of the
+-- location, appointment length, time format, and time zone.
 module QueryForm
   ( TimeFmt (..),
     QueryForm (..),
@@ -36,8 +35,8 @@ module QueryForm
     noSessionError,
     showDate,
     showTime,
-    prettyTz
-    )
+    prettyTz,
+  )
 where
 
 import Control.Monad.Trans.Maybe
@@ -56,7 +55,6 @@ data TimeFmt
 
 -- | Time format serialization for session and GET/POST parameters.
 instance PathPiece TimeFmt where
-
   toPathPiece Time12h = "12h"
   toPathPiece Time24h = "24h"
 
@@ -66,7 +64,6 @@ instance PathPiece TimeFmt where
 
 -- | Default is 12-hour time.
 instance Default TimeFmt where
-
   def = Time12h
 
 -- | Format strings to be used with 'Data.Time.Format'.
@@ -82,7 +79,7 @@ data QueryForm
         queryTimeFmt :: TimeFmt,
         queryTzLabel :: TZLabelW,
         queryLocation :: Location
-        }
+      }
   deriving (Show)
 
 -- | Represent field names used in a form. This abstraction gives
@@ -94,11 +91,9 @@ data QueryName
   deriving (Eq, Show)