HLint Report

Report generated by HLint v2.1.9 - a tool to suggest improvements to your Haskell code.

src/Files.hs:32:1: Warning: Use fewer imports
Found

import System.Posix.Types (FileMode)
import System.Posix.Types (FileOffset)

Perhaps

import System.Posix.Types (FileMode, FileOffset)

src/JSON.hs:109:1: Warning: Eta reduce
Found

mapRecords toRecord objs
  = mapObjects (recordObject . toRecord) objs

Perhaps

mapRecords toRecord = mapObjects (recordObject . toRecord)

src/JSON.hs:144:33: Suggestion: Redundant bracket
Found

(objToPair k encodedObj) <> seriesRest

Perhaps

objToPair k encodedObj <> seriesRest

src/JSON.hs:149:5: Warning: Eta reduce
Found

objToPair key encObj
  = ((TE.decodeLatin1 key .=) . UnsafeEncoding) encObj

Perhaps

objToPair key = ((TE.decodeLatin1 key .=) . UnsafeEncoding)

src/Ops.hs:76:1: Warning: Eta reduce
Found

flatMapM justAction mVal = maybe (return Nothing) justAction mVal

Perhaps

flatMapM = maybe (return Nothing)

src/Routes.hs:101:5: Warning: Redundant lambda
Found

hn0 act
  = \ _ req responder -> actionApp routeContext act req responder

Perhaps

hn0 act _ req responder = actionApp routeContext act req responder

src/Routes.hs:103:5: Warning: Redundant lambda
Found

hn mkAction
  = \ ps req responder ->
      actionApp routeContext (mkAction ps) req responder

Perhaps

hn mkAction ps req responder
  = actionApp routeContext (mkAction ps) req responder

src/Routes.hs:105:5: Warning: Redundant lambda
Found

hnm mkAction
  = \ ps req responder ->
      actionApp routeContext (mkAction (WAI.requestMethod req) ps) req
        responder

Perhaps

hnm mkAction ps req responder
  = actionApp routeContext (mkAction (WAI.requestMethod req) ps) req
      responder

src/Warp.hs:34:1: Warning: Eta reduce
Found

runWarp conf rc app
  = run (conf C.! "ssl.key") (oneOrMany $ conf C.! "ssl.cert")
      (Warp.setPort (conf C.! "port") $
         Warp.setTimeout 300 $
           Warp.setFdCacheDuration 300 $
             Warp.setFileInfoCacheDuration 300 $
               Warp.setServerName (BSC.pack $ "databrary/" ++ showVersion version)
                 $
                 Warp.setOnException
                   (\ req e ->
                      do t <- getCurrentTime
                         msg <- mapM
                                  (\ q -> requestLog t q Nothing $ Warp.exceptionResponseForDebug e)
                                  req
                         logMsg t
                           (maybe id (\ m -> (<>) (m <> "\n")) msg $ toLogStr $ show e)
                           (serviceLogs rc))
                   $ Warp.setHTTP2Disabled Warp.defaultSettings)
      app

Perhaps

runWarp conf rc
  = run (conf C.! "ssl.key") (oneOrMany $ conf C.! "ssl.cert")
      (Warp.setPort (conf C.! "port") $
         Warp.setTimeout 300 $
           Warp.setFdCacheDuration 300 $
             Warp.setFileInfoCacheDuration 300 $
               Warp.setServerName (BSC.pack $ "databrary/" ++ showVersion version)
                 $
                 Warp.setOnException
                   (\ req e ->
                      do t <- getCurrentTime
                         msg <- mapM
                                  (\ q -> requestLog t q Nothing $ Warp.exceptionResponseForDebug e)
                                  req
                         logMsg t
                           (maybe id (\ m -> (<>) (m <> "\n")) msg $ toLogStr $ show e)
                           (serviceLogs rc))
                   $ Warp.setHTTP2Disabled Warp.defaultSettings)

src/Action/Form.hs:31:5: Warning: Eta reduce
Found

getFileMaxSizeByFieldName fieldName
  = (fromMaybe 0 . (`lookup` fileLimits)) fieldName

Perhaps

getFileMaxSizeByFieldName = (fromMaybe 0 . (`lookup` fileLimits))

src/Action/Request.hs:11:21: Warning: Use elem
Found

any ("DatabraryClient" ==)

Perhaps

elem "DatabraryClient"

src/Controller/Asset.hs:56:1: Warning: Use fewer imports
Found

import Store.AV (AV)
import Store.AV (avProbeLength)

Perhaps

import Store.AV (AV, avProbeLength)

src/Controller/AssetSegment.hs:26:1: Warning: Use fewer imports
Found

import Files (unRawFilePath, RawFilePath)
import Files (fileInfo)

Perhaps

import Files (unRawFilePath, RawFilePath, fileInfo)

src/Controller/Citation.hs:15:1: Suggestion: Use newtype instead of data
Found

data GetCitationRequest = GetCitationRequest URI

Perhaps

newtype GetCitationRequest = GetCitationRequest URI

Note: decreases laziness

src/Controller/Excerpt.hs:35:1: Suggestion: Use newtype instead of data
Found

data CreateOrUpdateExcerptRequest = CreateOrUpdateExcerptRequest (Maybe
                                                                    Release)

Perhaps

newtype CreateOrUpdateExcerptRequest = CreateOrUpdateExcerptRequest (Maybe
                                                                       Release)

Note: decreases laziness

src/Controller/Funding.hs:42:1: Suggestion: Use newtype instead of data
Found

data CreateOrUpdateVolumeFundingRequest = CreateOrUpdateVolumeFundingRequest [T.Text]

Perhaps

newtype CreateOrUpdateVolumeFundingRequest = CreateOrUpdateVolumeFundingRequest [T.Text]

Note: decreases laziness

src/Controller/Funding.hs:51:100: Suggestion: Use const
Found

\ _ -> deform

Perhaps

const deform

src/Controller/Ingest.hs:39:1: Warning: Use fewer imports
Found

import Model.Metric (Metric)
import Model.Metric

Perhaps

import Model.Metric

src/Controller/Ingest.hs:65:3: Suggestion: Reduce duplication
Found

checkMemberADMIN
s <- focusIO getIngestStatus
v <- getVolume PermissionEDIT vi

Perhaps

Combine with src/Controller/Ingest.hs:76:3

src/Controller/Ingest.hs:101:1: Suggestion: Use newtype instead of data
Found

data DetectParticipantCSVRequest = DetectParticipantCSVRequest (FileInfo
                                                                  TL.Text)

Perhaps

newtype DetectParticipantCSVRequest = DetectParticipantCSVRequest (FileInfo
                                                                     TL.Text)

Note: decreases laziness

src/Controller/Ingest.hs:148:1: Warning: Eta reduce
Found

uniqueUploadName siteAuth vol uploadName
  = uniqueUploadName'
      ((partyId . partyRow . accountParty . siteAccount) siteAuth)
      ((volumeId . volumeRow) vol)
      uploadName

Perhaps

uniqueUploadName siteAuth vol
  = uniqueUploadName'
      ((partyId . partyRow . accountParty . siteAccount) siteAuth)
      ((volumeId . volumeRow) vol)

src/Controller/Ingest.hs:203:1: Warning: Eta reduce
Found

runImport vol records = mapM (createOrUpdateRecord vol) records

Perhaps

runImport vol = mapM (createOrUpdateRecord vol)

src/Controller/Ingest.hs:285:24: Warning: Use fromMaybe
Found

maybe (error "id missing") id

Perhaps

Data.Maybe.fromMaybe (error "id missing")

src/Controller/Ingest.hs:286:17: Warning: Use fromMaybe
Found

maybe (error "id empty") id

Perhaps

Data.Maybe.fromMaybe (error "id empty")

src/Controller/Ingest.hs:296:18: Warning: Use mapM_
Found

mapM (runMeasureUpdate newParticipantShell) measureActs

Perhaps

mapM_ (runMeasureUpdate newParticipantShell) measureActs

src/Controller/Ingest.hs:299:18: Warning: Use mapM_
Found

mapM (runMeasureUpdate oldRecord) measureActs

Perhaps

mapM_ (runMeasureUpdate oldRecord) measureActs

src/Controller/Login.hs:83:1: Warning: Redundant lambda
Found

postLoginAction
  = \ api ->
      withoutAuth $
        do (Just auth, su) <- runForm ((api == HTML) `thenUse` htmlLogin) $
                                do email <- "email" .:> emailTextForm
                                   password <- "password" .:> deform
                                   superuser <- "superuser" .:> deform
                                   let _ = LoginRequest email password superuser
                                   (auth :: Maybe SiteAuth) <- lift $
                                                                 lookupSiteAuthByEmail True email
                                   let p :: Maybe Party
                                       p = view <$> auth
                                       su
                                         = superuser &&
                                             any ((PermissionADMIN ==) . accessMember) auth
                                   attempts <- lift $ maybe (return 0) recentAccountLogins p
                                   let pass = checkPassword password `any` auth
                                       block = attempts > 4
                                   lift $ auditAccountLogin pass (fromMaybe nobodyParty p) email
                                   when block $
                                     "email" .:>
                                       deformError "Too many login attempts. Try again later."
                                   unless pass $
                                     "password" .:>
                                       deformError
                                         "Incorrect email address or password. Both are case-sensitive, and institutional addresses are preferred."
                                   return (auth, su)
           loginAccount api auth su

