WIP: Add hindent support and bash script

.haskell-ghc-mod.json

@@ -0,0 +1,3 @@
+{
+  "suppressErrors": true
+}

.hindent.yaml

@@ -0,0 +1,3 @@
+indent-size: 4
+line-length: 80
+force-trailing-newline: true

app/DevelMain.hs

@@ -27,73 +27,76 @@
 --
 -- There is more information about this approach,
 -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci
-
 module DevelMain where
 
-import Prelude
 import Application (getApplicationRepl, shutdownApp)
+import Prelude
 
+import Control.Concurrent
 import Control.Exception (finally)
 import Control.Monad ((>=>))
-import Control.Concurrent
 import Data.IORef
 import Foreign.Store
-import Network.Wai.Handler.Warp
 import GHC.Word
+import Network.Wai.Handler.Warp
 
 -- | Start or restart the server.
 -- newStore is from foreign-store.
 -- A Store holds onto some data across ghci reloads
 update :: IO ()
 update = do
     mtidStore <- lookupStore tidStoreNum
-    case mtidStore of
+    case mtidStore
       -- no server running
-      Nothing -> do
-          done <- storeAction doneStore newEmptyMVar
-          tid <- start done
-          _ <- storeAction (Store tidStoreNum) (newIORef tid)
-          return ()
+          of
+        Nothing -> do
+            done <- storeAction doneStore newEmptyMVar
+            tid <- start done
+            _ <- storeAction (Store tidStoreNum) (newIORef tid)
+            return ()
       -- server is already running
-      Just tidStore -> restartAppInNewThread tidStore
+        Just tidStore -> restartAppInNewThread tidStore
   where
     doneStore :: Store (MVar ())
     doneStore = Store 0
-
     -- shut the server down with killThread and wait for the done signal
     restartAppInNewThread :: Store (IORef ThreadId) -> IO ()
-    restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do
-        killThread tid
-        withStore doneStore takeMVar
-        readStore doneStore >>= start
-
-
+    restartAppInNewThread tidStore =
+        modifyStoredIORef tidStore $ \tid -> 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
+    start ::
+           MVar () -- ^ Written to when the thread is killed.
+        -> IO ThreadId
     start done = do
         (port, site, app) <- getApplicationRepl
-        forkIO (finally (runSettings (setPort port defaultSettings) app)
+        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))
+                 (putMVar done () >> shutdownApp site))
 
 -- | kill the server
 shutdown :: IO ()
 shutdown = do
     mtidStore <- lookupStore tidStoreNum
-    case mtidStore of
+    case mtidStore
       -- no server running
-      Nothing -> putStrLn "no Yesod app running"
-      Just tidStore -> do
-          withStore tidStore $ readIORef >=> killThread
-          putStrLn "Yesod app is shutdown"
+          of
+        Nothing -> putStrLn "no Yesod app running"
+        Just tidStore -> do
+            withStore tidStore $ readIORef >=> killThread
+            putStrLn "Yesod app is shutdown"
 
 tidStoreNum :: Word32
 tidStoreNum = 1
 
 modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO ()
-modifyStoredIORef store f = withStore store $ \ref -> do
-    v <- readIORef ref
-    f v >>= writeIORef ref
+modifyStoredIORef store f =
+    withStore store $ \ref -> do
+        v <- readIORef ref
+        f v >>= writeIORef ref

app/devel.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE PackageImports #-}
+
 import "PROJECTNAME" Application (develMain)
 import Prelude (IO)
 

app/main.hs

@@ -1,5 +1,5 @@
-import Prelude     (IO)
 import Application (appMain)
+import Prelude (IO)
 
 main :: IO ()
 main = appMain

hindent_all

@@ -0,0 +1,34 @@
+#!/usr/bin/env bash
+
+# Based on https://github.com/commercialhaskell/hindent/issues/309#issue-180517159
+
+set -e
+
+HINDENT=hindent
+GIT=git
+
+LINE_LENGTH=80
+
+function hindent_file {
+    filename="$1"
+    output_filename="${filename}.hindented"
+    # In hindent 0.5+, the style is hard-coded to johan-tibell
+    ${HINDENT} --style johan-tibell --line-length "${LINE_LENGTH}" < "${filename}" > "${output_filename}"
+    mv "${output_filename}" "${filename}"
+}
+
+function list_haskell_files {
+    # TODO: Figure out if it's a Haskell file in a more reliable way, e.g.
+    # using `file`, or just running hindent on everything.
+
+    # TODO: Exclude ./src/Settings.hs, due to https://github.com/commercialhaskell/hindent/issues/383
+    ${GIT} ls-files './*.hs'
+}
+
+function indent_everything {
+    for filename in $(list_haskell_files); do
+        hindent_file "${filename}"
+    done
+}
+
+indent_everything

