git.iko.soy/typeable/octopod
on master help sign in
Check formatting on CI (#103)

* Check formatting on CI * Formatted everything * Use git diff * Fixed formatting

commitf8bc81ce3176779d57072d3226ab5a6a5b681606 authoriko <ilyakooo0@gmail.com> dateWed 15 Sep 2021, 14:47 (5 years ago) parent7303b13
14 files changed+130−103
compare with master
unifiedsplit
.github/workflows/build.yaml+12−1 nix/ci.nix+6 octo-cli/Setup.hs+1 octo-cli/src/Text/Layout/Table/Extras.hs+11−9 octopod-api/Setup.hs+1 octopod-api/src/Octopod/PowerAPI.hs+24−24 octopod-backend/Setup.hs+2−1 octopod-backend/src/Control/Octopod/DeploymentLock.hs+30−29 octopod-backend/src/Octopod/Server/Posix.hs+11−14 octopod-common/Setup.hs+2−1 octopod-frontend/Setup.hs+2−1 octopod-frontend/src/Main.hs−1 octopod-frontend/src/Reflex/MultiEventWriter/Class.hs+10−8 octopod-frontend/src/Servant/Reflex/Extra.hs+18−14
.github/workflows/build.yaml+12−1
@@ -12,6 +12,17 @@ on:
1212 - staging
1313
1414jobs:
15+ check-formatting:
16+ name: Check Haskell formatting
17+ runs-on: ubuntu-latest
18+ steps:
19+ - uses: actions/checkout@v2
20+ - uses: cachix/install-nix-action@v12
21+ - name: Run fourmolu
22+ run: |
23+ nix-shell nix/ci.nix -j auto --run "git ls-files '*.hs' | xargs fourmolu -m inplace --ghc-opt -XRecursiveDo --ghc-opt -XTypeApplications"
24+ git diff --exit-code
25+
1526 octo-macOS:
1627 name: macOS octo CLI Release (Stack)
1728 runs-on: macos-latest
@@ -47,7 +58,7 @@ jobs:
4758 name: octopod
4859 signingKey: "${{ secrets.CACHIX_SIGNING_KEY }}"
4960 - name: Build
50− run: nix-build -A projectCross.musl64.hsPkgs.octo-cli.components.exes.octo --arg prod true
61+ run: nix-build -A projectCross.musl64.hsPkgs.octo-cli.components.exes.octo --arg prod true -j auto
5162 - uses: actions/upload-artifact@v2
5263 with:
5364 name: octo-cli-linux
nix/ci.nixnew file+6
@@ -0,0 +1,6 @@
1+{ sources ? import ./sources.nix
2+, pkgs ? import sources.nixpkgs { }
3+}:
4+pkgs.mkShell {
5+ packages = [ pkgs.haskellPackages.fourmolu ];
6+}
octo-cli/Setup.hs+1
@@ -1,2 +1,3 @@
11import Distribution.Simple
2+
23main = defaultMain
octo-cli/src/Text/Layout/Table/Extras.hs+11−9
@@ -2,23 +2,25 @@
22
33module Text.Layout.Table.Extras
44 (
5− ) where
5+ )
6+where
67
7−import Data.Text
8+import Data.Text
89import qualified Data.Text as T
9−import Text.Layout.Table.Cell
10−import Text.Layout.Table.Primitives.AlignInfo
11−import Text.Layout.Table.StringBuilder
10+import Text.Layout.Table.Cell
11+import Text.Layout.Table.Primitives.AlignInfo
12+import Text.Layout.Table.StringBuilder
1213
1314instance Cell Text where
1415 dropLeft = T.drop
1516 dropRight = T.dropEnd
1617 visibleLength = T.length
1718 measureAlignment p xs = case T.break p xs of
18− (ls, rs) -> AlignInfo (T.length ls) $
19− if T.null rs
20− then Nothing
21− else Just $ T.length rs - 1
19+ (ls, rs) ->
20+ AlignInfo (T.length ls) $
21+ if T.null rs
22+ then Nothing
23+ else Just $ T.length rs - 1
2224 buildCell = stringB . T.unpack
2325
2426instance StringBuilder Text where
octopod-api/Setup.hs+1
@@ -1,2 +1,3 @@
11import Distribution.Simple
2+
23main = defaultMain
octopod-api/src/Octopod/PowerAPI.hs+24−24
@@ -48,30 +48,30 @@ type CleanArchiveEndpoint =
4848type DeploymentAPI' c =
4949 Auth '[AuthHeaderAuth] () :> "api" :> "v1"
5050 :> ( "deployments"
51− :> ( ListEndpoint
52− -- endpoint to get deployment list
53− :<|> CreateEndpoint
54− -- endpoint to create a new deployment
55− :<|> ArchiveEndpoint c
56− -- endpoint to archive an existing deployment
57− :<|> UpdateEndpoint c
58− -- endpoint to update an existing deployment
59− :<|> InfoEndpoint c
60− -- endpoint to get deployment info
61− :<|> FullInfoEndpoint c
62− -- endpoint to get full deployment info
63− :<|> StatusEndpoint c
64− -- endpoint to get deployment status
65− :<|> CleanupEndpoint c
66− -- endpoint to clean up resources of an archived deployment
67− :<|> RestoreEndpoint c
68− -- endpoint to restore an archived deployment
69− )
70− :<|> GetActionInfoEndpoint
71− -- endpoint to get action logs
72− :<|> CleanArchiveEndpoint
73− -- endpoint to clean up resources of all archived deployments
74− -- according to the archive retention policy
51+ :> ( ListEndpoint
52+ -- endpoint to get deployment list
53+ :<|> CreateEndpoint
54+ -- endpoint to create a new deployment
55+ :<|> ArchiveEndpoint c
56+ -- endpoint to archive an existing deployment
57+ :<|> UpdateEndpoint c
58+ -- endpoint to update an existing deployment
59+ :<|> InfoEndpoint c
60+ -- endpoint to get deployment info
61+ :<|> FullInfoEndpoint c
62+ -- endpoint to get full deployment info
63+ :<|> StatusEndpoint c
64+ -- endpoint to get deployment status
65+ :<|> CleanupEndpoint c
66+ -- endpoint to clean up resources of an archived deployment
67+ :<|> RestoreEndpoint c
68+ -- endpoint to restore an archived deployment
69+ )
70+ :<|> GetActionInfoEndpoint
71+ -- endpoint to get action logs
72+ :<|> CleanArchiveEndpoint
73+ -- endpoint to clean up resources of all archived deployments
74+ -- according to the archive retention policy
7575 )
7676
7777data AuthHeaderAuth
octopod-backend/Setup.hs+2−1
@@ -1,2 +1,3 @@
1−import Distribution.Simple
1+import Distribution.Simple
2+
23main = defaultMain
octopod-backend/src/Control/Octopod/DeploymentLock.hs+30−29
@@ -1,18 +1,19 @@
11module Control.Octopod.DeploymentLock
2− ( LockedDeployments
3− , initLockedDeployments
4− , withLockedDeployment
5− , isDeploymentLocked
6− ) where
2+ ( LockedDeployments,
3+ initLockedDeployments,
4+ withLockedDeployment,
5+ isDeploymentLocked,
6+ )
7+where
78
8−import Common.Types
9−import Control.Concurrent.STM
10−import Control.Exception.Lifted
11−import Control.Monad.Base
12−import Control.Monad.Reader
13−import Control.Monad.Trans.Control
14−import Data.Generics.Product.Typed
15−import Data.Set (Set)
9+import Common.Types
10+import Control.Concurrent.STM
11+import Control.Exception.Lifted
12+import Control.Monad.Base
13+import Control.Monad.Reader
14+import Control.Monad.Trans.Control
15+import Data.Generics.Product.Typed
16+import Data.Set (Set)
1617import qualified Data.Set as S
1718
1819newtype LockedDeployments = LockedDeployments (TVar (Set DeploymentName))
@@ -20,19 +21,18 @@ newtype LockedDeployments = LockedDeployments (TVar (Set DeploymentName))
2021initLockedDeployments :: IO LockedDeployments
2122initLockedDeployments = LockedDeployments <$> newTVarIO S.empty
2223
23−withLockedDeployment
24− ::
25− ( MonadReader r m
26− , HasType LockedDeployments r
27− , MonadBaseControl IO m
28− )
29− => DeploymentName
30− -> m a
31− -- ^ The conflict handler. Gets called if the deployment is
32− -- already being processed.
33− -> m a
34− -- ^ The actions to be performed when the deployment is locked.
35− -> m a
24+withLockedDeployment ::
25+ ( MonadReader r m
26+ , HasType LockedDeployments r
27+ , MonadBaseControl IO m
28+ ) =>
29+ DeploymentName ->
30+ -- | The conflict handler. Gets called if the deployment is
31+ -- already being processed.
32+ m a ->
33+ -- | The actions to be performed when the deployment is locked.
34+ m a ->
35+ m a
3636withLockedDeployment dName conflictHandler m = do
3737 (LockedDeployments tvar) <- asks getTyped
3838 proceed <- liftBase . atomically $ do
@@ -46,9 +46,10 @@ withLockedDeployment dName conflictHandler m = do
4646 then finally m $ liftBase . atomically $ modifyTVar tvar (S.delete dName)
4747 else conflictHandler
4848
49−isDeploymentLocked
50− :: (MonadReader r m , HasType LockedDeployments r, MonadBase IO m)
51− => DeploymentName -> m Bool
49+isDeploymentLocked ::
50+ (MonadReader r m, HasType LockedDeployments r, MonadBase IO m) =>
51+ DeploymentName ->
52+ m Bool
5253isDeploymentLocked dName = do
5354 (LockedDeployments tvar) <- asks getTyped
5455 s <- liftBase $ readTVarIO tvar
octopod-backend/src/Octopod/Server/Posix.hs+11−14
@@ -1,22 +1,19 @@
11module Octopod.Server.Posix (installShutdownHandler) where
22
3+import Control.Monad
4+import Control.Monad.Base (liftBase)
5+import Data.Text
6+import System.Log.FastLogger
7+import System.Posix.Signals
38
4−import Control.Monad
5−import Control.Monad.Base (liftBase)
6−import Data.Text
7−import System.Log.FastLogger
8−import System.Posix.Signals
9−
10−
11−import Octopod.Server.Logger
12−
9+import Octopod.Server.Logger
1310
1411-- | Installs the given shutdown handler for the specified signals.
15−installShutdownHandler
16− :: TimedFastLogger
17− -> [Signal]
18− -> IO ()
19− -> IO [Handler]
12+installShutdownHandler ::
13+ TimedFastLogger ->
14+ [Signal] ->
15+ IO () ->
16+ IO [Handler]
2017installShutdownHandler logger signals action =
2118 forM signals $ \signal -> installHandler signal (handler signal) Nothing
2219 where
octopod-common/Setup.hs+2−1
@@ -1,2 +1,3 @@
1−import Distribution.Simple
1+import Distribution.Simple
2+
23main = defaultMain
octopod-frontend/Setup.hs+2−1
@@ -1,2 +1,3 @@
1−import Distribution.Simple
1+import Distribution.Simple
2+
23main = defaultMain
octopod-frontend/src/Main.hs−1
@@ -22,7 +22,6 @@ import Frontend.Utils (errorCommonWidget, loadingCommonWidget)
2222import Page.Deployment
2323import Page.Deployments
2424
25−
2625main :: IO ()
2726main = mdo
2827 mainWidgetWithHead'
octopod-frontend/src/Reflex/MultiEventWriter/Class.hs+10−8
@@ -1,11 +1,11 @@
11module Reflex.MultiEventWriter.Class
2− ( MultiEventWriter(..)
3− ) where
4−
5−import Control.Monad.Reader (ReaderT, lift)
6−import Data.Type.Equality
7−import Reflex.Dom
2+ ( MultiEventWriter (..),
3+ )
4+where
85
6+import Control.Monad.Reader (ReaderT, lift)
7+import Data.Type.Equality
8+import Reflex.Dom
99
1010-- | Same as 'EventWriter' but without a fundep.
1111class (Monad m, Semigroup w) => MultiEventWriter t w m | m -> t where
@@ -24,8 +24,10 @@ type MultiEventWriter' t w u m = MultiEventWriter'' t w u m (w == u)
2424class (u == w) ~ f => MultiEventWriter'' t w u m f where
2525 tellMultiEvent' :: Event t w -> EventWriterT t u m ()
2626
27−instance ((w == w) ~ 'True, Reflex t, Monad m, Semigroup w)
28− => MultiEventWriter'' t w w m 'True where
27+instance
28+ ((w == w) ~ 'True, Reflex t, Monad m, Semigroup w) =>
29+ MultiEventWriter'' t w w m 'True
30+ where
2931 tellMultiEvent' = tellEvent
3032
3133instance ((u == w) ~ 'False, MultiEventWriter t w m) => MultiEventWriter'' t w u m 'False where
octopod-frontend/src/Servant/Reflex/Extra.hs+18−14
@@ -1,27 +1,31 @@
11{-# OPTIONS_GHC -Wno-orphans #-}
22
33module Servant.Reflex.Extra
4− ( reqErrorBody
5− ) where
4+ ( reqErrorBody,
5+ )
6+where
67
7−import Data.Functor.Identity
8−import Data.Proxy
9−import Data.Text (Text)
8+import Data.Functor.Identity
9+import Data.Proxy
10+import Data.Text (Text)
1011import qualified Data.Text.Encoding as E
11−import Reflex.Dom
12−import Servant.API
13−import Servant.Reflex
12+import Reflex.Dom
13+import Servant.API
14+import Servant.Reflex
1415
15−instance (SupportsServantReflex t m)
16− => HasClient t m (NoContentVerb 'GET) tag where
16+instance
17+ (SupportsServantReflex t m) =>
18+ HasClient t m (NoContentVerb 'GET) tag
19+ where
1720 type Client t m (NoContentVerb 'GET) tag = Event t tag -> m (Event t (ReqResult tag NoContent))
1821 clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap' trigs =
19− wrap' =<< fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req) baseurl opts trigs
20− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy 'GET)
22+ wrap' =<< fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req) baseurl opts trigs
23+ where
24+ method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy 'GET)
2125
2226reqErrorBody :: ReqResult tag a -> Maybe Text
23−reqErrorBody (ResponseFailure _ _ XhrResponse {_xhrResponse_responseText = Just b})
24− = Just b
27+reqErrorBody (ResponseFailure _ _ XhrResponse {_xhrResponse_responseText = Just b}) =
28+ Just b
2529reqErrorBody (ResponseFailure _ _ XhrResponse {_xhrResponse_response = Just (XhrResponseBody_Default t)}) =
2630 Just t
2731reqErrorBody (ResponseFailure _ _ XhrResponse {_xhrResponse_response = Just (XhrResponseBody_Text t)}) =