Merge pull request #11 from jonschoning/ghc-8.8.3

update to nightly-2020-03-29 (ghc-8.8.3)

README.md

@@ -59,8 +59,6 @@ see `config/settings.yml` for changing default run-time parameters / environment
 
 default app http port: `3000`
 
-default ekg http port: `8000`
-
 ssl: use reverse proxy
 
 ## Development 

config/settings.yml

@@ -37,7 +37,7 @@ database:
 copyright: Insert copyright statement here
 #analytics: UA-YOURCODE
 
-ekg-host:       "_env:EKG_HOST:0.0.0.0"
+# ekg-host:       "_env:EKG_HOST:0.0.0.0"
-ekg-port:       "_env:EKG_PORT:8000"
+# ekg-port:       "_env:EKG_PORT:8000"
 
 source-code-uri: "https://github.com/jonschoning/espial"

docker-compose.yml

@@ -7,7 +7,7 @@ services:
       dockerfile: ../Dockerfile
     ports:
       - "3000:3000"
-      - "8000:8000"
+      # - "8000:8000"
     volumes:
       - '$APPDATA:/app/data'
     environment:

espial.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 853ba5e7d0435fcec73b493932da0f2748f4674bbfc62ebbd54df707166f999b
+-- hash: b6f4cdc1abf4e7a6b5bbc1382963c22cc62bbbe8c4ae5e5394cf6fe5fc1ff9cb
 
 name:           espial
 version:        0.0.8
@@ -123,7 +123,7 @@ library
       Paths_espial
   hs-source-dirs:
       src
-  default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns
+  default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric DerivingStrategies EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns
   build-depends:
       aeson >=1.4
     , attoparsec
@@ -139,11 +139,9 @@ library
     , containers
     , data-default
     , directory >=1.1 && <1.4
-    , ekg
-    , ekg-core
     , entropy
     , esqueleto
-    , fast-logger >=2.2 && <2.5
+    , fast-logger >=2.2 && <4
     , file-embed
     , foreign-store
     , hjsmin >=0.1 && <0.3
@@ -157,10 +155,9 @@ library
     , iso8601-time >=0.1.3
     , microlens
     , monad-logger >=0.3 && <0.4
-    , monad-metrics
     , mtl
     , parser-combinators
-    , persistent >=2.8 && <2.10
+    , persistent >=2.8 && <2.11
     , persistent-sqlite >=2.6.2
     , persistent-template >=2.5 && <2.9
     , pretty-show
@@ -175,7 +172,6 @@ library
     , wai
     , wai-extra >=3.0 && <3.1
     , wai-logger >=2.2 && <2.4
-    , wai-middleware-metrics
     , warp >=3.0 && <3.4
     , yaml >=0.8 && <0.12
     , yesod >=1.6 && <1.7
@@ -198,7 +194,7 @@ executable espial
       Paths_espial
   hs-source-dirs:
       app
-  default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns
+  default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric DerivingStrategies EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       aeson >=1.4
@@ -215,12 +211,10 @@ executable espial
     , containers
     , data-default
     , directory >=1.1 && <1.4
-    , ekg
-    , ekg-core
     , entropy
     , espial
     , esqueleto
-    , fast-logger >=2.2 && <2.5
+    , fast-logger >=2.2 && <4
     , file-embed
     , foreign-store
     , hjsmin >=0.1 && <0.3
@@ -234,10 +228,9 @@ executable espial
     , iso8601-time >=0.1.3
     , microlens
     , monad-logger >=0.3 && <0.4
-    , monad-metrics
     , mtl
     , parser-combinators
-    , persistent >=2.8 && <2.10
+    , persistent >=2.8 && <2.11
     , persistent-sqlite >=2.6.2
     , persistent-template >=2.5 && <2.9
     , pretty-show
@@ -252,7 +245,6 @@ executable espial
     , wai
     , wai-extra >=3.0 && <3.1
     , wai-logger >=2.2 && <2.4
-    , wai-middleware-metrics
     , warp >=3.0 && <3.4
     , yaml >=0.8 && <0.12
     , yesod >=1.6 && <1.7
@@ -271,7 +263,7 @@ executable migration
       Paths_espial
   hs-source-dirs:
       app/migration
-  default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns
+  default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric DerivingStrategies EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       aeson >=1.4
@@ -288,12 +280,10 @@ executable migration
     , containers
     , data-default
     , directory >=1.1 && <1.4
-    , ekg
-    , ekg-core
     , entropy
     , espial
     , esqueleto
