pb/style

.github/workflows/restyled.yml

@@ -0,0 +1,22 @@
+name: Restyled
+
+on:
+  pull_request:
+
+concurrency:
+  group: ${{ github.workflow }}-${{ github.ref }}
+  cancel-in-progress: true
+
+permissions:
+  contents: read
+  pull-requests: write
+
+jobs:
+  restyled:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+      - uses: restyled-io/actions/setup@v4
+      - uses: restyled-io/actions/run@v4
+        with:
+          suggestions: true

.restyled.yaml

@@ -4,7 +4,7 @@ restylers:
       enabled: false
   - fourmolu:
       image:
-        tag: v0.14.1.0
+        tag: v0.17.0.0
   - stylish-haskell:
       enabled: false
   - prettier-markdown:

app/Main.hs

@@ -11,8 +11,8 @@ main :: IO ()
 main =
   runSubcommand
     $ subcommand Commands.cat
-    <> subcommand Commands.capture
-    <> subcommand Commands.changes
-    <> subcommand Commands.deploy
-    <> subcommand Commands.list
-    <> subcommand Commands.version
+      <> subcommand Commands.capture
+      <> subcommand Commands.changes
+      <> subcommand Commands.deploy
+      <> subcommand Commands.list
+      <> subcommand Commands.version

fourmolu.yaml

@@ -1,15 +1,30 @@
 indentation: 2
-column-limit: 80 # ignored until v12 / ghc-9.6
+column-limit: 80 # needs v0.12
 function-arrows: leading
 comma-style: leading # default
 import-export-style: leading
+import-grouping: # needs v0.17
+  - name: "Preludes"
+    rules:
+      - glob: Prelude
+      - glob: "**.Prelude"
+      - glob: RIO
+      - glob: Stackctl.Test.App
+  - name: "Everything else"
+    rules:
+      - match: all
+        priority: 100
 indent-wheres: false # default
 record-brace-space: true
 newlines-between-decls: 1 # default
 haddock-style: single-line
 let-style: mixed
 in-style: left-align
-single-constraint-parens: never # ignored until v12 / ghc-9.6
+single-constraint-parens: never # needs v0.12
+sort-constraints: false # default
+sort-derived-classes: false # default
+sort-derived-clauses: false # default
+trailing-section-operators: false # needs v0.17
 unicode: never # default
 respectful: true # default
 

src/Stackctl/AWS/CloudFormation.hs

@@ -194,7 +194,7 @@ awsCloudFormationDescribeStackMaybe stackName =
   handling_ _ValidationError (pure Nothing)
     $ awsSilently -- don't log said 400
     $ Just
-    <$> awsCloudFormationDescribeStack stackName
+      <$> awsCloudFormationDescribeStack stackName
 
 awsCloudFormationDescribeStackOutputs
   :: (MonadIO m, MonadAWS m)
@@ -218,10 +218,10 @@ awsCloudFormationDescribeStackEvents stackName mLastId = do
 
   runConduit
     $ AWS.paginate req
-    .| mapC (fromMaybe [] . (^. describeStackEventsResponse_stackEvents))
-    .| concatC
-    .| takeWhileC (\e -> Just (e ^. stackEvent_eventId) /= mLastId)
-    .| sinkList
+      .| mapC (fromMaybe [] . (^. describeStackEventsResponse_stackEvents))
+      .| concatC
+      .| takeWhileC (\e -> Just (e ^. stackEvent_eventId) /= mLastId)
+      .| sinkList
 
 awsCloudFormationGetStackNamesMatching
   :: (MonadIO m, MonadAWS m)
@@ -232,12 +232,12 @@ awsCloudFormationGetStackNamesMatching p = do
 
   runConduit
     $ AWS.paginate req
-    .| concatMapC (^. listStacksResponse_stackSummaries)
-    .| concatC
-    .| mapC (^. stackSummary_stackName)
-    .| filterC ((p `match`) . unpack)
-    .| mapC StackName
-    .| sinkList
+      .| concatMapC (^. listStacksResponse_stackSummaries)
+      .| concatC
+      .| mapC (^. stackSummary_stackName)
+      .| filterC ((p `match`) . unpack)
+      .| mapC StackName
+      .| sinkList
 
 awsCloudFormationGetMostRecentStackEventId
   :: (MonadIO m, MonadAWS m)
@@ -258,9 +258,9 @@ awsCloudFormationGetMostRecentStackEventId stackName = do
 
   AWS.simple req
     $ pure
-    . getFirstEventId
-    . fromMaybe []
-    . (^. describeStackEventsResponse_stackEvents)
+      . getFirstEventId
+      . fromMaybe []
+      . (^. describeStackEventsResponse_stackEvents)
 
 awsCloudFormationDeleteStack
   :: (MonadIO m, MonadLogger m, MonadAWS m)
@@ -314,7 +314,7 @@ awaitStack
 awaitStack waiter stackName =
   AWS.await waiter
     $ newDescribeStacks