Perhaps

postLoginAction api
  = withoutAuth $
      do (Just auth, su) <- runForm ((api == HTML) `thenUse` htmlLogin) $
                              do email <- "email" .:> emailTextForm
                                 password <- "password" .:> deform
                                 superuser <- "superuser" .:> deform
                                 let _ = LoginRequest email password superuser
                                 (auth :: Maybe SiteAuth) <- lift $ lookupSiteAuthByEmail True email
                                 let p :: Maybe Party
                                     p = view <$> auth
                                     su
                                       = superuser && any ((PermissionADMIN ==) . accessMember) auth
                                 attempts <- lift $ maybe (return 0) recentAccountLogins p
                                 let pass = checkPassword password `any` auth
                                     block = attempts > 4
                                 lift $ auditAccountLogin pass (fromMaybe nobodyParty p) email
                                 when block $
                                   "email" .:>
                                     deformError "Too many login attempts. Try again later."
                                 unless pass $
                                   "password" .:>
                                     deformError
                                       "Incorrect email address or password. Both are case-sensitive, and institutional addresses are preferred."
                                 return (auth, su)
         loginAccount api auth su

src/Controller/Metric.hs:31:28: Suggestion: Use list comprehension
Found

if metricAdded then [metricId'] else []

Perhaps

[metricId' | metricAdded]

src/Controller/Paths.hs:34:19: Error: Parse error
Found

  type PathParameter = Parameter PathString
  
> idIso :: IdType a I.<-> Id a
  idIso = -- [I.biCase|a <-> Id a|]
      ((\a      -> Id a)

src/Controller/Periodic.hs:44:1: Suggestion: Use newtype instead of data
Found

data RunPeriodicRequest = RunPeriodicRequest Bool

Perhaps

newtype RunPeriodicRequest = RunPeriodicRequest Bool

Note: decreases laziness

src/Controller/Permission.hs:25:1: Warning: Eta reduce
Found

checkPermissionOld requiredPermissionLevel
  objectWithCurrentUserPermLevel
  = checkPermission view requiredPermissionLevel
      objectWithCurrentUserPermLevel

Perhaps

checkPermissionOld = checkPermission view

src/Controller/Record.hs:54:1: Suggestion: Use newtype instead of data
Found

data CreateRecordRequest = CreateRecordRequest Category

Perhaps

newtype CreateRecordRequest = CreateRecordRequest Category

Note: decreases laziness

src/Controller/Record.hs:66:1: Suggestion: Use newtype instead of data
Found

data ManageRecordMeasureRequest = ManageRecordMeasureRequest (Maybe
                                                                BS.ByteString)

Perhaps

newtype ManageRecordMeasureRequest = ManageRecordMeasureRequest (Maybe
                                                                   BS.ByteString)

Note: decreases laziness

src/Controller/Record.hs:72:7: Warning: Eta reduce
Found

mkMeasure datum = Measure record met datum

Perhaps

mkMeasure = Measure record met

src/Controller/Record.hs:99:1: Suggestion: Use newtype instead of data
Found

data UpdateRecordSlotRequest = UpdateRecordSlotRequest (Maybe
                                                          Segment)

Perhaps

newtype UpdateRecordSlotRequest = UpdateRecordSlotRequest (Maybe
                                                             Segment)

Note: decreases laziness

src/Controller/Register.hs:77:1: Warning: Redundant lambda
Found

postRegisterAction
  = \ api ->
      withoutAuth $
        do reg <- runForm ((api == HTML) `thenUse` htmlRegister) $
                    do name <- "sortname" .:> (deformRequired =<< deform)
                       prename <- "prename" .:> deformNonEmpty deform
                       email <- "email" .:> emailTextForm
                       affiliation <- "affiliation" .:> deformNonEmpty deform
                       agreement <- "agreement" .:>
                                      (deformCheck "You must consent to the user agreement." id =<<
                                         deform)
                       let _ = RegisterRequest name prename email affiliation agreement
                       let p = blankParty{partyRow =
                                            (partyRow blankParty){partySortName = name,
                                                                  partyPreName = prename,
                                                                  partyAffiliation = affiliation},
                                          partyAccount = Just a}
                           a = Account{accountParty = p, accountEmail = email}
                       return a
           auth <- maybe
                     (SiteAuth <$> addAccount reg <*> pure Nothing <*> pure mempty)
                     return
                     =<< lookupSiteAuthByEmail False (accountEmail reg)
           resetPasswordMail (Right auth) "Databrary account created" $
             \ (Just url) ->
               "Thank you for registering with  Please use this link to complete your registration:\n\n"
                 <>
                 url <>
                   "\n\nBy clicking the above link, you also indicate that you have read and understand the Databrary Access agreement, which you can download here: http://databrary.org/policies/agreement.pdf\n\nOnce you've validated your e-mail, you will be able to request authorization to be granted full access to \n"
           focusIO $ staticSendInvestigator (view auth)
           return $
             okResponse [] $
               "Your confirmation email has been sent to '" <>
                 accountEmail reg <> "'."

Perhaps

postRegisterAction api
  = withoutAuth $
      do reg <- runForm ((api == HTML) `thenUse` htmlRegister) $
                  do name <- "sortname" .:> (deformRequired =<< deform)
                     prename <- "prename" .:> deformNonEmpty deform
                     email <- "email" .:> emailTextForm
                     affiliation <- "affiliation" .:> deformNonEmpty deform
                     agreement <- "agreement" .:>
                                    (deformCheck "You must consent to the user agreement." id =<<
                                       deform)
                     let _ = RegisterRequest name prename email affiliation agreement
                     let p = blankParty{partyRow =
                                          (partyRow blankParty){partySortName = name,
                                                                partyPreName = prename,
                                                                partyAffiliation = affiliation},
                                        partyAccount = Just a}
                         a = Account{accountParty = p, accountEmail = email}
                     return a
         auth <- maybe
                   (SiteAuth <$> addAccount reg <*> pure Nothing <*> pure mempty)
                   return
                   =<< lookupSiteAuthByEmail False (accountEmail reg)
         resetPasswordMail (Right auth) "Databrary account created" $
           \ (Just url) ->
             "Thank you for registering with  Please use this link to complete your registration:\n\n"
               <>
               url <>
                 "\n\nBy clicking the above link, you also indicate that you have read and understand the Databrary Access agreement, which you can download here: http://databrary.org/policies/agreement.pdf\n\nOnce you've validated your e-mail, you will be able to request authorization to be granted full access to \n"
         focusIO $ staticSendInvestigator (view auth)
         return $
           okResponse [] $
             "Your confirmation email has been sent to '" <>
               accountEmail reg <> "'."

src/Controller/Register.hs:139:1: Suggestion: Use newtype instead of data
Found

data PasswordResetRequest = PasswordResetRequest BSC.ByteString

Perhaps

newtype PasswordResetRequest = PasswordResetRequest BSC.ByteString

Note: decreases laziness

src/Controller/Register.hs:142:1: Warning: Redundant lambda
Found

postPasswordResetAction
  = \ api ->
      withoutAuth $
        do PasswordResetRequest email <- runForm
                                           ((api == HTML) `thenUse` htmlPasswordReset)
                                           $ PasswordResetRequest <$> ("email" .:> emailTextForm)
           auth <- lookupPasswordResetAccount email
           resetPasswordMail (maybe (Left email) Right auth)
             "Databrary password reset"
             $
             ("Someone (hopefully you) has requested to reset the password for the Databrary account associated with this email address. If you did not request this, let us know (by replying to this message) or simply ignore it.\n\n" <>)
               .
               maybe
                 "Unfortunately, no Databrary account was found for this email address. You can try again with a different email address, or reply to this email for assistance.\n"
                 ("Otherwise, you may use this link to reset your Databrary password:\n\n" <>)
           return $
             okResponse [] $
               "Your password reset information has been sent to '" <>
                 email <> "'."

Perhaps

postPasswordResetAction api
  = withoutAuth $
      do PasswordResetRequest email <- runForm
                                         ((api == HTML) `thenUse` htmlPasswordReset)
                                         $ PasswordResetRequest <$> ("email" .:> emailTextForm)
         auth <- lookupPasswordResetAccount email
         resetPasswordMail (maybe (Left email) Right auth)
           "Databrary password reset"
           $
           ("Someone (hopefully you) has requested to reset the password for the Databrary account associated with this email address. If you did not request this, let us know (by replying to this message) or simply ignore it.\n\n" <>)
             .
             maybe
               "Unfortunately, no Databrary account was found for this email address. You can try again with a different email address, or reply to this email for assistance.\n"
               ("Otherwise, you may use this link to reset your Databrary password:\n\n" <>)
         return $
           okResponse [] $
             "Your password reset information has been sent to '" <>
               email <> "'."

src/Controller/Search.hs:36:1: Warning: Redundant lambda
Found

postSearchHandler
  = \ api ->
      withAuth $
        do when (api == HTML) angular
           q <- runForm Nothing searchForm
           proxyResponse <$> search q

Perhaps

postSearchHandler api
  = withAuth $
      do when (api == HTML) angular
         q <- runForm Nothing searchForm
         proxyResponse <$> search q

src/Controller/Slot.hs:89:38: Suggestion: Use if
Found

case getOrig of
    True -> Just . JSON.mapRecords (assetSlotJSON False) <$>
              lookupOrigSlotAssets o
    False -> Just . JSON.mapRecords (assetSlotJSON False) <$>
               lookupSlotAssets o

Perhaps

if getOrig then
  Just . JSON.mapRecords (assetSlotJSON False) <$>
    lookupOrigSlotAssets o
  else
  Just . JSON.mapRecords (assetSlotJSON False) <$> lookupSlotAssets o

src/Controller/Slot.hs:137:18: Suggestion: Redundant bracket
Found

(maybe getSlot getVolumeSlot vi) PermissionPUBLIC

Perhaps

maybe getSlot getVolumeSlot vi PermissionPUBLIC

src/Controller/Slot.hs:176:18: Suggestion: Redundant bracket
Found

(maybe getSlot getVolumeSlot vi) PermissionPUBLIC

Perhaps

maybe getSlot getVolumeSlot vi PermissionPUBLIC

src/Controller/Tag.hs:51:3: Suggestion: Reduce duplication
Found

guardVerfHeader
u <- authAccount
s <- getSlot (if kw then PermissionEDIT else PermissionSHARED) si

Perhaps

Combine with src/Controller/Tag.hs:69:3

src/Controller/Token.hs:9:1: Warning: Use fewer imports
Found

import Control.Monad (mfilter)
import Control.Monad (when, unless)

Perhaps

import Control.Monad (mfilter, when, unless)

src/Controller/Transcode.hs:96:1: Suggestion: Use newtype instead of data
Found

data UpdateTranscodeRequest = UpdateTranscodeRequest TranscodeAction

Perhaps

newtype UpdateTranscodeRequest = UpdateTranscodeRequest TranscodeAction

Note: decreases laziness

src/Controller/Volume.hs:194:6: Suggestion: Redundant bracket
Found

(Just . JSON.toEncoding) <$> metricsCaching

Perhaps

Just . JSON.toEncoding <$> metricsCaching

src/Controller/Volume.hs:295:3: Warning: Use unless
Found

when (not empty)

Perhaps

unless empty

src/Controller/VolumeAccess.hs:68:56: Warning: Use /=
Found

not . (== FormDatumNone)

Perhaps

(/= FormDatumNone)

Note: incorrect if either value is NaN

src/Controller/Zip.hs:64:13: Suggestion: Use if
Found

case isOrig of
    True -> getAssetFile $ fromJust origAsset
    False -> getAssetFile a

Perhaps

if isOrig then getAssetFile $ fromJust origAsset else
  getAssetFile a

src/Controller/Zip.hs:69:35: Suggestion: Use if
Found

case isOrig of
    False -> makeFilename (assetDownloadName True False ar)
               `addFormatExtension` assetFormat ar
    True -> makeFilename (assetDownloadName False True ar)
              `addFormatExtension` assetFormat ar

Perhaps

if isOrig then
  makeFilename (assetDownloadName False True ar) `addFormatExtension`
    assetFormat ar
  else
  makeFilename (assetDownloadName True False ar) `addFormatExtension`
    assetFormat ar

src/Controller/Zip.hs:147:17: Suggestion: Use if
Found

case isOrig of
    True -> do origs <- lookupOrigContainerAssets c
               let pdfs = filterFormat c' formatNotAV
               return $ pdfs ++ origs
    False -> return c'

Perhaps

if isOrig then
  (do origs <- lookupOrigContainerAssets c
      let pdfs = filterFormat c' formatNotAV
      return $ pdfs ++ origs)
  else return c'

src/Controller/Zip.hs:159:17: Suggestion: Use if
Found

case isOrig of
    True -> pathMaybe pathId </> pathSlotId </< "zip" </< "true"
    False -> pathMaybe pathId </> pathSlotId </< "zip" </< "false"

Perhaps

(if isOrig then
   pathMaybe pathId </> pathSlotId </< "zip" </< "true" else
   pathMaybe pathId </> pathSlotId </< "zip" </< "false")

src/Controller/Zip.hs:185:17: Suggestion: Use if
Found

case isOrig of
    True -> pathId </< "zip" </< "true"
    False -> pathId </< "zip" </< "false"

Perhaps

(if isOrig then pathId </< "zip" </< "true" else
   pathId </< "zip" </< "false")

src/Data/ByteString/Builder/Escape.hs:18:21: Suggestion: Use String
Found

Char -> [Char] -> BoundedPrim Word8

Perhaps

Char -> String -> BoundedPrim Word8

src/Data/ByteString/Builder/Escape.hs:32:34: Suggestion: Use String
Found

Char -> [Char] -> L.ByteString -> Builder

Perhaps

Char -> String -> L.ByteString -> Builder

src/Data/ByteString/Builder/Escape.hs:35:19: Suggestion: Use String
Found

Char -> [Char] -> Text -> Builder

Perhaps

Char -> String -> Text -> Builder

src/Data/Csv/Contrib.hs:53:5: Warning: Eta reduce
Found

getSample vals = (take maxSamples . L.nub) vals

Perhaps

getSample = (take maxSamples . L.nub)

src/Data/Csv/Contrib.hs:60:31: Warning: Use fromMaybe
Found

maybe "" id

Perhaps

MB.fromMaybe ""

src/Data/Csv/Contrib.hs:79:1: Warning: Eta reduce
Found

parseCsvWithHeader contents = runCsvParser ATTO.parseOnly contents

Perhaps

parseCsvWithHeader = runCsvParser ATTO.parseOnly

src/Data/Csv/Contrib.hs:93:1: Warning: Eta reduce
Found

scrub rows = fmap scrubRow rows

Perhaps

scrub = fmap scrubRow

src/Data/Csv/Contrib.hs:97:5: Warning: Eta reduce
Found

scrubRow row
  = HMP.map (\ v -> if BSC.all (== ' ') v then "" else v) row

Perhaps

scrubRow = HMP.map (\ v -> if BSC.all (== ' ') v then "" else v)

src/HTTP/Form/Deform.hs:60:5: Warning: Use fmap
Found

liftM

Perhaps

fmap

src/HTTP/Form/Deform.hs:132:1: Warning: Eta reduce
Found

(.:>) keyName subDeform
  = withSubDeform (FormField keyName) subDeform

Perhaps

(.:>) keyName = withSubDeform (FormField keyName)

src/HTTP/Form/View.hs:30:5: Warning: Use fmap
Found

liftM

Perhaps

fmap

src/HTTP/Form/View.hs:35:5: Warning: Use fmap
Found

liftM

Perhaps

fmap

src/HTTP/Method/Map.hs:19:1: Suggestion: Use newtype instead of data
Found

data MethodMapException = MethodMapConflict StdMethod
                            deriving (Typeable, Show)

Perhaps

newtype MethodMapException = MethodMapConflict StdMethod
                               deriving (Typeable, Show)

Note: decreases laziness

src/Ingest/JSON.hs:206:28: Suggestion: Use const
Found

\ _ -> asSegment

Perhaps

const asSegment

src/Model/Access.hs:34:1: Warning: Eta reduce
Found

accessSlot requestedPerm
  = accessPermissionedObject lookupSlot
      (extractPermissionIgnorePolicy .
         volumeRolePolicy . containerVolume . slotContainer)
      requestedPerm

Perhaps

accessSlot
  = accessPermissionedObject lookupSlot
      (extractPermissionIgnorePolicy .
         volumeRolePolicy . containerVolume . slotContainer)

src/Model/Access.hs:49:1: Warning: Eta reduce
Found

accessVolume requestedPerm
  = accessPermissionedObject lookupVolume
      (extractPermissionIgnorePolicy . volumeRolePolicy)
      requestedPerm

Perhaps

accessVolume
  = accessPermissionedObject lookupVolume
      (extractPermissionIgnorePolicy . volumeRolePolicy)

src/Model/AssetSlot.hs:26:1: Warning: Use fewer imports
Found

import Data.Maybe (fromMaybe, isNothing)
import Data.Maybe (fromJust, catMaybes)

Perhaps

import Data.Maybe (fromMaybe, isNothing, fromJust, catMaybes)

src/Model/Authorize.hs:52:6: Suggestion: Use const
Found

\ p ->
  $(
    selectQuery (selectAuthorizeParent 'child 'ident)
      "$WHERE (expires IS NULL OR expires > CURRENT_TIMESTAMP) AND site >= ${p} AND member >= ${p} AND (site <> 'NONE' OR member <> 'NONE')"
    )

Perhaps

const
  $(
    selectQuery (selectAuthorizeParent 'child 'ident)
      "$WHERE (expires IS NULL OR expires > CURRENT_TIMESTAMP) AND site >= ${p} AND member >= ${p} AND (site <> 'NONE' OR member <> 'NONE')"
    )

src/Model/Authorize.hs:63:6: Suggestion: Use const
Found

\ p ->
  $(
    selectQuery (selectAuthorizeChild 'parent 'ident)
      "$WHERE (expires IS NULL OR expires > CURRENT_TIMESTAMP) AND site >= ${p} AND member >= ${p} AND (site <> 'NONE' OR member <> 'NONE')"
    )

Perhaps

const
  $(
    selectQuery (selectAuthorizeChild 'parent 'ident)
      "$WHERE (expires IS NULL OR expires > CURRENT_TIMESTAMP) AND site >= ${p} AND member >= ${p} AND (site <> 'NONE' OR member <> 'NONE')"
    )

src/Model/Citation.hs:46:5: Warning: Functor law
Found

fmap ($ Just (volumeName $ volumeRow vol))
  (fmap
     (\ (vhead_aAhJ, vurl_aAhK, vyear_aAhL) ->
        Citation vhead_aAhJ vurl_aAhK vyear_aAhL)
     mRow)

Perhaps

fmap
  (($ Just (volumeName $ volumeRow vol)) .
     (\ (vhead_aAhJ, vurl_aAhK, vyear_aAhL) ->
        Citation vhead_aAhJ vurl_aAhK vyear_aAhL))
  mRow

src/Model/Comment.hs:343:1: Warning: Eta reduce
Found

makeCommentRow i c s w t x = CommentRow i w (SlotId c s) t x

Perhaps

makeCommentRow i c s w = CommentRow i w (SlotId c s)

src/Model/Funding.hs:51:8: Suggestion: Use uncurry
Found

\ (vid_a13Ft, vname_a13Fu) -> Funder vid_a13Ft vname_a13Fu

Perhaps

uncurry Funder

Note: increases laziness

src/Model/Funding.hs:76:12: Suggestion: Use uncurry
Found

\ (vid_a1vMW, vname_a1vMX) -> Funder vid_a1vMW vname_a1vMX

Perhaps

uncurry Funder

Note: increases laziness

src/Model/Ingest.hs:61:14: Warning: Functor law
Found

fmap ($ vol)
  (fmap
     (\ (vid_a6Dph, vtop_a6Dpi, vname_a6Dpj, vdate_a6Dpk,
         vrelease_a6Dpl)
        ->
        Container
          (ContainerRow vid_a6Dph vtop_a6Dpi vname_a6Dpj vdate_a6Dpk)
          vrelease_a6Dpl)
     (mapQuery
        ((\ _p_a6Dpq _p_a6Dpr ->
            (Data.ByteString.concat
               [Data.String.fromString
                  "SELECT container.id,container.top,container.name,container.date,slot_release.release FROM container LEFT JOIN slot_release ON container.id = slot_release.container AND slot_release.segment = '(,)' JOIN ingest.container AS ingest USING (id, volume) WHERE ingest.key = ",
                Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6Dpp
                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                     Database.PostgreSQL.Typed.Types.PGTypeName "text")
                  _p_a6Dpq,
                Data.String.fromString " AND container.volume = ",
                Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6Dpp
                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                     Database.PostgreSQL.Typed.Types.PGTypeName "integer")
                  _p_a6Dpr]))
           k
           (volumeId $ volumeRow vol))
        (\ [_cid_a6Dps, _ctop_a6Dpt, _cname_a6Dpu, _cdate_a6Dpv,
            _crelease_a6Dpw]
           ->
           (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6Dpp
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "integer")
              _cid_a6Dps,
            Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6Dpp
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "boolean")
              _ctop_a6Dpt,
            Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6Dpp
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "text")
              _cname_a6Dpu,
            Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6Dpp
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "date")
              _cdate_a6Dpv,
            Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6Dpp
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "release")
              _crelease_a6Dpw))))