-    , fast-logger >=2.2 && <2.5
+    , fast-logger >=2.2 && <4
     , file-embed
     , foreign-store
     , hjsmin >=0.1 && <0.3
@@ -307,11 +297,10 @@ executable migration
     , iso8601-time >=0.1.3
     , microlens
     , monad-logger >=0.3 && <0.4
-    , monad-metrics
     , mtl
     , optparse-generic >=1.2.3
     , parser-combinators
-    , persistent >=2.8 && <2.10
+    , persistent >=2.8 && <2.11
     , persistent-sqlite >=2.6.2
     , persistent-template >=2.5 && <2.9
     , pretty-show
@@ -326,7 +315,6 @@ executable migration
     , wai
     , wai-extra >=3.0 && <3.1
     , wai-logger >=2.2 && <2.4
-    , wai-middleware-metrics
     , warp >=3.0 && <3.4
     , yaml >=0.8 && <0.12
     , yesod >=1.6 && <1.7
@@ -349,7 +337,7 @@ test-suite test
       Paths_espial
   hs-source-dirs:
       test
-  default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns
+  default-extensions: BangPatterns CPP ConstraintKinds DataKinds DeriveDataTypeable DeriveGeneric DerivingStrategies EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings PolyKinds PolymorphicComponents QuasiQuotes Rank2Types RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns
   ghc-options: -Wall
   build-depends:
       aeson >=1.4
@@ -366,12 +354,10 @@ test-suite test
     , containers
     , data-default
     , directory >=1.1 && <1.4
-    , ekg
-    , ekg-core
     , entropy
     , espial
     , esqueleto
-    , fast-logger >=2.2 && <2.5
+    , fast-logger >=2.2 && <4
     , file-embed
     , foreign-store
     , hjsmin >=0.1 && <0.3
@@ -386,10 +372,9 @@ test-suite test
     , iso8601-time >=0.1.3
     , microlens
     , monad-logger >=0.3 && <0.4
-    , monad-metrics
     , mtl
     , parser-combinators
-    , persistent >=2.8 && <2.10
+    , persistent >=2.8 && <2.11
     , persistent-sqlite >=2.6.2
     , persistent-template >=2.5 && <2.9
     , pretty-show
@@ -404,7 +389,6 @@ test-suite test
     , wai
     , wai-extra >=3.0 && <3.1
     , wai-logger >=2.2 && <2.4
-    , wai-middleware-metrics
     , warp >=3.0 && <3.4
     , yaml >=0.8 && <0.12
     , yesod >=1.6 && <1.7

package.yaml

@@ -47,6 +47,7 @@ default-extensions:
 - DataKinds
 - DeriveDataTypeable
 - DeriveGeneric
+- DerivingStrategies      
 - EmptyDataDecls
 - FlexibleContexts
 - FlexibleInstances
@@ -73,6 +74,7 @@ default-extensions:
 - TypeFamilies
 - TypeOperators
 - TypeSynonymInstances
+- UndecidableInstances
 - ViewPatterns
 
 dependencies:
@@ -92,7 +94,7 @@ dependencies:
 - classy-prelude-yesod >=1.4 && <1.6
 - bytestring >=0.9 && <0.11
 - text >=0.11 && <2.0
-- persistent >=2.8 && <2.10
+- persistent >=2.8 && <2.11
 # - persistent-postgresql >=2.8 && <2.9
 - blaze-html >= 0.9 && < 1.0
 - persistent-template >=2.5 && <2.9
@@ -110,7 +112,7 @@ dependencies:
 # - aeson >=0.6 && <1.4
 - conduit >=1.0 && <2.0
 - monad-logger >=0.3 && <0.4
-- fast-logger >=2.2 && <2.5
+- fast-logger >=2.2 && <4
 - wai-logger >=2.2 && <2.4
 - file-embed
 - safe
@@ -126,8 +128,8 @@ dependencies:
 - attoparsec
 - bcrypt >= 0.0.8
 - entropy
-- ekg
+# - ekg
-- ekg-core
+# - ekg-core
 - esqueleto
 - hscolour
 - http-api-data >= 0.3.4
@@ -135,12 +137,12 @@ dependencies:
 - http-types
 - iso8601-time >=0.1.3
 - microlens
-- monad-metrics
+# - monad-metrics
 - mtl
 - persistent-sqlite >=2.6.2
 - pretty-show
 - transformers >= 0.2.2