-    & describeStacks_stackName ?~ unStackName stackName
+      & describeStacks_stackName ?~ unStackName stackName
 
 makeParameter :: Text -> Maybe Text -> Parameter
 makeParameter k v =
@@ -424,7 +424,7 @@ awsCloudFormationCreateChangeSet stackName mStackDescription stackTemplate param
 
       logInfo
         $ "Creating changeset..."
-        :# ["name" .= name, "type" .= changeSetType]
+          :# ["name" .= name, "type" .= changeSetType]
       csId <- AWS.simple req (^. createChangeSetResponse_id)
 
       logDebug "Awaiting CREATE_COMPLETE"
@@ -471,16 +471,16 @@ awsCloudFormationDeleteAllChangeSets stackName = do
   logInfo "Deleting all changesets"
   runConduit
     $ AWS.paginate (newListChangeSets $ unStackName stackName)
-    .| concatMapC
-      ( \resp -> fromMaybe [] $ do
-          ss <- resp ^. listChangeSetsResponse_summaries
-          pure $ mapMaybe Summary.changeSetId ss
-      )
-    .| mapM_C
-      ( \csId -> do
-          logInfo $ "Enqueing delete" :# ["changeSetId" .= csId]
-          void $ AWS.send $ newDeleteChangeSet csId
-      )
+      .| concatMapC
+        ( \resp -> fromMaybe [] $ do
+            ss <- resp ^. listChangeSetsResponse_summaries
+            pure $ mapMaybe Summary.changeSetId ss
+        )
+      .| mapM_C
+        ( \csId -> do
+            logInfo $ "Enqueing delete" :# ["changeSetId" .= csId]
+            void $ AWS.send $ newDeleteChangeSet csId
+        )
 
 -- | Did we abandoned this Stack's first ever ChangeSet?
 --

src/Stackctl/AWS/Core.hs

@@ -160,10 +160,10 @@ handlingServiceError =
   handling _ServiceError $ \e -> do
     logError
       $ "Exiting due to AWS Service error"
-      :# [ "code" .= toText (e ^. serviceError_code)
-         , "message" .= fmap toText (e ^. serviceError_message)
-         , "requestId" .= fmap toText (e ^. serviceError_requestId)
-         ]
+        :# [ "code" .= toText (e ^. serviceError_code)
+           , "message" .= fmap toText (e ^. serviceError_message)
+           , "requestId" .= fmap toText (e ^. serviceError_requestId)
+           ]
     exitFailure
 
 formatServiceError :: ServiceError -> Text

src/Stackctl/AWS/Lambda.hs

@@ -93,11 +93,11 @@ awsLambdaInvoke name payload = do
 
   logDebug
     $ "Function result"
-    :# [ "name" .= name
-       , "status" .= status
-       , "error" .= mError
-       , "functionError" .= mFunctionError
-       ]
+      :# [ "name" .= name
+         , "status" .= status
+         , "error" .= mError
+         , "functionError" .= mFunctionError
+         ]
 
   pure
     $ if

src/Stackctl/AWS/Scope.hs

@@ -26,20 +26,14 @@ awsScopeSpecPatterns :: AwsScope -> [Pattern]
 awsScopeSpecPatterns AwsScope {..} =
   [ compile
       $ "stacks"
-      </> unpack (unAccountId awsAccountId)
-      <> ".*"
-      </> unpack (fromRegion awsRegion)
-      <> "**"
-      </> "*"
-      <.> "yaml"
+        </> unpack (unAccountId awsAccountId) <> ".*"
+        </> unpack (fromRegion awsRegion) <> "**"
+        </> "*" <.> "yaml"
   , compile
       $ "stacks"
-      </> "*."
-      <> unpack (unAccountId awsAccountId)
-      </> unpack (fromRegion awsRegion)
-      <> "**"
-      </> "*"
-      <.> "yaml"
+        </> "*." <> unpack (unAccountId awsAccountId)
+        </> unpack (fromRegion awsRegion) <> "**"
+        </> "*" <.> "yaml"
   ]
 
 awsScopeSpecStackName :: AwsScope -> FilePath -> Maybe StackName
@@ -50,13 +44,13 @@ awsScopeSpecStackName scope path = do
   -- pretty fast and loose with the "parsing" step
   pure
     $ path -- stacks/account/region/x/y.yaml
-    & splitPath -- [stacks/, account/, region/, x/, y.yaml]
-    & drop 3 -- [x, y.yaml]
-    & joinPath -- x/y.yaml
-    & dropExtension -- x/y
-    & pack
-    & T.replace "/" "-" -- x-y
-    & StackName
+      & splitPath -- [stacks/, account/, region/, x/, y.yaml]
+      & drop 3 -- [x, y.yaml]
+      & joinPath -- x/y.yaml
+      & dropExtension -- x/y
+      & pack
+      & T.replace "/" "-" -- x-y
+      & StackName
 
 class HasAwsScope env where
   awsScopeL :: Lens' env AwsScope

src/Stackctl/Action.hs

