style: Fourmolu 0.5.0 formatting changes.

No functional changes here, this is pure formatting.

primer-selda/src/Primer/Database/Selda.hs

@@ -60,23 +60,23 @@ import Primer.Database (
 -- consisting of the session's 'App', the git version of Primer that
 -- last updated it, and the session's name.
 data SessionRow = SessionRow
-  { -- | The session's UUID.
-    uuid :: UUID
-  , -- | Primer's git version. We would prefer that this were a git
-    -- rev, but for technical reasons, it may also be a last-modified
-    -- date.
-    gitversion :: Version
-  , -- | The session's 'App'. Note that the 'App' is serialized to
-    -- JSON before being stored as a bytestring in the database.
-    app :: BL.ByteString
-  , -- | The session's name.
-    --
-    -- This should be of type 'SessionName', but Selda doesn't make it
-    -- particularly easy to derive @SqlType@ from a newtype wrapper
-    -- around 'Text', so rather than copy-pasting the 'Text' instance,
-    -- we just convert back to 'Text' before serializing to the
-    -- database.
-    name :: Text
+  { uuid :: UUID
+  -- ^ The session's UUID.
+  , gitversion :: Version
+  -- ^ Primer's git version. We would prefer that this were a git
+  -- rev, but for technical reasons, it may also be a last-modified
+  -- date.
+  , app :: BL.ByteString
+  -- ^ The session's 'App'. Note that the 'App' is serialized to
+  -- JSON before being stored as a bytestring in the database.
+  , name :: Text
+  -- ^ The session's name.
+  --
+  -- This should be of type 'SessionName', but Selda doesn't make it
+  -- particularly easy to derive @SqlType@ from a newtype wrapper
+  -- around 'Text', so rather than copy-pasting the 'Text' instance,
+  -- we just convert back to 'Text' before serializing to the
+  -- database.
   }
   deriving (Generic)
 

primer-service/src/Primer/Pagination.hs

@@ -81,10 +81,10 @@ type PP api =
     :> api
 
 data Pagination = Pagination
-  { -- | Defaults to @1@ if not given in the query parameters
-    page :: Positive
-  , -- | Does not default, since there is no default that would work for all cases
-    size :: Maybe Positive
+  { page :: Positive
+  -- ^ Defaults to @1@ if not given in the query parameters
+  , size :: Maybe Positive
+  -- ^ Does not default, since there is no default that would work for all cases
   }
 
 instance

primer/src/Primer/API.hs

@@ -297,12 +297,12 @@ instance ToJSON Tree
 data Prog = Prog
   { types :: [Name]
   , -- We don't use Map ID Def, as the JSON encoding would be as an object,
-    -- where keys are IDs converted to strings and we have no nice way of
-    -- saying "all the keys of this object should parse as numbers". Similarly,
-    -- it is rather redundant as each Def carries a defID field (which is
-    -- encoded as a number), and it is difficult to enforce that "the keys of
-    -- this object match the defID field of the corresponding value".
-    defs :: [Def]
+  -- where keys are IDs converted to strings and we have no nice way of
+  -- saying "all the keys of this object should parse as numbers". Similarly,
+  -- it is rather redundant as each Def carries a defID field (which is
+  -- encoded as a number), and it is difficult to enforce that "the keys of
+  -- this object match the defID field of the corresponding value".
+  defs :: [Def]
   }
   deriving (Generic)
 

primer/src/Primer/Action.hs

@@ -135,8 +135,8 @@ data OfferedAction a = OfferedAction
   , description :: Text
   , input :: ActionInput a
   , priority :: Int
-  , -- | Used primarily for display purposes.
-    actionType :: ActionType
+  , actionType :: ActionType
+  -- ^ Used primarily for display purposes.
   }
   deriving (Functor)
 
@@ -599,7 +599,7 @@ moveExpr m@(Branch c) z | Case _ _ brs <- target z =
 moveExpr m@(Branch _) _ = throwError $ CustomFailure (Move m) "Move-to-branch failed: this is not a case expression"
 moveExpr Child2 z
   | Case{} <- target z =
-    throwError $ CustomFailure (Move Child2) "cannot move to 'Child2' of a case: use Branch instead"
+      throwError $ CustomFailure (Move Child2) "cannot move to 'Child2' of a case: use Branch instead"
 moveExpr m z = move m z
 
 -- | Apply a movement to a zipper
@@ -914,11 +914,11 @@ renameLam y ze = case target ze of
   Lam m x e
     | unName x == y -> pure ze
     | otherwise -> do
-      let y' = unsafeMkName y
-      case renameVar x y' e of
-        Just e' -> pure $ replace (Lam m y' e') ze
-        Nothing ->
-          throwError NameCapture
+        let y' = unsafeMkName y
+        case renameVar x y' e of
+          Just e' -> pure $ replace (Lam m y' e') ze
+          Nothing ->
+            throwError NameCapture
   _ ->
     throwError $ CustomFailure (RenameLam y) "the focused expression is not a lambda"
 
@@ -928,11 +928,11 @@ renameLAM b ze = case target ze of
   LAM m a e
     | unName a == b -> pure ze
     | otherwise -> do
-      let b' = unsafeMkName b
-      case renameTyVarExpr a b' e of
-        Just e' -> pure $ replace (LAM m b' e') ze
-        Nothing ->
-          throwError NameCapture
+        let b' = unsafeMkName b
+        case renameTyVarExpr a b' e of
+          Just e' -> pure $ replace (LAM m b' e') ze
+          Nothing ->
+            throwError NameCapture
   _ ->
     throwError $ CustomFailure (RenameLAM b) "the focused expression is not a type abstraction"
 
@@ -942,15 +942,15 @@ renameLet y ze = case target ze of
   Let m x e1 e2
     | unName x == y -> pure ze
     | otherwise -> do
-      let y' = unsafeMkName y
-      (e1', e2') <- doRename x y' e1 e2
-      pure $ replace (Let m y' e1' e2') ze
+        let y' = unsafeMkName y
+        (e1', e2') <- doRename x y' e1 e2
+        pure $ replace (Let m y' e1' e2') ze
   Letrec m x e1 t1 e2
     | unName x == y -> pure ze
     | otherwise -> do
-      let y' = unsafeMkName y
-      (e1', e2') <- doRename x y' e1 e2
-      pure $ replace (Letrec m y' e1' t1 e2') ze
+        let y' = unsafeMkName y
+        (e1', e2') <- doRename x y' e1 e2
+        pure $ replace (Letrec m y' e1' t1 e2') ze
   _ ->
     throwError $ CustomFailure (RenameLet y) "the focused expression is not a let"
   where
@@ -1028,10 +1028,10 @@ renameForall b zt = case target zt of
   TForall m a k t
     | unName a == b -> pure zt
     | otherwise -> do
-      let b' = unsafeMkName b
-      case renameTyVar a b' t of
-        Just t' -> pure $ replace (TForall m b' k t') zt
-        Nothing ->
-          throwError NameCapture
+        let b' = unsafeMkName b
+        case renameTyVar a b' t of
+          Just t' -> pure $ replace (TForall m b' k t') zt
+          Nothing ->
+            throwError NameCapture
   _ ->
     throwError $ CustomFailure (RenameForall b) "the focused expression is not a forall type"

primer/src/Primer/Action/Available.hs

@@ -209,25 +209,25 @@ findNodeWithParent id x = go x Nothing
     go expr parent
       | expr ^. _exprMetaLens % _id == id = Just (ExprNode expr, parent)
       | otherwise = case expr of
-        Hole _ e -> go e (Just (ExprNode expr))
-        EmptyHole _ -> Nothing
-        Ann _ e t -> go e (Just (ExprNode expr)) <|> goTy t expr
-        App _ a b -> go a (Just (ExprNode expr)) <|> go b (Just (ExprNode expr))
-        APP _ a b -> go a (Just (ExprNode expr)) <|> goTy b expr
-        Con _ _ -> Nothing
-        Lam _ _ e -> go e (Just (ExprNode expr))
-        LAM _ _ e -> go e (Just (ExprNode expr))
-        Var _ _ -> Nothing
-        GlobalVar _ _ -> Nothing
-        Let _ _ a b -> go a (Just (ExprNode expr)) <|> go b (Just (ExprNode expr))
-        Letrec _ _ a ta b -> go a (Just (ExprNode expr)) <|> goTy ta expr <|> go b (Just (ExprNode expr))
-        LetType _ _ t e -> goTy t expr <|> go e (Just (ExprNode expr))
-        Case _ e branches ->
-          let (Alt inBranches) = flip foldMap branches $
-                \(CaseBranch _ binds rhs) ->
-                  Alt (go rhs (Just (ExprNode expr)))
-                    <> foldMap (Alt . map (\b -> (CaseBindNode b, Just (ExprNode expr))) . findBind id) binds
-           in go e (Just (ExprNode expr)) <|> inBranches
+          Hole _ e -> go e (Just (ExprNode expr))
+          EmptyHole _ -> Nothing
+          Ann _ e t -> go e (Just (ExprNode expr)) <|> goTy t expr
+          App _ a b -> go a (Just (ExprNode expr)) <|> go b (Just (ExprNode expr))
+          APP _ a b -> go a (Just (ExprNode expr)) <|> goTy b expr
+          Con _ _ -> Nothing
+          Lam _ _ e -> go e (Just (ExprNode expr))
+          LAM _ _ e -> go e (Just (ExprNode expr))
+          Var _ _ -> Nothing
+          GlobalVar _ _ -> Nothing
+          Let _ _ a b -> go a (Just (ExprNode expr)) <|> go b (Just (ExprNode expr))
+          Letrec _ _ a ta b -> go a (Just (ExprNode expr)) <|> goTy ta expr <|> go b (Just (ExprNode expr))
+          LetType _ _ t e -> goTy t expr <|> go e (Just (ExprNode expr))
+          Case _ e branches ->
+            let (Alt inBranches) = flip foldMap branches $
+                  \(CaseBranch _ binds rhs) ->
+                    Alt (go rhs (Just (ExprNode expr)))
+                      <> foldMap (Alt . map (\b -> (CaseBindNode b, Just (ExprNode expr))) . findBind id) binds
+             in go e (Just (ExprNode expr)) <|> inBranches
 
     goTy t p = case findTypeWithParent id t of
       Nothing -> Nothing
@@ -239,13 +239,13 @@ findType :: forall b. ID -> Type' (Meta b) -> Maybe (Type' (Meta b))
 findType id ty
   | ty ^. _typeMetaLens % _id == id = Just ty
   | otherwise = case ty of
-    TEmptyHole _ -> Nothing
-    THole _ t -> findType id t
-    TCon _ _ -> Nothing
-    TVar _ _ -> Nothing
-    TFun _ a b -> findType id a <|> findType id b
-    TApp _ a b -> findType id a <|> findType id b
-    TForall _ _ _ t -> findType id t
+      TEmptyHole _ -> Nothing
+      THole _ t -> findType id t
+      TCon _ _ -> Nothing
+      TVar _ _ -> Nothing
+      TFun _ a b -> findType id a <|> findType id b
+      TApp _ a b -> findType id a <|> findType id b
+      TForall _ _ _ t -> findType id t
 
 -- | Find a sub-type in a larger type by its ID. Also returning its parent
 findTypeWithParent :: forall b. ID -> Type' (Meta b) -> Maybe (Type' (Meta b), Maybe (Type' (Meta b)))
@@ -254,13 +254,13 @@ findTypeWithParent id x = go x Nothing
     go ty parent
       | ty ^. _typeMetaLens % _id == id = Just (ty, parent)
       | otherwise = case ty of
-        TEmptyHole _ -> Nothing
-        THole _ t -> go t (Just ty)
-        TCon _ _ -> Nothing
-        TVar _ _ -> Nothing
-        TFun _ a b -> go a (Just ty) <|> go b (Just ty)
-        TApp _ a b -> go a (Just ty) <|> go b (Just ty)
-        TForall _ _ _ t -> go t (Just ty)
+          TEmptyHole _ -> Nothing
+          THole _ t -> go t (Just ty)
+          TCon _ _ -> Nothing
+          TVar _ _ -> Nothing
+          TFun _ a b -> go a (Just ty) <|> go b (Just ty)
+          TApp _ a b -> go a (Just ty) <|> go b (Just ty)
+          TForall _ _ _ t -> go t (Just ty)
 
 -- | If the given binding has the given ID, return Just that binding, otherwise return nothing.
 -- This is just a helper for 'findNode'.

primer/src/Primer/App.hs

@@ -333,15 +333,15 @@ applyProgAction prog mdefID = \case
     Just _ -> pure (prog, Just id_)
   DeleteDef id_
     | Map.member id_ (progDefs prog) -> do
-      let defs = Map.delete id_ (progDefs prog)
-          prog' = prog{progDefs = defs, progSelection = Nothing}
-      -- Run a full TC solely to ensure that no references to the removed id
-      -- remain. This is rather inefficient and could be improved in the
-      -- future.
-      runExceptT (checkEverything @TypeError NoSmartHoles (progTypes prog) (progDefs prog')) >>= \case
-        Left _ -> throwError $ DefInUse id_
-        Right _ -> pure ()
-      pure (prog', Nothing)
+        let defs = Map.delete id_ (progDefs prog)
+            prog' = prog{progDefs = defs, progSelection = Nothing}
+        -- Run a full TC solely to ensure that no references to the removed id
+        -- remain. This is rather inefficient and could be improved in the
+        -- future.
+        runExceptT (checkEverything @TypeError NoSmartHoles (progTypes prog) (progDefs prog')) >>= \case
+          Left _ -> throwError $ DefInUse id_
+          Right _ -> pure ()
+        pure (prog', Nothing)
   DeleteDef id_ -> throwError $ DefNotFound id_
   RenameDef id_ nameStr -> case Map.lookup id_ (progDefs prog) of
     Nothing -> throwError $ DefNotFound id_
@@ -634,7 +634,7 @@ copyPasteSig p (fromDefId, fromTyId) toDefId setup = do
     Left err -> throwError $ ActionError err
     Right (_, _, tgt) -> pure $ focusOnlyType tgt
   let sharedScope =
-        if fromDefId == toDefId --optimization only
+        if fromDefId == toDefId -- optimization only
           then getSharedScopeTy c $ Right tgt
           else mempty
   -- Delete unbound vars
@@ -762,7 +762,7 @@ copyPasteBody p (fromDefId, fromId) toDefId setup = do
     (Right _, InExpr _) -> throwError $ CopyPasteError "tried to paste a type into an expression"
     (Right srcT, InType tgtT) -> do
       let sharedScope =
-            if fromDefId == toDefId --optimization only
+            if fromDefId == toDefId -- optimization only
               then getSharedScopeTy srcT $ Left tgtT
               else mempty
       -- Delete unbound vars. TODO: we may want to let-bind them?
@@ -781,7 +781,7 @@ copyPasteBody p (fromDefId, fromId) toDefId setup = do
       tcWholeProg finalProg
     (Left srcE, InExpr tgtE) -> do
       let sharedScope =
-            if fromDefId == toDefId --optimization only
+            if fromDefId == toDefId -- optimization only
               then getSharedScope srcE tgtE
               else mempty
       -- Delete unbound vars. TODO: we may want to let-bind them?

primer/src/Primer/Core.hs

@@ -100,7 +100,7 @@ data TypeCacheBoth = TCBoth {tcChkedAt :: Type' (), tcSynthed :: Type' ()}
   deriving (Eq, Show, Generic, Data)
   deriving (FromJSON, ToJSON) via VJSON TypeCacheBoth
 
---TODO `_chkedAt` and `_synthed` should be `AffineTraversal`s,
+-- TODO `_chkedAt` and `_synthed` should be `AffineTraversal`s,
 -- but there is currently no `failing` for AffineTraversals, only for AffineFolds (`afailing`).
 -- See https://github.com/well-typed/optics/pull/393
 

primer/src/Primer/Database.hs

@@ -132,10 +132,10 @@ data Session = Session {id :: SessionId, name :: SessionName}
 
 -- | Per-session information.
 data SessionData = SessionData
-  { -- | The session's 'App'.
-    sessionApp :: App
-  , -- | The session's name.
-    sessionName :: SessionName
+  { sessionApp :: App
+  -- ^ The session's 'App'.
+  , sessionName :: SessionName
+  -- ^ The session's name.
   }
   deriving (Generic)
 
@@ -176,10 +176,10 @@ data Op
 
 -- | A config for the 'serve' computation.
 data ServiceCfg = ServiceCfg
-  { -- | The database operation queue.
-    opQueue :: TBQueue Op
-  , -- | The running version of Primer.
-    version :: Version
+  { opQueue :: TBQueue Op
+  -- ^ The database operation queue.
+  , version :: Version
+  -- ^ The running version of Primer.
   }
 
 -- | A 'Page' is a portion of the results of some DB query, along with the