-- wai-middleware-metrics
+# - wai-middleware-metrics
 - parser-combinators
 - html-entities
 

src/Application.hs

@@ -18,7 +18,7 @@ import           Control.Monad.Logger (liftLoc, runLoggingT)
 import           Database.Persist.Sqlite (createSqlitePool, runSqlPool, sqlDatabase, sqlPoolSize)
 import           Import
 import           Language.Haskell.TH.Syntax (qLocation)
-import           Lens.Micro
+-- import           Lens.Micro
 import           Network.HTTP.Client.TLS
 import           Network.Wai (Middleware)
 import           Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, setOnException, setPort, getPort)
@@ -28,12 +28,11 @@ import           Network.Wai.Middleware.Gzip
 import           Network.Wai.Middleware.MethodOverride
 import           Network.Wai.Middleware.RequestLogger (Destination(Logger), IPAddrSource(..), OutputFormat(..), destination, mkRequestLogger, outputFormat)
 import           System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)
-import           Yesod.Auth (getAuth)
 
-import qualified Control.Monad.Metrics as MM
+-- import qualified Control.Monad.Metrics as MM
-import qualified Network.Wai.Metrics as WM
+-- import qualified Network.Wai.Metrics as WM
-import qualified System.Metrics as EKG
+-- import qualified System.Metrics as EKG
-import qualified System.Remote.Monitoring as EKG
+-- import qualified System.Remote.Monitoring as EKG
 
 -- Import all relevant handler modules here.
 -- Don't forget to add new modules to your cabal file!
@@ -52,9 +51,9 @@ makeFoundation :: AppSettings -> IO App
 makeFoundation appSettings = do
   appHttpManager <- getGlobalManager
   appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
-  store <- EKG.newStore
+  -- store <- EKG.newStore
-  EKG.registerGcMetrics store
+  -- EKG.registerGcMetrics store
-  appMetrics <- MM.initializeWith store
+  -- appMetrics <- MM.initializeWith store
   appStatic <-
     (if appMutableStatic appSettings
        then staticDevel
@@ -77,13 +76,13 @@ makeApplication :: App -> IO Application
 makeApplication foundation = do
   logWare <- makeLogWare foundation
   appPlain <- toWaiAppPlain foundation
-  let store = appMetrics foundation ^. MM.metricsStore
+  -- let store = appMetrics foundation ^. MM.metricsStore
-  waiMetrics <- WM.registerWaiMetrics store
+  -- waiMetrics <- WM.registerWaiMetrics store
-  return (logWare (makeMiddleware waiMetrics appPlain))
+  return (logWare (makeMiddleware appPlain))
 
-makeMiddleware :: WM.WaiMetrics -> Middleware
+makeMiddleware :: Middleware
-makeMiddleware waiMetrics =
+makeMiddleware =
-  WM.metrics waiMetrics .
+  -- WM.metrics waiMetrics .
   acceptOverride .
   autohead .
   gzip def {gzipFiles = GzipPreCompressed GzipIgnore} .
@@ -127,7 +126,7 @@ getApplicationDev = do
   foundation <- makeFoundation settings
   wsettings <- getDevSettings (warpSettings foundation)
   app <- makeApplication foundation
-  forkEKG foundation
+  -- forkEKG foundation
   return (wsettings, app)
 
 getAppSettings :: IO AppSettings
@@ -137,15 +136,15 @@ getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv
 develMain :: IO ()
 develMain = develMainHelper getApplicationDev
 
-forkEKG :: App -> IO ()
+-- forkEKG :: App -> IO ()
-forkEKG foundation = 
+-- forkEKG foundation = 
-  let settings = appSettings foundation in
+--   let settings = appSettings foundation in
-  for_ (appEkgHost settings) $ \ekgHost ->
+--   for_ (appEkgHost settings) $ \ekgHost ->
-    for_ (appEkgPort settings) $ \ekgPort ->
+--     for_ (appEkgPort settings) $ \ekgPort ->
-      EKG.forkServerWith
+--       EKG.forkServerWith
-        (appMetrics foundation ^. MM.metricsStore)
+--         (appMetrics foundation ^. MM.metricsStore)
-        (encodeUtf8 ekgHost)
+--         (encodeUtf8 ekgHost)
-        ekgPort
+--         ekgPort
 
 -- | The @main@ function for an executable running this site.
 appMain :: IO ()
@@ -153,7 +152,7 @@ appMain = do
   settings <- loadYamlSettingsArgs [configSettingsYmlValue] useEnv
   foundation <- makeFoundation settings
   app <- makeApplication foundation
-  forkEKG foundation
+  -- forkEKG foundation
   runSettings (warpSettings foundation) app
 
 getApplicationRepl :: IO (Int, App, Application)

src/Foundation.hs

@@ -15,8 +15,8 @@ import PathPiece()
 import Yesod.Default.Util   (addStaticContentExternal)
 import Yesod.Core.Types
 import Yesod.Auth.Message
-import qualified Network.Wai as NW
+-- import qualified Network.Wai as NW
-import qualified Control.Monad.Metrics as MM
+-- import qualified Control.Monad.Metrics as MM
 import qualified Data.CaseInsensitive as CI
 import qualified Data.Text.Encoding as TE
 import qualified Yesod.Core.Unsafe as Unsafe
@@ -27,7 +27,7 @@ data App = App
     , appConnPool    :: ConnectionPool -- ^ Database connection pool.
     , appHttpManager :: Manager
     , appLogger      :: Logger
-    , appMetrics     :: !MM.Metrics
+    -- , appMetrics     :: !MM.Metrics
     } deriving (Typeable)
 
 mkYesodData "App" $(parseRoutesFile "config/routes")