Perhaps

fmap
  (($ vol) .
     (\ (vid_a6Dph, vtop_a6Dpi, vname_a6Dpj, vdate_a6Dpk,
         vrelease_a6Dpl)
        ->
        Container
          (ContainerRow vid_a6Dph vtop_a6Dpi vname_a6Dpj vdate_a6Dpk)
          vrelease_a6Dpl))
  (mapQuery
     ((\ _p_a6Dpq _p_a6Dpr ->
         (Data.ByteString.concat
            [Data.String.fromString
               "SELECT container.id,container.top,container.name,container.date,slot_release.release FROM container LEFT JOIN slot_release ON container.id = slot_release.container AND slot_release.segment = '(,)' JOIN ingest.container AS ingest USING (id, volume) WHERE ingest.key = ",
             Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6Dpp
               (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                  Database.PostgreSQL.Typed.Types.PGTypeName "text")
               _p_a6Dpq,
             Data.String.fromString " AND container.volume = ",
             Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6Dpp
               (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                  Database.PostgreSQL.Typed.Types.PGTypeName "integer")
               _p_a6Dpr]))
        k
        (volumeId $ volumeRow vol))
     (\ [_cid_a6Dps, _ctop_a6Dpt, _cname_a6Dpu, _cdate_a6Dpv,
         _crelease_a6Dpw]
        ->
        (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6Dpp
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "integer")
           _cid_a6Dps,
         Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6Dpp
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "boolean")
           _ctop_a6Dpt,
         Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6Dpp
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "text")
           _cname_a6Dpu,
         Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6Dpp
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "date")
           _cdate_a6Dpv,
         Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6Dpp
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "release")
           _crelease_a6Dpw)))