@@ -128,10 +128,10 @@ runAction stackName Action {on, run} = do
         Nothing -> do
           logError
             $ "Output not found"
-            :# [ "stackName" .= stackName
-               , "desiredOutput" .= outputName
-               , "availableOutputs" .= map (^. output_outputKey) outputs
-               ]
+              :# [ "stackName" .= stackName
+                 , "desiredOutput" .= outputName
+                 , "availableOutputs" .= map (^. output_outputKey) outputs
+                 ]
           throwIO NoSuchOutput
         Just name -> invoke name
     InvokeLambdaByName name -> invoke name

src/Stackctl/Config.hs

@@ -75,9 +75,10 @@ loadConfigOrExit = either die pure =<< loadConfig
 
 loadConfig :: MonadIO m => m (Either ConfigError Config)
 loadConfig =
-  runExceptT $ getConfigFile >>= \case
-    Nothing -> pure emptyConfig
-    Just cf -> loadConfigFrom cf
+  runExceptT
+    $ getConfigFile >>= \case
+      Nothing -> pure emptyConfig
+      Just cf -> loadConfigFrom cf
 
 loadConfigFrom :: (MonadIO m, MonadError ConfigError m) => FilePath -> m Config
 loadConfigFrom path = loadConfigFromBytes =<< liftIO (readFileBinary path)

src/Stackctl/Config/RequiredVersion.hs

@@ -54,7 +54,7 @@ requiredVersionFromText = fromWords . T.words
     ws ->
       Left
         $ show (unpack $ T.unwords ws)
-        <> " did not parse as optional operator and version string"
+          <> " did not parse as optional operator and version string"
 
   parseRequiredVersion :: Text -> Text -> Either String RequiredVersion
   parseRequiredVersion op w = RequiredVersion <$> parseOp op <*> parseVersion w
@@ -71,8 +71,8 @@ requiredVersionFromText = fromWords . T.words
     op ->
       Left
         $ "Invalid comparison operator ("
-        <> unpack op
-        <> "), may only be =, <, <=, >, >=, or =~"
+          <> unpack op
+          <> "), may only be =, <, <=, >, >=, or =~"
 
   parseVersion :: Text -> Either String Version
   parseVersion t =

src/Stackctl/FilterOption.hs

@@ -44,8 +44,8 @@ envFilterOption items = var "FILTERS" <|> var "FILTER"
     Env.var (first Env.UnreadError . readFilterOption) name
       $ Env.help
       $ "Filter "
-      <> items
-      <> " by patterns"
+        <> items
+        <> " by patterns"
 
 filterOption :: String -> Parser FilterOption
 filterOption items =

src/Stackctl/Options.hs

@@ -55,11 +55,11 @@ envParser :: Env.Parser Env.Error Options
 envParser =
   Env.prefixed "STACKCTL_"
     $ Options
-    <$> optional envDirectoryOption
-    <*> optional (envFilterOption "specifications")
-    <*> pure mempty -- use LOG_COLOR
-    <*> pure mempty -- use LOG_LEVEL
-    <*> optional envAutoSSOOption
+      <$> optional envDirectoryOption
+      <*> optional (envFilterOption "specifications")
+      <*> pure mempty -- use LOG_COLOR
+      <*> pure mempty -- use LOG_LEVEL
+      <*> optional envAutoSSOOption
 
 -- brittany-disable-next-binding
 

src/Stackctl/Spec/Capture.hs

@@ -132,9 +132,8 @@ runCapture CaptureOptions {..} = do
   case results of
     [] -> do
       logError
-        $ "No Active Stacks match "
-        <> pack (decompile scoStackName)
-        :# []
+        $ "No Active Stacks match " <> pack (decompile scoStackName)
+          :# []
       exitFailure
     [stackName] -> do
       stack <- awsCloudFormationDescribeStack stackName

src/Stackctl/Spec/Cat.hs

@@ -138,11 +138,11 @@ prettyPrintStackSpecYaml Colors {..} name StackSpecYaml {..} =
     kvs <- f <$> mA
     pure
       $ [cyan label <> ":"]
-      <> map
-        ( \(k, mV) ->
-            "  " <> cyan k <> ":" <> maybe "" (\v -> " " <> green v) mV
-        )
-        kvs
+        <> map
+          ( \(k, mV) ->
+              "  " <> cyan k <> ":" <> maybe "" (\v -> " " <> green v) mV
+          )
+          kvs
 
   ppList :: Text -> (a -> [Text]) -> Maybe a -> [Text]
   ppList label f = maybe [] (((cyan label <> ":") :) . f)
@@ -186,8 +186,8 @@ prettyPrintTemplate Colors {..} val =
   displayObjectProperty =
     displayPropertyWith @(HashMap Text Value)
       $ map (("  - " <>) . green)
-      . sort
-      . HashMap.keys
+        . sort
+        . HashMap.keys
 
   displayPropertyWith
     :: (FromJSON a, ToJSON a) => (a -> [Text]) -> Text -> [Text]