@@ -58,7 +58,8 @@ instance Yesod App where
         10080 -- min (7 days)
         "config/client_session_key.aes"
 
-    yesodMiddleware = metricsMiddleware . defaultYesodMiddleware . defaultCsrfMiddleware
+    -- yesodMiddleware = metricsMiddleware . defaultYesodMiddleware . defaultCsrfMiddleware
+    yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
 
     defaultLayout widget = do
         req <- getRequest
@@ -68,7 +69,7 @@ instance Yesod App where
         musername <- maybeAuthUsername
         muser <- (fmap.fmap) snd maybeAuthPair
         mcurrentRoute <- getCurrentRoute
-        void $ mapM (incrementRouteEKG req) mcurrentRoute
+        -- void $ mapM (incrementRouteEKG req) mcurrentRoute
         let msourceCodeUri = appSourceCodeUri (appSettings master)
         pc <- widgetToPageContent $ do
             setTitle "Espial"
@@ -139,17 +140,17 @@ popupLayout widget = do
     withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
 
 
-metricsMiddleware :: Handler a -> Handler a
+-- metricsMiddleware :: Handler a -> Handler a
-metricsMiddleware handler = do
+-- metricsMiddleware handler = do
-  req <- getRequest
+--   req <- getRequest
-  mcurrentRoute <- getCurrentRoute
+--   mcurrentRoute <- getCurrentRoute
-  void $ mapM (incrementRouteEKG req) mcurrentRoute
+--   void $ mapM (incrementRouteEKG req) mcurrentRoute
-  handler
+--   handler
 
 
-incrementRouteEKG :: YesodRequest -> Route App -> Handler ()
+-- incrementRouteEKG :: YesodRequest -> Route App -> Handler ()
-incrementRouteEKG req = MM.increment . (\r -> "route." <> r <> "." <> method) . pack . constrName
+-- incrementRouteEKG req = MM.increment . (\r -> "route." <> r <> "." <> method) . pack . constrName
-  where method = decodeUtf8 $ NW.requestMethod $ reqWaiRequest req
+--   where method = decodeUtf8 $ NW.requestMethod $ reqWaiRequest req
 
 -- YesodAuth
 
@@ -169,8 +170,8 @@ instance YesodAuth App where
 
 instance YesodAuthPersist App
 
-instance MM.MonadMetrics Handler where
+-- instance MM.MonadMetrics Handler where
-  getMetrics = pure . appMetrics =<< getYesod 
+--   getMetrics = pure . appMetrics =<< getYesod 
 
 -- session keys
 

src/Handler/Archive.hs

@@ -12,7 +12,7 @@ import qualified Network.HTTP.Client as NH
 import qualified Network.HTTP.Client.TLS as NH
 import qualified Network.HTTP.Types.Status as NH
 import qualified Web.FormUrlEncoded as WH
-import qualified Control.Monad.Metrics as MM
+-- import qualified Control.Monad.Metrics as MM
 import HTMLEntities.Decoder (htmlEncodedText)
 import Data.Text.Lazy.Builder (toLazyText)
 