src/Model/Ingest.hs:151:14: Warning: Functor law
Found

fmap ($ vol)
  (fmap
     (\ (vid_a6GtB, vcategory_a6GtC, vmeasures_a6GtD, vc_a6GtE) ->
        ($)
          (Model.Record.SQL.makeRecord vid_a6GtB vcategory_a6GtC
             vmeasures_a6GtD)
          vc_a6GtE)
     (mapQuery
        ((\ _p_a6GtG _p_a6GtH ->
            (Data.ByteString.concat
               [Data.String.fromString
                  "SELECT record.id,record.category,record.measures,record_release(record.id) FROM record_measures AS record JOIN ingest.record AS ingest USING (id, volume) WHERE ingest.key = ",
                Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6GtF
                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                     Database.PostgreSQL.Typed.Types.PGTypeName "text")
                  _p_a6GtG,
                Data.String.fromString " AND record.volume = ",
                Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6GtF
                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                     Database.PostgreSQL.Typed.Types.PGTypeName "integer")
                  _p_a6GtH]))
           k
           (volumeId $ volumeRow vol))
        (\ [_cid_a6GtI, _ccategory_a6GtJ, _cmeasures_a6GtK,
            _crecord_release_a6GtL]
           ->
           (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6GtF
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "integer")
              _cid_a6GtI,
            Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6GtF
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "smallint")
              _ccategory_a6GtJ,
            Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6GtF
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "text[]")
              _cmeasures_a6GtK,
            Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6GtF
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "release")
              _crecord_release_a6GtL))))

Perhaps

fmap
  (($ vol) .
     (\ (vid_a6GtB, vcategory_a6GtC, vmeasures_a6GtD, vc_a6GtE) ->
        ($)
          (Model.Record.SQL.makeRecord vid_a6GtB vcategory_a6GtC
             vmeasures_a6GtD)
          vc_a6GtE))
  (mapQuery
     ((\ _p_a6GtG _p_a6GtH ->
         (Data.ByteString.concat
            [Data.String.fromString
               "SELECT record.id,record.category,record.measures,record_release(record.id) FROM record_measures AS record JOIN ingest.record AS ingest USING (id, volume) WHERE ingest.key = ",
             Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6GtF
               (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                  Database.PostgreSQL.Typed.Types.PGTypeName "text")
               _p_a6GtG,
             Data.String.fromString " AND record.volume = ",
             Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6GtF
               (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                  Database.PostgreSQL.Typed.Types.PGTypeName "integer")
               _p_a6GtH]))
        k
        (volumeId $ volumeRow vol))
     (\ [_cid_a6GtI, _ccategory_a6GtJ, _cmeasures_a6GtK,
         _crecord_release_a6GtL]
        ->
        (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6GtF
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "integer")
           _cid_a6GtI,
         Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6GtF
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "smallint")
           _ccategory_a6GtJ,
         Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6GtF
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "text[]")
           _cmeasures_a6GtK,
         Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6GtF
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "release")
           _crecord_release_a6GtL)))