src/Application.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Application
     ( getApplicationDev
     , appMain
@@ -19,28 +20,27 @@ module Application
     , db
     ) where
 
-import Control.Monad.Logger                 (liftLoc, runLoggingT)
-import Database.Persist.Postgresql          (createPostgresqlPool, pgConnStr,
-                                             pgPoolSize, runSqlPool)
+import Control.Monad.Logger (liftLoc, runLoggingT)
+import Database.Persist.Postgresql
+       (createPostgresqlPool, pgConnStr, pgPoolSize, runSqlPool)
 import Import
-import Language.Haskell.TH.Syntax           (qLocation)
+import Language.Haskell.TH.Syntax (qLocation)
 import Network.Wai (Middleware)
-import Network.Wai.Handler.Warp             (Settings, defaultSettings,
-                                             defaultShouldDisplayException,
-                                             runSettings, setHost,
-                                             setOnException, setPort, getPort)
-import Network.Wai.Middleware.RequestLogger (Destination (Logger),
-                                             IPAddrSource (..),
-                                             OutputFormat (..), destination,
-                                             mkRequestLogger, outputFormat)
-import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
-                                             toLogStr)
+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 Handler.Comment
 
 -- Import all relevant handler modules here.
 -- Don't forget to add new modules to your cabal file!
 import Handler.Common
 import Handler.Home
-import Handler.Comment
 import Handler.Profile
 
 -- This line actually creates our YesodDispatch instance. It is the second half
@@ -53,15 +53,17 @@ mkYesodDispatch "App" resourcesApp
 -- the place to put your migrate statements to have automatic database
 -- migrations handled by Yesod.
 makeFoundation :: AppSettings -> IO App
-makeFoundation appSettings = do
+makeFoundation appSettings
     -- Some basic initializations: HTTP connection manager, logger, and static
     -- subsite.
+ = do
     appHttpManager <- newManager
     appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
     appStatic <-
-        (if appMutableStatic appSettings then staticDevel else static)
-        (appStaticDir appSettings)
-
+        (if appMutableStatic appSettings
+             then staticDevel
+             else static)
+            (appStaticDir appSettings)
     -- We need a log function to create a connection pool. We need a connection
     -- pool to create our foundation. And we need our foundation to get a
     -- logging function. To get out of this loop, we initially create a
@@ -71,17 +73,17 @@ makeFoundation appSettings = do
         -- The App {..} syntax is an example of record wild cards. For more
         -- information, see:
         -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
-        tempFoundation = mkFoundation $ error "connPool forced in tempFoundation"
+        tempFoundation =
+            mkFoundation $ error "connPool forced in tempFoundation"
         logFunc = messageLoggerSource tempFoundation appLogger
-
     -- Create the database connection pool
-    pool <- flip runLoggingT logFunc $ createPostgresqlPool
-        (pgConnStr  $ appDatabaseConf appSettings)
-        (pgPoolSize $ appDatabaseConf appSettings)
-
+    pool <-
+        flip runLoggingT logFunc $
+        createPostgresqlPool
+            (pgConnStr $ appDatabaseConf appSettings)
+            (pgPoolSize $ appDatabaseConf appSettings)
     -- Perform database migration using our application's logging settings.
     runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
-
     -- Return the foundation
     return $ mkFoundation pool
 
@@ -96,32 +98,34 @@ makeApplication foundation = do
 
 makeLogWare :: App -> IO Middleware
 makeLogWare foundation =
-    mkRequestLogger def
+    mkRequestLogger
+        def
         { outputFormat =
-            if appDetailedRequestLogging $ appSettings foundation
-                then Detailed True
-                else Apache
-                        (if appIpFromHeader $ appSettings foundation
-                            then FromFallback
-                            else FromSocket)
+              if appDetailedRequestLogging $ appSettings foundation
+                  then Detailed True
+                  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)
@@ -141,25 +145,22 @@ develMain = develMainHelper getApplicationDev
 
 -- | The @main@ function for an executable running this site.
 appMain :: IO ()
-appMain = do
+appMain
     -- Get the settings from all relevant sources
-    settings <- loadYamlSettingsArgs
+ = 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
-
     -- Generate a WAI Application from the foundation
     app <- makeApplication foundation
-
     -- Run the application with Warp
     runSettings (warpSettings foundation) app
 
-
 --------------------------------------------------------------
 -- Functions for DevelMain.hs (a way to run the app from GHCi)
 --------------------------------------------------------------
@@ -174,11 +175,9 @@ getApplicationRepl = do
 shutdownApp :: App -> IO ()
 shutdownApp _ = return ()
 
-
 ---------------------------------------------
 -- Functions for use in development with GHCi
 ---------------------------------------------
-
 -- | Run a handler
 handler :: Handler a -> IO a
 handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h