@@ -31,15 +31,15 @@ archiveBookmarkUrl :: Key Bookmark -> String -> Handler ()
 archiveBookmarkUrl kbid url =
   (_fetchArchiveSubmitInfo >>= \case
     Left e -> do
-      MM.increment "archive.fetchSubmitId_noparse"
+      -- MM.increment "archive.fetchSubmitId_noparse"
       $(logError) (pack e)
     Right submitInfo ->  do
         userId <- requireAuthId
         let req = _buildArchiveSubmitRequest submitInfo url
-        MM.increment "archive.submit"  
+        -- MM.increment "archive.submit"  
         res <- liftIO $ NH.httpLbs req  =<< NH.getGlobalManager
         let status = NH.responseStatus res
-        MM.increment ("archive.submit_status_" <> (pack.show) (NH.statusCode status)) 
+        -- MM.increment ("archive.submit_status_" <> (pack.show) (NH.statusCode status)) 
         let updateArchiveUrl = runDB . updateBookmarkArchiveUrl userId kbid . Just
             headers = NH.responseHeaders res
         case status of
@@ -87,9 +87,9 @@ _buildArchiveSubmitRequest (action, submitId) href =
 
 _fetchArchiveSubmitInfo :: Handler (Either String (String , String))
 _fetchArchiveSubmitInfo = do
-  MM.increment "archive.fetchSubmitId"  
+  -- MM.increment "archive.fetchSubmitId"  
   res <- liftIO $ NH.httpLbs (buildSimpleRequest "https://archive.li/") =<< NH.getGlobalManager
-  MM.increment ("archive.fetchSubmitId_status_" <> (pack.show) (NH.statusCode (NH.responseStatus res))) 
+  -- MM.increment ("archive.fetchSubmitId_status_" <> (pack.show) (NH.statusCode (NH.responseStatus res))) 
   let body = LBS.toStrict (responseBody res)
       action = _parseSubstring (AP8.string "action=\"") (AP8.notChar '"') body
       submitId = _parseSubstring (AP8.string "submitid\" value=\"") (AP8.notChar '"') body
@@ -107,12 +107,13 @@ _parseSubstring start inner res = do
 
 fetchPageTitle :: String -> Handler (Either String Text)
 fetchPageTitle url =
-  do MM.increment "fetchPageTitle"
+  do
+     -- MM.increment "fetchPageTitle"
      res <- liftIO $ NH.httpLbs (buildSimpleRequest url) =<< NH.getGlobalManager
      let body = LBS.toStrict (responseBody res)
      pure (decodeHtmlBs <$> parseTitle body)
      `catch` (\(e :: SomeException) -> do
-                MM.increment "fetchPageTitle.error"
+                -- MM.increment "fetchPageTitle.error"
                 $(logError) $ (pack . show) e
                 pure (Left (show e)))
   where

src/Handler/Notes.hs

@@ -6,7 +6,6 @@ import Handler.Common (lookupPagingParams)
 import qualified Data.Aeson as A
 import qualified Data.Text as T
 import           Yesod.RssFeed
-import           Text.Blaze.Html (toHtml)
 import qualified Text.Blaze.Html5 as H
 
 getNotesR :: UserNameP -> Handler Html

src/Handler/User.hs

@@ -4,7 +4,6 @@ module Handler.User where
 import qualified Data.Text as T
 import           Handler.Common
 import           Import
-import           Text.Blaze.Html (toHtml)
 import qualified Text.Blaze.Html5 as H
 import           Yesod.RssFeed
 import qualified Database.Esqueleto as E

src/Model.hs

@@ -3,7 +3,9 @@
 module Model where
 
 import qualified ClassyPrelude.Yesod as CP
+import Control.Monad.Fail (MonadFail)
 import qualified Data.Aeson as A
+import qualified Data.Aeson.Types as A (parseFail)
 import qualified Data.Attoparsec.Text as P
 import qualified Control.Monad.Combinators as PC
 import qualified Data.List.NonEmpty as NE
@@ -245,7 +247,7 @@ parseSearchQuery toExpr =
         quotedTerm = PC.between (P.char '"') (P.char '"') (P.takeWhile1 (/= '"'))
         simpleTerm = P.takeWhile1 (\c -> not (isSpace c) && c /= ':' && c /= '|')
 
-parseTimeText :: (TI.ParseTime t, Monad m, Alternative m) => Text -> m t
+parseTimeText :: (TI.ParseTime t, MonadFail m, Alternative m) => Text -> m t
 parseTimeText t =
   asum $
   flip (parseTimeM True defaultTimeLocale) (unpack t) <$>
@@ -426,8 +428,8 @@ instance FromJSON TagCloudMode where
       Just (String "lowerBound") -> TagCloudModeLowerBound <$> o .: "expanded" <*> o .: "value"
       Just (String "related") -> TagCloudModeRelated <$> o .: "expanded" <*> (fmap words (o .: "value"))
       Just (String "none") -> pure TagCloudModeNone
-      _ -> fail "bad parse"
+      _ -> A.parseFail "bad parse"
-  parseJSON _ = fail "bad parse"
+  parseJSON _ = A.parseFail "bad parse"
 
 instance ToJSON TagCloudMode where
   toJSON (TagCloudModeTop e i) =
@@ -635,9 +637,9 @@ upsertBookmark userId mbid bm tags = do
       get bid >>= \case
         Just prev_bm -> do
           when (userId /= bookmarkUserId prev_bm)
-            (fail "unauthorized")
+            (throwString "unauthorized")
           replaceBookmark bid prev_bm
-        _ -> fail "not found"
+        _ -> throwString "not found"
     Nothing -> do
       getBy (UniqueUserHref (bookmarkUserId bm) (bookmarkHref bm)) >>= \case
         Just (Entity bid prev_bm) -> replaceBookmark bid prev_bm
@@ -672,10 +674,10 @@ upsertNote userId mnid note = do
       get nid >>= \case
         Just note' -> do
           when (userId /= (noteUserId note'))
-            (fail "unauthorized")
+            (throwString "unauthorized")
           replace nid note
           pure (Updated, nid)
-        _ -> fail "not found"
+        _ -> throwString "not found"
     Nothing -> do
       (Created,) <$> insert note
 
@@ -702,7 +704,7 @@ instance FromJSON FileBookmark where
     (o A..:? "selected") <*>
     (o A..:? "archive_url") <*>
     (o .: "tags")
-  parseJSON _ = fail "bad parse"
+  parseJSON _ = A.parseFail "bad parse"
 
 instance ToJSON FileBookmark where
   toJSON (FileBookmark {..}) =
@@ -743,7 +745,7 @@ instance FromJSON FileNote where
     o .: "length" <*>
     (readFileNoteTime =<< o .: "created_at") <*>
     (readFileNoteTime =<< o .: "updated_at")
-  parseJSON _ = fail "bad parse"
+  parseJSON _ = A.parseFail "bad parse"
 
 instance ToJSON FileNote where
   toJSON (FileNote {..}) =
@@ -757,7 +759,7 @@ instance ToJSON FileNote where
       ]
 
 readFileNoteTime
-  :: Monad m
+  :: MonadFail m
   => String -> m UTCTime
 readFileNoteTime = parseTimeM True defaultTimeLocale "%F %T"
 

src/Settings.hs

@@ -56,10 +56,11 @@ data AppSettings = AppSettings
     , appAuthDummyLogin         :: Bool
     -- ^ Indicate if auth dummy login should be enabled.
 
-    , appEkgHost                :: Maybe Text
+    -- , appEkgHost                :: Maybe Text
-    -- ^ Host/interface the ekg server should bind to.
+    -- -- ^ Host/interface the ekg server should bind to.
-    , appEkgPort                :: Maybe Int
+    -- , appEkgPort                :: Maybe Int
-    -- ^ Port to listen on
+    -- -- ^ Port to listen on
+
     , appSourceCodeUri                :: Maybe Text
     -- ^ Uri to app source code
     }
@@ -92,8 +93,8 @@ instance FromJSON AppSettings where
 
         appAuthDummyLogin         <- o .:? "auth-dummy-login"      .!= dev
 
-        appEkgHost                <- o .:? "ekg-host"
+        -- appEkgHost                <- o .:? "ekg-host"
-        appEkgPort                <- o .:? "ekg-port"
+        -- appEkgPort                <- o .:? "ekg-port"
         appSourceCodeUri          <- o .:? "source-code-uri"
 
         return AppSettings {..}

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-14.27
+resolver: nightly-2020-03-29
 # allow-newer: true
 packages:
 - '.'

stack.yaml.lock

@@ -41,7 +41,7 @@ packages:
     hackage: yesod-newsfeed-1.7.0.0
 snapshots:
 - completed:
-    size: 524996
+    size: 507788
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/27.yaml
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/3/29.yaml
-    sha256: 7ea31a280c56bf36ff591a7397cc384d0dff622e7f9e4225b47d8980f019a0f0
+    sha256: f5cfc0452d1dc9d3058dcf389278d1cfb72ebc91b1a9bd48e8dde399c9479999
-  original: lts-14.27
+  original: nightly-2020-03-29