src/Model/Ingest.hs:233:14: Warning: Functor law
Found

fmap (`Asset` vol)
  (fmap
     (\ (vid_a6PDo, vformat_a6PDp, vrelease_a6PDq, vduration_a6PDr,
         vname_a6PDs, vc_a6PDt, vsize_a6PDu)
        ->
        Model.Asset.SQL.makeAssetRow vid_a6PDo vformat_a6PDp vrelease_a6PDq
          vduration_a6PDr
          vname_a6PDs
          vc_a6PDt
          vsize_a6PDu)
     (mapQuery
        ((\ _p_a6PDw _p_a6PDx ->
            (Data.ByteString.concat
               [Data.String.fromString
                  "SELECT asset.id,asset.format,asset.release,asset.duration,asset.name,asset.sha1,asset.size FROM asset JOIN ingest.asset AS ingest USING (id) WHERE ingest.file = ",
                Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6PDv
                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                     Database.PostgreSQL.Typed.Types.PGTypeName "text")
                  _p_a6PDw,
                Data.String.fromString " AND asset.volume = ",
                Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6PDv
                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                     Database.PostgreSQL.Typed.Types.PGTypeName "integer")
                  _p_a6PDx]))
           k
           (volumeId $ volumeRow vol))
        (\ [_cid_a6PDy, _cformat_a6PDz, _crelease_a6PDA, _cduration_a6PDB,
            _cname_a6PDC, _csha1_a6PDD, _csize_a6PDE]
           ->
           (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6PDv
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "integer")
              _cid_a6PDy,
            Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6PDv
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "smallint")
              _cformat_a6PDz,
            Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6PDv
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "release")
              _crelease_a6PDA,
            Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6PDv
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "interval")
              _cduration_a6PDB,
            Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6PDv
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "text")
              _cname_a6PDC,
            Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6PDv
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "bytea")
              _csha1_a6PDD,
            Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6PDv
              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                 Database.PostgreSQL.Typed.Types.PGTypeName "bigint")
              _csize_a6PDE))))

Perhaps

fmap
  ((`Asset` vol) .
     (\ (vid_a6PDo, vformat_a6PDp, vrelease_a6PDq, vduration_a6PDr,
         vname_a6PDs, vc_a6PDt, vsize_a6PDu)
        ->
        Model.Asset.SQL.makeAssetRow vid_a6PDo vformat_a6PDp vrelease_a6PDq
          vduration_a6PDr
          vname_a6PDs
          vc_a6PDt
          vsize_a6PDu))
  (mapQuery
     ((\ _p_a6PDw _p_a6PDx ->
         (Data.ByteString.concat
            [Data.String.fromString
               "SELECT asset.id,asset.format,asset.release,asset.duration,asset.name,asset.sha1,asset.size FROM asset JOIN ingest.asset AS ingest USING (id) WHERE ingest.file = ",
             Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6PDv
               (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                  Database.PostgreSQL.Typed.Types.PGTypeName "text")
               _p_a6PDw,
             Data.String.fromString " AND asset.volume = ",
             Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6PDv
               (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                  Database.PostgreSQL.Typed.Types.PGTypeName "integer")
               _p_a6PDx]))
        k
        (volumeId $ volumeRow vol))
     (\ [_cid_a6PDy, _cformat_a6PDz, _crelease_a6PDA, _cduration_a6PDB,
         _cname_a6PDC, _csha1_a6PDD, _csize_a6PDE]
        ->
        (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6PDv
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "integer")
           _cid_a6PDy,
         Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull _tenv_a6PDv
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "smallint")
           _cformat_a6PDz,
         Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6PDv
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "release")
           _crelease_a6PDA,
         Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6PDv
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "interval")
           _cduration_a6PDB,
         Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6PDv
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "text")
           _cname_a6PDC,
         Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6PDv
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "bytea")
           _csha1_a6PDD,
         Database.PostgreSQL.Typed.Types.pgDecodeColumn _tenv_a6PDv
           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
              Database.PostgreSQL.Typed.Types.PGTypeName "bigint")
           _csize_a6PDE)))

src/Model/Ingest.hs:360:1: Warning: Eta reduce
Found

attemptParseRows participantFieldMapping contents
  = decodeCsvByNameWith
      (participantRecordParseNamedRecord participantFieldMapping)
      contents

Perhaps

attemptParseRows participantFieldMapping
  = decodeCsvByNameWith
      (participantRecordParseNamedRecord participantFieldMapping)

src/Model/Ingest.hs:432:1: Warning: Eta reduce
Found

extractColumnsDistinctSampleJson maxSamples hdrs records
  = (fmap (\ (colHdr, vals) -> columnSampleJson colHdr vals) .
       extractColumnsDistinctSample maxSamples hdrs)
      records

Perhaps

extractColumnsDistinctSampleJson maxSamples hdrs
  = (fmap (\ (colHdr, vals) -> columnSampleJson colHdr vals) .
       extractColumnsDistinctSample maxSamples hdrs)

src/Model/Ingest.hs:433:13: Suggestion: Use uncurry
Found

\ (colHdr, vals) -> columnSampleJson colHdr vals

Perhaps

uncurry columnSampleJson

Note: increases laziness

src/Model/Ingest.hs:438:1: Warning: Eta reduce
Found

extractColumnsInitialJson maxRows hdrs records
  = (fmap (\ (colHdr, vals) -> columnSampleJson colHdr vals) .
       extractColumnsInitialRows maxRows hdrs)
      records

Perhaps

extractColumnsInitialJson maxRows hdrs
  = (fmap (\ (colHdr, vals) -> columnSampleJson colHdr vals) .
       extractColumnsInitialRows maxRows hdrs)

src/Model/Ingest.hs:439:13: Suggestion: Use uncurry
Found

\ (colHdr, vals) -> columnSampleJson colHdr vals

Perhaps

uncurry columnSampleJson

Note: increases laziness

src/Model/Ingest.hs:463:1: Warning: Eta reduce
Found

participantFieldMappingToJSON fldMap
  = (toJSON . fmap fieldToEntry . Map.toList . pfmGetMapping) fldMap

Perhaps

participantFieldMappingToJSON
  = (toJSON . fmap fieldToEntry . Map.toList . pfmGetMapping)

src/Model/Measure.hs:18:1: Warning: Use fewer imports
Found

import Database.PostgreSQL.Typed.Types
       (PGTypeName, pgTypeName, PGColumn(pgDecode))
import Database.PostgreSQL.Typed.Types

Perhaps

import Database.PostgreSQL.Typed.Types

src/Model/Party.hs:945:11: Suggestion: Redundant bracket
Found

\ _p_a6QXP ->
  (BS.concat
     [Data.String.fromString
        "SELECT count(*) FROM audit.account WHERE audit_action = 'attempt' AND id = ",
      Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6QXO
        (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
           Database.PostgreSQL.Typed.Types.PGTypeName "integer")
        _p_a6QXP,
      Data.String.fromString
        " AND audit_time > CURRENT_TIMESTAMP - interval '1 hour'"])

Perhaps

\ _p_a6QXP ->
  BS.concat
    [Data.String.fromString
       "SELECT count(*) FROM audit.account WHERE audit_action = 'attempt' AND id = ",
     Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a6QXO
       (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
          Database.PostgreSQL.Typed.Types.PGTypeName "integer")
       _p_a6QXP,
     Data.String.fromString
       " AND audit_time > CURRENT_TIMESTAMP - interval '1 hour'"]

src/Model/PermissionUtil.hs:9:1: Warning: Eta reduce
Found

maskRestrictedString s = const (ST.fromString "") s

Perhaps

maskRestrictedString = const (ST.fromString "")

src/Model/PermissionUtil.hs:9:26: Warning: Evaluate
Found

const (ST.fromString "") s

Perhaps

(ST.fromString "")

src/Model/Record.hs:62:10: Warning: Use isJust
Found

maybe False (const True)

Perhaps

Data.Maybe.isJust

src/Model/Tag.hs:65:8: Suggestion: Use uncurry
Found

\ (vid_a6Dpn, vname_a6Dpo) -> Tag vid_a6Dpn vname_a6Dpo

Perhaps

uncurry Tag

Note: increases laziness

src/Model/Tag.hs:354:8: Suggestion: Use uncurry
Found

\ (vid_a6Q1R, vname_a6Q1S) -> Tag vid_a6Q1R vname_a6Q1S

Perhaps

uncurry Tag

Note: increases laziness

src/Model/Token.hs:678:10: Warning: Functor law
Found

fmap (\ mkTok -> mkTok nobodySiteAuth)
  (fmap
     (\ (vtoken_a7EVR, vexpires_a7EVS, vfilename_a7EVT, vsize_a7EVU) ->
        makeUpload (Token vtoken_a7EVR vexpires_a7EVS) vfilename_a7EVT
          vsize_a7EVU)
     rows)

Perhaps

fmap
  ((\ mkTok -> mkTok nobodySiteAuth) .
     (\ (vtoken_a7EVR, vexpires_a7EVS, vfilename_a7EVT, vsize_a7EVU) ->
        makeUpload (Token vtoken_a7EVR vexpires_a7EVS) vfilename_a7EVT
          vsize_a7EVU))
  rows

src/Model/Transcode.hs:65:13: Suggestion: Redundant bracket
Found

\ _p_a9v0p ->
  (BS.concat
     [Data.String.fromString
        "SELECT transcode.segment,transcode.options,transcode.start,transcode.process,transcode.log,party.id,party.name,party.prename,party.orcid,party.affiliation,party.url,account.email,account.password,authorize_view.site,authorize_view.member,asset.id,asset.format,asset.release,asset.duration,asset.name,asset.sha1,asset.size,orig.id,orig.format,orig.release,orig.duration,orig.name,orig.sha1,orig.size,volume.id,volume.name,volume.body,volume.alias,volume.doi,volume_creation(volume.id) FROM transcode JOIN party JOIN account USING (id) LEFT JOIN authorize_view ON account.id = authorize_view.child AND authorize_view.parent = 0 ON transcode.owner = party.id JOIN asset ON transcode.asset = asset.id JOIN asset AS orig ON transcode.orig = orig.id JOIN volume ON asset.volume = volume.id AND orig.volume = volume.id WHERE transcode.asset = ",
      Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a9v0o
        (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
           Database.PostgreSQL.Typed.Types.PGTypeName "integer")
        _p_a9v0p])

Perhaps

\ _p_a9v0p ->
  BS.concat
    [Data.String.fromString
       "SELECT transcode.segment,transcode.options,transcode.start,transcode.process,transcode.log,party.id,party.name,party.prename,party.orcid,party.affiliation,party.url,account.email,account.password,authorize_view.site,authorize_view.member,asset.id,asset.format,asset.release,asset.duration,asset.name,asset.sha1,asset.size,orig.id,orig.format,orig.release,orig.duration,orig.name,orig.sha1,orig.size,volume.id,volume.name,volume.body,volume.alias,volume.doi,volume_creation(volume.id) FROM transcode JOIN party JOIN account USING (id) LEFT JOIN authorize_view ON account.id = authorize_view.child AND authorize_view.parent = 0 ON transcode.owner = party.id JOIN asset ON transcode.asset = asset.id JOIN asset AS orig ON transcode.orig = orig.id JOIN volume ON asset.volume = volume.id AND orig.volume = volume.id WHERE transcode.asset = ",
     Database.PostgreSQL.Typed.Types.pgEscapeParameter _tenv_a9v0o
       (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
          Database.PostgreSQL.Typed.Types.PGTypeName "integer")
       _p_a9v0p]

src/Model/Transcode.hs:953:5: Warning: Functor law
Found

fmap (\ mk -> mk orig)
  (fmap
     (\ (vsegment_a9v8b, voptions_a9v8c, vstart_a9v8d, vprocess_a9v8e,
         vlog_a9v8f, vid_a9v8g, vname_a9v8h, vprename_a9v8i, vorcid_a9v8j,
         vaffiliation_a9v8k, vurl_a9v8l, vemail_a9v8m, vpassword_a9v8n,
         vsite_a9v8o, vmember_a9v8p, vid_a9v8q, vformat_a9v8r,
         vrelease_a9v8s, vduration_a9v8t, vname_a9v8u, vc_a9v8v,
         vsize_a9v8w)
        ->
        makeOrigTranscode
          (($)
             (makeTranscodeRow vsegment_a9v8b voptions_a9v8c vstart_a9v8d
                vprocess_a9v8e
                vlog_a9v8f)
             (Model.Party.SQL.makeSiteAuth
                (Model.Party.SQL.makeUserAccount
                   (Model.Party.SQL.makeAccount
                      (PartyRow vid_a9v8g vname_a9v8h vprename_a9v8i vorcid_a9v8j
                         vaffiliation_a9v8k
                         vurl_a9v8l)
                      (Account vemail_a9v8m)))
                vpassword_a9v8n
                (do cm_a9v8A <- vsite_a9v8o
                    cm_a9v8B <- vmember_a9v8p
                    Just (Model.Permission.Types.Access cm_a9v8A cm_a9v8B))))
          (Model.Asset.SQL.makeAssetRow vid_a9v8q vformat_a9v8r
             vrelease_a9v8s
             vduration_a9v8t
             vname_a9v8u
             vc_a9v8v
             vsize_a9v8w))
     mRow)

Perhaps

fmap
  ((\ mk -> mk orig) .
     (\ (vsegment_a9v8b, voptions_a9v8c, vstart_a9v8d, vprocess_a9v8e,
         vlog_a9v8f, vid_a9v8g, vname_a9v8h, vprename_a9v8i, vorcid_a9v8j,
         vaffiliation_a9v8k, vurl_a9v8l, vemail_a9v8m, vpassword_a9v8n,
         vsite_a9v8o, vmember_a9v8p, vid_a9v8q, vformat_a9v8r,
         vrelease_a9v8s, vduration_a9v8t, vname_a9v8u, vc_a9v8v,
         vsize_a9v8w)
        ->
        makeOrigTranscode
          (($)
             (makeTranscodeRow vsegment_a9v8b voptions_a9v8c vstart_a9v8d
                vprocess_a9v8e
                vlog_a9v8f)
             (Model.Party.SQL.makeSiteAuth
                (Model.Party.SQL.makeUserAccount
                   (Model.Party.SQL.makeAccount
                      (PartyRow vid_a9v8g vname_a9v8h vprename_a9v8i vorcid_a9v8j
                         vaffiliation_a9v8k
                         vurl_a9v8l)
                      (Account vemail_a9v8m)))
                vpassword_a9v8n
                (do cm_a9v8A <- vsite_a9v8o
                    cm_a9v8B <- vmember_a9v8p
                    Just (Model.Permission.Types.Access cm_a9v8A cm_a9v8B))))
          (Model.Asset.SQL.makeAssetRow vid_a9v8q vformat_a9v8r
             vrelease_a9v8s
             vduration_a9v8t
             vname_a9v8u
             vc_a9v8v
             vsize_a9v8w)))
  mRow

src/Model/VolumeMetric.hs:43:6: Warning: Functor law
Found

fmap id

Perhaps

id

src/Model/AssetSegment/Types.hs:55:1: Warning: Eta reduce
Found

newAssetSegment a s e
  = AssetSegment a (assetAssumedSegment a `segmentIntersect` s) e

Perhaps

newAssetSegment a s
  = AssetSegment a (assetAssumedSegment a `segmentIntersect` s)

src/Model/Authorize/SQL.hs:100:46: Error: Parse error
Found

  selectAuthorizeActivity :: TH.Name -- ^@'Identity'@
    -> Selector -- ^ @('Timestamp', 'Party')@
> selectAuthorizeActivity ident = selectJoin '(,)
    [ selectAuditActivity "authorize"
    , joinOn "audit.child = party.id"

src/Model/Funding/FundRef.hs:71:17: Warning: Use sortOn
Found

sortBy (comparing $ Down . T.length)

Perhaps

sortOn (Down . T.length)

src/Model/Identity/Types.hs:1:1: Warning: Unused LANGUAGE pragma
Found

{-# LANGUAGE TemplateHaskell, LambdaCase #-}

Perhaps

{-# LANGUAGE LambdaCase #-}

src/Model/Party/SQL.hs:48:1: Warning: Eta reduce
Found

makeParty pr mMkAcct perm mAccess
  = makeParty2 pr mMkAcct NotLoaded perm mAccess

Perhaps

makeParty pr mMkAcct = makeParty2 pr mMkAcct NotLoaded

src/Model/Volume/SQL.hs:30:1: Warning: Eta reduce
Found

setCreation r mCreate owners rolePolicy
  = Volume r (fromMaybe (volumeCreation blankVolume) mCreate) owners
      rolePolicy

Perhaps

setCreation r mCreate
  = Volume r (fromMaybe (volumeCreation blankVolume) mCreate)

src/Model/Volume/SQL.hs:45:1: Warning: Eta reduce
Found

makeVolume vol own rolePolicy
  = vol
      (maybe []
         (map (parseOwner . fromMaybe (error "NULL volume.owner")))
         own)
      rolePolicy

Perhaps

makeVolume vol own
  = vol
      (maybe []
         (map (parseOwner . fromMaybe (error "NULL volume.owner")))
         own)

src/Model/VolumeAccess/SQL.hs:108:43: Error: Parse error
Found

  selectVolumeActivity :: TH.Name -- ^@'Identity'@
    -> Selector -- ^ @('Timestamp', 'Volume')@
> selectVolumeActivity ident = selectJoin '(,)
    [ selectAuditActivity "volume_access"
    , joinOn "audit.volume = volume.id"

src/Service/DB.hs:82:59: Warning: Redundant bracket
Found

(PGSimple.close)

Perhaps

PGSimple.close

src/Service/Init.hs:41:23: Suggestion: Use let
Found

do time <- getCurrentTime
   logs <- initLogs (conf C.! (if fg then "log" else "log.bg"))
   mailer <- pure initMailer
   entropy <- initEntropy
   passwd <- initPasswd
   messages <- loadMessages
   db <- initDB (conf C.! "db")
   storage <- initStorage_ (conf C.! "store")
   av <- initAV
   web <- initWeb
   httpc <- initHTTPClient
   static <- initStatic (conf C.! "static")
   solr <- initSolr fg (conf C.! "solr")
   ezid <- initEZID (conf C.! "ezid")
   ingest <- initIngest
   notify <- initNotifications (conf C.! "notification")
   stats <- if fg then runDBM db lookupSiteStats else
              return (error "siteStats")
   statsref <- newIORef stats
   let rc
         = Service{serviceStartTime = time,
                   serviceSecret = Secret $ conf C.! "secret",
                   serviceEntropy = entropy, servicePasswd = passwd,
                   serviceLogs = logs, serviceMailer = mailer,
                   serviceMessages = messages, serviceDB = db,
                   serviceStorage = storage, serviceAV = av, serviceWeb = web,
                   serviceHTTPClient = httpc, serviceStatic = static,
                   serviceStats = statsref, serviceIngest = ingest,
                   serviceSolr = solr, serviceEZID = ezid, servicePeriodic = Nothing,
                   serviceNotification = notify, serviceDown = conf C.! "store.DOWN"}
   periodic <- fg `thenReturn` forkPeriodic rc
   when fg $ void $ forkNotifier rc
   return $! rc{servicePeriodic = periodic}

Perhaps

do time <- getCurrentTime
   logs <- initLogs (conf C.! (if fg then "log" else "log.bg"))
   let mailer = initMailer
   entropy <- initEntropy
   passwd <- initPasswd
   messages <- loadMessages
   db <- initDB (conf C.! "db")
   storage <- initStorage_ (conf C.! "store")
   av <- initAV
   web <- initWeb
   httpc <- initHTTPClient
   static <- initStatic (conf C.! "static")
   solr <- initSolr fg (conf C.! "solr")
   ezid <- initEZID (conf C.! "ezid")
   ingest <- initIngest
   notify <- initNotifications (conf C.! "notification")
   stats <- if fg then runDBM db lookupSiteStats else
              return (error "siteStats")
   statsref <- newIORef stats
   let rc
         = Service{serviceStartTime = time,
                   serviceSecret = Secret $ conf C.! "secret",
                   serviceEntropy = entropy, servicePasswd = passwd,
                   serviceLogs = logs, serviceMailer = mailer,
                   serviceMessages = messages, serviceDB = db,
                   serviceStorage = storage, serviceAV = av, serviceWeb = web,
                   serviceHTTPClient = httpc, serviceStatic = static,
                   serviceStats = statsref, serviceIngest = ingest,
                   serviceSolr = solr, serviceEZID = ezid, servicePeriodic = Nothing,
                   serviceNotification = notify, serviceDown = conf C.! "store.DOWN"}
   periodic <- fg `thenReturn` forkPeriodic rc
   when fg $ void $ forkNotifier rc
   return $! rc{servicePeriodic = periodic}

src/Service/Mail.hs:56:1: Suggestion: Use newtype instead of data
Found

data Mailer = Mailer{mlr ::
                     MailHost -> MailPort -> MailUser -> MailPass -> Mail -> IO ()}

Perhaps

newtype Mailer = Mailer{mlr ::
                        MailHost -> MailPort -> MailUser -> MailPass -> Mail -> IO ()}

Note: decreases laziness

src/View/Form.hs:59:22: Suggestion: Redundant bracket
Found

(BS.null b) `unlessUse` b

Perhaps

BS.null b `unlessUse` b

src/View/Form.hs:124:11: Warning: Use elem
Found

any (v ==)

Perhaps

elem v

src/View/Notification.hs:248:3: Warning: Eta reduce
Found

link u a q h
  = H.a H.! actionLink u a (map (second Just) q :: Query) $ h

Perhaps

link u a q = H.a H.! actionLink u a (map (second Just) q :: Query)

src/Web/All.hs:42:1: Warning: Redundant lambda
Found

generateAllJS
  = \ f ->
      do let debugOn = True
         deps <- liftIO $ webDeps debugOn
         appMinJs <- liftIO $ makeWebFilePath "app.min.js"
         generateMerged (deps ++ [appMinJs]) f

Perhaps

generateAllJS f
  = do let debugOn = True
       deps <- liftIO $ webDeps debugOn
       appMinJs <- liftIO $ makeWebFilePath "app.min.js"
       generateMerged (deps ++ [appMinJs]) f

src/Web/All.hs:49:1: Warning: Redundant lambda
Found

generateAllCSS
  = \ f ->
      do css <- liftIO $ cssWebDeps False
         generateMerged css f

Perhaps

generateAllCSS f
  = do css <- liftIO $ cssWebDeps False
       generateMerged css f

src/Web/Files.hs:40:28: Suggestion: Use <=<
Found

\ webDirRaw -> mapM makeWebFilePath =<< listFiles webDirRaw

Perhaps

(mapM makeWebFilePath Control.Monad.<=< listFiles)

src/Web/GZip.hs:21:6: Suggestion: Use /=
Found

takeExtension b' `notElem` [".png"]

Perhaps

(takeExtension b' /= ".png")

src/Web/Generate.hs:64:1: Warning: Redundant lambda
Found

staticWebGenerate g
  = \ (w, _) ->
      liftIO $
        do tempFile <- do f <- unRawFilePath $ webFileAbs w
                          let (d, n) = splitFileName f
                          rawFilePath $ d FP.</> ('.' : n)
           g =<< unRawFilePath tempFile
           c <- catchDoesNotExist $ compareFiles (webFileAbs w) tempFile
           if or c then False <$ removeLink tempFile else
             True <$ rename tempFile (webFileAbs w)

Perhaps

staticWebGenerate g (w, _)
  = liftIO $
      do tempFile <- do f <- unRawFilePath $ webFileAbs w
                        let (d, n) = splitFileName f
                        rawFilePath $ d FP.</> ('.' : n)
         g =<< unRawFilePath tempFile
         c <- catchDoesNotExist $ compareFiles (webFileAbs w) tempFile
         if or c then False <$ removeLink tempFile else
           True <$ rename tempFile (webFileAbs w)

src/Web/Generate.hs:76:1: Warning: Redundant lambda
Found

webLinkDataFile s
  = \ fo@(f, _) ->
      do wf <- liftIO $
                 rawFilePath =<< canonicalizePath =<< getDataFileName s
         webRegenerate
           (do r <- removeFile (webFileAbs f)
               f' <- unRawFilePath $ webFileAbs f
               unless r $ createDirectoryIfMissing False $ takeDirectory f'
               createSymbolicLink wf (webFileAbs f))
           [wf]
           []
           fo

Perhaps

webLinkDataFile s fo@(f, _)
  = do wf <- liftIO $
               rawFilePath =<< canonicalizePath =<< getDataFileName s
       webRegenerate
         (do r <- removeFile (webFileAbs f)
             f' <- unRawFilePath $ webFileAbs f
             unless r $ createDirectoryIfMissing False $ takeDirectory f'
             createSymbolicLink wf (webFileAbs f))
         [wf]
         []
         fo

src/Web/JSHint.hs:21:1: Suggestion: Redundant where
Found

checkJSHint
  = \ fo@(f, _) ->
      do relPath <- liftIO $ unRawFilePath $ webFileRel f
         absPath <- liftIO $ unRawFilePath $ webFileAbs f
         let (d, n) = splitFileName $ webFileAbs f
             h = d </> ('.' `BSC.cons` n `addExtension` ".hinted")
         if takeExtensions relPath == ".js" then
           do r <- fileNewer (webFileAbs f) fo
              when r $
                liftIO $
                  do ht <- fmap snd <$> fileInfo h
                     ft <- modificationTimestamp <$> getFileStatus (webFileAbs f)
                     when (all (ft >) ht) $
                       do callProcess "jshint" [absPath]
                          maybe (openFd h WriteOnly (Just 438) defaultFileFlags >>= closeFd)
                            (\ _ -> setFileTimestamps h ft ft)
                            ht
              return r
           else mzero
  where

Perhaps

checkJSHint
  = \ fo@(f, _) ->
      do relPath <- liftIO $ unRawFilePath $ webFileRel f
         absPath <- liftIO $ unRawFilePath $ webFileAbs f
         let (d, n) = splitFileName $ webFileAbs f
             h = d </> ('.' `BSC.cons` n `addExtension` ".hinted")
         if takeExtensions relPath == ".js" then
           do r <- fileNewer (webFileAbs f) fo
              when r $
                liftIO $
                  do ht <- fmap snd <$> fileInfo h
                     ft <- modificationTimestamp <$> getFileStatus (webFileAbs f)
                     when (all (ft >) ht) $
                       do callProcess "jshint" [absPath]
                          maybe (openFd h WriteOnly (Just 438) defaultFileFlags >>= closeFd)
                            (\ _ -> setFileTimestamps h ft ft)
                            ht
              return r
           else mzero

src/Web/Libs.hs:34:3: Suggestion: Use :
Found

[("jquery-ui", "jquery-ui-dist")] ++
  [("slider", "angular-ui-slider/src")]

Perhaps

("jquery-ui", "jquery-ui-dist") :
  [("slider", "angular-ui-slider/src")]

src/Web/Libs.hs:42:1: Warning: Redundant lambda
Found

generateLib
  = \ fo@(f, _) ->
      do fp <- liftIO $ unRawFilePath $ webFileRel f
         let (libDir, l) = splitFileName fp
             nodeDir
               = case
                   [p | (b, p) <- jsAll, ('.' : e) <- maybeToList (stripPrefix b l),
                    e `elem` extensions]
                   of
                     [a] -> Just a
                     _ -> Nothing
         case (libDir, nodeDir) of
             ("lib/", Just p) -> webLinkDataFile (prefix </> p </> l) fo
             _ -> mzero

Perhaps

generateLib fo@(f, _)
  = do fp <- liftIO $ unRawFilePath $ webFileRel f
       let (libDir, l) = splitFileName fp
           nodeDir
             = case
                 [p | (b, p) <- jsAll, ('.' : e) <- maybeToList (stripPrefix b l),
                  e `elem` extensions]
                 of
                   [a] -> Just a
                   _ -> Nothing
       case (libDir, nodeDir) of
           ("lib/", Just p) -> webLinkDataFile (prefix </> p </> l) fo
           _ -> mzero

src/Web/Libs.hs:77:26: Suggestion: Use <=<
Found

\ f -> makeWebFilePath =<< rawFilePath f

Perhaps

makeWebFilePath Control.Monad.<=< rawFilePath

src/Web/Messages.hs:19:1: Warning: Redundant lambda
Found

generateMessagesJS
  = \ fo@(f, _) ->
      do mf <- liftIO messagesFile
         mfRawFilePath <- liftIO $ rawFilePath mf
         fp <- liftIO $ unRawFilePath $ webFileAbs f
         webRegenerate
           (do msg <- liftIO $ loadMessagesFrom mf
               withBinaryFile fp WriteMode $
                 \ h ->
                   do hPutStr h "app.constant('messageData',"
                      BSB.hPutBuilder h $
                        JSON.fromEncoding $ JSON.value $ JSON.toJSON msg
                      hPutStr h ");")
           [mfRawFilePath]
           []
           fo

Perhaps

generateMessagesJS fo@(f, _)
  = do mf <- liftIO messagesFile
       mfRawFilePath <- liftIO $ rawFilePath mf
       fp <- liftIO $ unRawFilePath $ webFileAbs f
       webRegenerate
         (do msg <- liftIO $ loadMessagesFrom mf
             withBinaryFile fp WriteMode $
               \ h ->
                 do hPutStr h "app.constant('messageData',"
                    BSB.hPutBuilder h $
                      JSON.fromEncoding $ JSON.value $ JSON.toJSON msg
                    hPutStr h ");")
         [mfRawFilePath]
         []
         fo

src/Web/Rules.hs:58:1: Warning: Redundant lambda
Found

generateFixed includeStatic
  = \ fo@(f, _) ->
      case
        lookup (webFileRel f) $
          (if includeStatic then (staticGenerators ++) else id)
            fixedGenerators
        of
          Just g -> g fo
          _ -> mzero

Perhaps

generateFixed includeStatic fo@(f, _)
  = case
      lookup (webFileRel f) $
        (if includeStatic then (staticGenerators ++) else id)
          fixedGenerators
      of
        Just g -> g fo
        _ -> mzero

src/Web/Rules.hs:100:11: Suggestion: Redundant bracket
Found

[(map fst staticGenerators),
 ["constants.json.gz", "all.min.js.gz", "all.min.css.gz"],
 map ((RF.<.> ".gz") . webFileRel) svg]

Perhaps

[map fst staticGenerators,
 ["constants.json.gz", "all.min.js.gz", "all.min.css.gz"],
 map ((RF.<.> ".gz") . webFileRel) svg]

src/Web/Service.hs:28:14: Suggestion: Redundant bracket
Found

(TE.encodeUtf8 . T.strip) <$> TIO.readFile versionFilePath

Perhaps

TE.encodeUtf8 . T.strip <$> TIO.readFile versionFilePath

src/Web/Service.hs:36:1: Warning: Eta reduce
Found

getWebVersion web = webVersion web

Perhaps

getWebVersion = webVersion

src/Web/Stylus.hs:17:1: Warning: Redundant lambda
Found

generateStylusCSS
  = \ fo@(f, _) ->
      do let src = "app.styl"
         sl <- liftIO $ findWebFiles ".styl"
         fpRel <- liftIO $ unRawFilePath $ webFileRel f
         fpAbs <- liftIO $ unRawFilePath $ webFileAbs f
         srcAbs <- liftIO $
                     (unRawFilePath . webFileAbs) =<<
                       makeWebFilePath =<< rawFilePath src
         webRegenerate
           (callProcess "stylus" $
              (if takeExtensions fpRel == ".min.css" then ("-c" :) else id)
                ["-u", "nib", "-u", "autoprefixer-stylus", "-o", fpAbs, srcAbs])
           []
           sl
           fo

Perhaps

generateStylusCSS fo@(f, _)
  = do let src = "app.styl"
       sl <- liftIO $ findWebFiles ".styl"
       fpRel <- liftIO $ unRawFilePath $ webFileRel f
       fpAbs <- liftIO $ unRawFilePath $ webFileAbs f
       srcAbs <- liftIO $
                   (unRawFilePath . webFileAbs) =<<
                     makeWebFilePath =<< rawFilePath src
       webRegenerate
         (callProcess "stylus" $
            (if takeExtensions fpRel == ".min.css" then ("-c" :) else id)
              ["-u", "nib", "-u", "autoprefixer-stylus", "-o", fpAbs, srcAbs])
         []
         sl
         fo

src/Web/Uglify.hs:25:36: Suggestion: Use infix
Found

isPrefixOf "lib/" (webFileRel f)

Perhaps

"lib/" `isPrefixOf` webFileRel f

src/Web/Uglify.hs:33:1: Warning: Redundant lambda
Found

generateUglifyJS
  = \ fileToGenInfo@(fileToGen, _) ->
      do inputFiles <- liftIO appWebJS
         guard (not $ null inputFiles)
         inputFilesAbs <- mapM ((liftIO . unRawFilePath) . webFileAbs)
                            inputFiles
         fileToGenAbs <- liftIO $ unRawFilePath $ webFileAbs fileToGen
         let fileToGenMap = webFileAbs fileToGen RF.<.> ".map"
         fileToGenMapAbs <- liftIO $ unRawFilePath fileToGenMap
         webRegenerate
           (do print "making minified with command..."
               print
                 ("uglifyjs",
                  ["--output", fileToGenAbs, "--source-map", fileToGenMapAbs,
                   "--prefix", "relative", "--screw-ie8", "--mangle", "--compress",
                   "--define", "DEBUG=false", "--wrap", "app"]
                    ++ inputFilesAbs)
               callProcess "uglifyjs" $
                 ["--output", fileToGenAbs, "--source-map", fileToGenMapAbs,
                  "--prefix", "relative", "--screw-ie8", "--mangle", "--compress",
                  "--define", "DEBUG=false", "--wrap", "app"]
                   ++ inputFilesAbs)
           []
           inputFiles
           fileToGenInfo

Perhaps

generateUglifyJS fileToGenInfo@(fileToGen, _)
  = do inputFiles <- liftIO appWebJS
       guard (not $ null inputFiles)
       inputFilesAbs <- mapM ((liftIO . unRawFilePath) . webFileAbs)
                          inputFiles
       fileToGenAbs <- liftIO $ unRawFilePath $ webFileAbs fileToGen
       let fileToGenMap = webFileAbs fileToGen RF.<.> ".map"
       fileToGenMapAbs <- liftIO $ unRawFilePath fileToGenMap
       webRegenerate
         (do print "making minified with command..."
             print
               ("uglifyjs",
                ["--output", fileToGenAbs, "--source-map", fileToGenMapAbs,
                 "--prefix", "relative", "--screw-ie8", "--mangle", "--compress",
                 "--define", "DEBUG=false", "--wrap", "app"]
                  ++ inputFilesAbs)
             callProcess "uglifyjs" $
               ["--output", fileToGenAbs, "--source-map", fileToGenMapAbs,
                "--prefix", "relative", "--screw-ie8", "--mangle", "--compress",
                "--define", "DEBUG=false", "--wrap", "app"]
                 ++ inputFilesAbs)
         []
         inputFiles
         fileToGenInfo