diff --git a/.github/workflows/linting.yml b/.github/workflows/linting.yml index c969a68c..ee06bacd 100644 --- a/.github/workflows/linting.yml +++ b/.github/workflows/linting.yml @@ -11,7 +11,7 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: fourmolu/fourmolu-action@v3 + - uses: fourmolu/fourmolu-action@v4 with: pattern: | src/**/*.hs diff --git a/cabal.project.freeze b/cabal.project.freeze index 1ea711e2..ae03b4b6 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -1,5 +1,6 @@ active-repositories: hackage.haskell.org:merge constraints: any.Cabal ==3.6.3.0, + Cabal -bundled-binary-generic, any.Cabal-syntax ==3.8.1.0, any.HUnit ==1.6.2.0, any.OneTuple ==0.3.1, @@ -302,6 +303,7 @@ constraints: any.Cabal ==3.6.3.0, any.terminal-size ==0.3.3, any.terminfo ==0.4.1.5, any.text ==2.0.1, + text -developer +simdutf, any.text-conversions ==0.3.1.1, any.text-display ==0.0.3.0, any.text-manipulate ==0.3.1.0, @@ -381,6 +383,9 @@ constraints: any.Cabal ==3.6.3.0, any.x509-store ==1.6.9, any.x509-system ==1.6.7, any.x509-validation ==1.6.12, + any.xml-conduit ==1.9.1.1, + any.xml-conduit-writer ==0.1.1.2, + any.xml-types ==0.3.8, any.zlib ==0.6.3.0, zlib -bundled-c-zlib -non-blocking-ffi -pkg-config index-state: hackage.haskell.org 2022-08-23T14:54:28Z diff --git a/fourmolu.yaml b/fourmolu.yaml index 2d0d07fb..59c69534 100644 --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -4,6 +4,7 @@ import-export-style: leading record-brace-space: false # rec {x = 1} vs. rec{x = 1} indent-wheres: true # 'false' means save space by only half-indenting the 'where' keyword respectful: true # don't be too opinionated about newlines etc. -haddock-style: multi-line # '--' vs. '{-' +haddock-style: multi-line-compact # '--' vs. '{-' newlines-between-decls: 1 # number of newlines between top-level declarations fixities: [] +function-arrows: leading diff --git a/src/Flora/Environment.hs b/src/Flora/Environment.hs index 184e46a6..103bd094 100644 --- a/src/Flora/Environment.hs +++ b/src/Flora/Environment.hs @@ -43,12 +43,12 @@ data TestEnv = TestEnv } deriving stock (Generic) -mkPool :: - PG.ConnectInfo -> -- Database access information - Int -> -- Number of sub-pools - NominalDiffTime -> -- Allowed timeout - Int -> -- Number of connections - Eff '[IOE] (Pool PG.Connection) +mkPool + :: PG.ConnectInfo -- Database access information + -> Int -- Number of sub-pools + -> NominalDiffTime -- Allowed timeout + -> Int -- Number of connections + -> Eff '[IOE] (Pool PG.Connection) mkPool connectInfo subPools timeout' connections = liftIO $ Pool.newPool $ diff --git a/src/Flora/Environment/OddJobs.hs b/src/Flora/Environment/OddJobs.hs index a6b7ed75..daccfa38 100644 --- a/src/Flora/Environment/OddJobs.hs +++ b/src/Flora/Environment/OddJobs.hs @@ -13,13 +13,13 @@ import OddJobs.Types (ConcurrencyControl (..), Job, UIConfig (..)) import Flora.Environment.Config import Flora.OddJobs.Types -makeConfig :: - JobsRunnerEnv -> - FloraConfig -> - Logger -> - Pool PG.Connection -> - (Job -> JobsRunner ()) -> - Config +makeConfig + :: JobsRunnerEnv + -> FloraConfig + -> Logger + -> Pool PG.Connection + -> (Job -> JobsRunner ()) + -> Config makeConfig runnerEnv cfg logger pool runnerContinuation = mkConfig (\level event -> structuredLogging cfg logger level event) diff --git a/src/Flora/Import/Package.hs b/src/Flora/Import/Package.hs index 003fd4a6..b6193668 100644 --- a/src/Flora/Import/Package.hs +++ b/src/Flora/Import/Package.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wno-redundant-constraints #-} -{- | +{-| Module: Flora.Import.Package This module contains all the code to import Cabal packages into Flora. The import process @@ -77,7 +77,7 @@ import Flora.Model.Requirement import Flora.Model.User import GHC.Stack (HasCallStack) -{- | This tuple represents the package that depends on any associated dependency/requirement. +{-| This tuple represents the package that depends on any associated dependency/requirement. It is used in the recursive loading of Cabal files -} type DependentName = (Namespace, PackageName) @@ -127,17 +127,17 @@ coreLibraries = , PackageName "unix" ] -{- | Imports a Cabal file into the database by: +{-| Imports a Cabal file into the database by: * first, reading and parsing the file using 'loadFile' * then, extracting relevant information using 'extractPackageDataFromCabal' * finally, inserting that data into the database -} -importFile :: - ([DB, IOE, Logging, Time] :>> es) => - UserId -> - -- | The absolute path to the Cabal file - FilePath -> - Eff es () +importFile + :: ([DB, IOE, Logging, Time] :>> es) + => UserId + -> FilePath + -- ^ The absolute path to the Cabal file + -> Eff es () importFile userId path = loadFile path >>= extractPackageDataFromCabal userId >>= persistImportOutput importRelFile :: ([DB, IOE, Logging, Time] :>> es) => UserId -> FilePath -> Eff es () @@ -146,11 +146,11 @@ importRelFile user dir = do importFile user workdir -- | Loads and parses a Cabal file -loadFile :: - ([DB, IOE, Logging, Time] :>> es) => - -- | The absolute path to the Cabal file - FilePath -> - Eff es GenericPackageDescription +loadFile + :: ([DB, IOE, Logging, Time] :>> es) + => FilePath + -- ^ The absolute path to the Cabal file + -> Eff es GenericPackageDescription loadFile path = do exists <- liftIO $ System.doesFileExist path unless exists $ @@ -160,14 +160,14 @@ loadFile path = do content <- liftIO $ BS.readFile path parseString parseGenericPackageDescription path content -parseString :: - (HasCallStack, [Logging, Time] :>> es) => - -- | File contents to final value parser - (BS.ByteString -> ParseResult a) -> - -- | File name - String -> - BS.ByteString -> - Eff es a +parseString + :: (HasCallStack, [Logging, Time] :>> es) + => (BS.ByteString -> ParseResult a) + -- ^ File contents to final value parser + -> String + -- ^ File name + -> BS.ByteString + -> Eff es a parseString parser name bs = do let (_warnings, result) = runParseResult (parser bs) case result of @@ -179,7 +179,7 @@ parseString parser name bs = do loadAndExtractCabalFile :: ([DB, IOE, Logging, Time] :>> es) => UserId -> FilePath -> Eff es ImportOutput loadAndExtractCabalFile userId filePath = loadFile filePath >>= extractPackageDataFromCabal userId -{- | Persists an 'ImportOutput' to the database. An 'ImportOutput' can be obtained +{-| Persists an 'ImportOutput' to the database. An 'ImportOutput' can be obtained by extracting relevant information from a Cabal file using 'extractPackageDataFromCabal' -} persistImportOutput :: [DB, IOE] :>> es => ImportOutput -> Eff es () @@ -206,7 +206,7 @@ persistImportOutput (ImportOutput package categories release components) = do Update.upsertPackage (dep.package) Update.upsertRequirement (dep.requirement) -{- | Transforms a 'GenericPackageDescription' from Cabal into an 'ImportOutput' +{-| Transforms a 'GenericPackageDescription' from Cabal into an 'ImportOutput' that can later be inserted into the database. This function produces stable, deterministic ids, so it should be possible to extract and insert a single package many times in a row. -} @@ -330,16 +330,16 @@ extractBenchmark = (^. #benchmarkName % to unUnqualComponentName % to T.pack) (^. #benchmarkBuildInfo % #targetBuildDepends) -{- | Traverses the provided 'CondTree' and applies the given 'ComponentExtractor' +{-| Traverses the provided 'CondTree' and applies the given 'ComponentExtractor' to every node, returning a list of 'ImportComponent' -} -extractCondTree :: - (Package -> Release -> Maybe UnqualComponentName -> Maybe (Condition ConfVar) -> component -> ImportComponent) -> - Package -> - Release -> - Maybe UnqualComponentName -> - CondTree ConfVar [Dependency] component -> - [ImportComponent] +extractCondTree + :: (Package -> Release -> Maybe UnqualComponentName -> Maybe (Condition ConfVar) -> component -> ImportComponent) + -> Package + -> Release + -> Maybe UnqualComponentName + -> CondTree ConfVar [Dependency] component + -> [ImportComponent] extractCondTree extractor package release defaultComponentName = go Nothing where go cond tree = @@ -351,33 +351,33 @@ extractCondTree extractor package release defaultComponentName = go Nothing condIfFalseComponents = maybe [] (go (Just . CNot $ condBranchCondition)) condBranchIfFalse in condIfTrueComponents <> condIfFalseComponents -{- | Cabal often models conditional components as a list of 'CondTree' associated with an 'UnqualComponentName'. +{-| Cabal often models conditional components as a list of 'CondTree' associated with an 'UnqualComponentName'. This function builds upon 'extractCondTree' to make it easier to extract fields such as 'condExecutables', 'condTestSuites' etc. from a 'GenericPackageDescription' -} -extractCondTrees :: - (Package -> Release -> Maybe UnqualComponentName -> Maybe (Condition ConfVar) -> component -> ImportComponent) -> - Package -> - Release -> - [(UnqualComponentName, CondTree ConfVar [Dependency] component)] -> - [ImportComponent] +extractCondTrees + :: (Package -> Release -> Maybe UnqualComponentName -> Maybe (Condition ConfVar) -> component -> ImportComponent) + -> Package + -> Release + -> [(UnqualComponentName, CondTree ConfVar [Dependency] component)] + -> [ImportComponent] extractCondTrees extractor package release trees = trees >>= \case (name, tree) -> extractCondTree extractor package release (Just name) tree -genericComponentExtractor :: - forall component. - () => - ComponentType -> - -- | Extract name from component - (component -> Text) -> - -- | Extract dependencies - (component -> [Dependency]) -> - Package -> - Release -> - Maybe UnqualComponentName -> - Maybe (Condition ConfVar) -> - component -> - (PackageComponent, [ImportDependency]) +genericComponentExtractor + :: forall component + . () + => ComponentType + -> (component -> Text) + -- ^ Extract name from component + -> (component -> [Dependency]) + -- ^ Extract dependencies + -> Package + -> Release + -> Maybe UnqualComponentName + -> Maybe (Condition ConfVar) + -> component + -> (PackageComponent, [ImportDependency]) genericComponentExtractor componentType getName diff --git a/src/Flora/Import/Package/Bulk.hs b/src/Flora/Import/Package/Bulk.hs index 2e94964a..8bd6b0fe 100644 --- a/src/Flora/Import/Package/Bulk.hs +++ b/src/Flora/Import/Package/Bulk.hs @@ -49,14 +49,14 @@ importAllFilesInDirectory appLogger user dir = do traverse_ persistImportOutput chunk liftIO . putStrLn $ "✅ Processed " <> show newCount <> " new cabal files" -{- | Finds all cabal files in the provided directory recursively +{-| Finds all cabal files in the provided directory recursively Hits are written to the output channel as they are found, so it should be possible to process large amounts of Cabal files efficiently -} -findAllCabalFilesInDirectory :: - IOE :> es => - FilePath -> - Stream (Of FilePath) (Eff es) () +findAllCabalFilesInDirectory + :: IOE :> es + => FilePath + -> Stream (Of FilePath) (Eff es) () findAllCabalFilesInDirectory workdir = do liftIO . putStrLn $ "🔎 Searching cabal files in " <> workdir liftIO $ System.createDirectoryIfMissing True workdir diff --git a/src/Flora/Model/Category/Types.hs b/src/Flora/Model/Category/Types.hs index 0e9d8b66..dd4e5f19 100644 --- a/src/Flora/Model/Category/Types.hs +++ b/src/Flora/Model/Category/Types.hs @@ -55,16 +55,16 @@ data PackageCategory = PackageCategory mkCategoryId :: IO CategoryId mkCategoryId = CategoryId <$> UUID.nextRandom -mkCategory :: - -- | Id of the category in the database - CategoryId -> - -- | Name - Text -> - -- | Optional slug, can be inferred from the name - Maybe Text -> - -- | Synopsis - Text -> - Category +mkCategory + :: CategoryId + -- ^ Id of the category in the database + -> Text + -- ^ Name + -> Maybe Text + -- ^ Optional slug, can be inferred from the name + -> Text + -- ^ Synopsis + -> Category mkCategory categoryId name Nothing synopsis = mkCategory categoryId name (Just $ slugify name) synopsis mkCategory categoryId name (Just slug) synopsis = diff --git a/src/Flora/Model/Package/Query.hs b/src/Flora/Model/Package/Query.hs index 0546ff08..8a6fdf61 100644 --- a/src/Flora/Model/Package/Query.hs +++ b/src/Flora/Model/Package/Query.hs @@ -89,11 +89,11 @@ getHaskellOrHackagePackage packageName = (Only packageName) -- | TODO: Remove the manual fields and use pg-entity -getAllPackageDependents :: - ([DB, Logging, Time, IOE] :>> es) => - Namespace -> - PackageName -> - Eff es (Vector Package) +getAllPackageDependents + :: ([DB, Logging, Time, IOE] :>> es) + => Namespace + -> PackageName + -> Eff es (Vector Package) getAllPackageDependents namespace packageName = dbtToEff $ query Select packageDependentsQuery (namespace, packageName) -- | This function gets the first 6 dependents of a package @@ -137,20 +137,20 @@ packageDependentsQuery = AND dep."name" = ? |] -getAllPackageDependentsWithLatestVersion :: - ([DB, Logging, Time, IOE] :>> es) => - Namespace -> - PackageName -> - Eff es (Vector (Namespace, PackageName, Text, Version)) +getAllPackageDependentsWithLatestVersion + :: ([DB, Logging, Time, IOE] :>> es) + => Namespace + -> PackageName + -> Eff es (Vector (Namespace, PackageName, Text, Version)) getAllPackageDependentsWithLatestVersion namespace packageName = dbtToEff $ query Select packageDependentsWithLatestVersionQuery (namespace, packageName) -getPackageDependentsWithLatestVersion :: - ([DB, Logging, Time, IOE] :>> es) => - Namespace -> - PackageName -> - Eff es (Vector (Namespace, PackageName, Text, Version)) +getPackageDependentsWithLatestVersion + :: ([DB, Logging, Time, IOE] :>> es) + => Namespace + -> PackageName + -> Eff es (Vector (Namespace, PackageName, Text, Version)) getPackageDependentsWithLatestVersion namespace packageName = do (result, duration) <- timeAction $ @@ -195,10 +195,10 @@ getComponent releaseId name componentType = , [field| component_type |] ] -unsafeGetComponent :: - ([DB, Logging, Time, IOE] :>> es) => - ReleaseId -> - Eff es (Maybe PackageComponent) +unsafeGetComponent + :: ([DB, Logging, Time, IOE] :>> es) + => ReleaseId + -> Eff es (Maybe PackageComponent) unsafeGetComponent releaseId = dbtToEff $ queryOne Select (_selectWhere @PackageComponent queryFields) (Only releaseId) @@ -206,12 +206,12 @@ unsafeGetComponent releaseId = queryFields :: Vector Field queryFields = [[field| release_id |]] -getAllRequirements :: - ([DB, Logging, Time, IOE] :>> es) => - -- | Id of the release for which we want the dependencies - ReleaseId -> - -- | Returns a vector of (Namespace, Name, dependency requirement, version of latest of release of dependency, synopsis of dependency) - Eff es (Vector (Namespace, PackageName, Text, Version, Text)) +getAllRequirements + :: ([DB, Logging, Time, IOE] :>> es) + => ReleaseId + -- ^ Id of the release for which we want the dependencies + -> Eff es (Vector (Namespace, PackageName, Text, Version, Text)) + -- ^ Returns a vector of (Namespace, Name, dependency requirement, version of latest of release of dependency, synopsis of dependency) getAllRequirements releaseId = dbtToEff $ query Select getAllRequirementsQuery (Only releaseId) getRequirements :: ([DB, Logging, Time, IOE] :>> es) => ReleaseId -> Eff es (Vector (Namespace, PackageName, Text)) @@ -224,7 +224,7 @@ getRequirements releaseId = do ] pure result -{- | This query finds all the dependencies of a release, +{-| This query finds all the dependencies of a release, and displays their namespace, name and the requirement spec (version range) expressed by the dependent. HACK: This query is terrifying, must be optimised by someone who knows their shit. -} @@ -285,10 +285,10 @@ numberOfPackageRequirementsQuery = where rel."release_id" = ? |] -getPackageCategories :: - ([DB, Logging, Time, IOE] :>> es) => - PackageId -> - Eff es (Vector Category) +getPackageCategories + :: ([DB, Logging, Time, IOE] :>> es) + => PackageId + -> Eff es (Vector Category) getPackageCategories packageId = dbtToEff $ joinSelectOneByField @Category @@ -297,10 +297,10 @@ getPackageCategories packageId = [field| package_id |] packageId -getPackagesFromCategoryWithLatestVersion :: - ([DB, Logging, Time, IOE] :>> es) => - CategoryId -> - Eff es (Vector (Namespace, PackageName, Text, Version)) +getPackagesFromCategoryWithLatestVersion + :: ([DB, Logging, Time, IOE] :>> es) + => CategoryId + -> Eff es (Vector (Namespace, PackageName, Text, Version)) getPackagesFromCategoryWithLatestVersion categoryId = dbtToEff $ query Select q (Only categoryId) where q = @@ -311,11 +311,11 @@ getPackagesFromCategoryWithLatestVersion categoryId = dbtToEff $ query Select q where c.category_id = ? |] -searchPackage :: - ([DB, Logging, Time, IOE] :>> es) => - Word -> - Text -> - Eff es (Vector (Namespace, PackageName, Text, Version, Float)) +searchPackage + :: ([DB, Logging, Time, IOE] :>> es) + => Word + -> Text + -> Eff es (Vector (Namespace, PackageName, Text, Version, Float)) searchPackage pageNumber searchString = dbtToEff $ let limit = 30 @@ -342,10 +342,10 @@ searchPackage pageNumber searchString = |] (searchString, searchString, offset) -listAllPackages :: - ([DB, Logging, Time, IOE] :>> es) => - Word -> - Eff es (Vector (Namespace, PackageName, Text, Version, Float)) +listAllPackages + :: ([DB, Logging, Time, IOE] :>> es) + => Word + -> Eff es (Vector (Namespace, PackageName, Text, Version, Float)) listAllPackages pageNumber = dbtToEff $ let limit = 30 diff --git a/src/Flora/Model/PersistentSession.hs b/src/Flora/Model/PersistentSession.hs index 06b15c9e..c1830f6b 100644 --- a/src/Flora/Model/PersistentSession.hs +++ b/src/Flora/Model/PersistentSession.hs @@ -59,11 +59,11 @@ newPersistentSession userId persistentSessionId = do let sessionData = SessionData Map.empty pure PersistentSession{..} -persistSession :: - ([IOE, DB, Time] :>> es) => - PersistentSessionId -> - UserId -> - Eff es PersistentSessionId +persistSession + :: ([IOE, DB, Time] :>> es) + => PersistentSessionId + -> UserId + -> Eff es PersistentSessionId persistSession persistentSessionId userId = do persistentSession <- newPersistentSession userId persistentSessionId insertSession persistentSession diff --git a/src/Flora/Model/Release/Types.hs b/src/Flora/Model/Release/Types.hs index 4eb33e84..2eeb1656 100644 --- a/src/Flora/Model/Release/Types.hs +++ b/src/Flora/Model/Release/Types.hs @@ -35,7 +35,7 @@ newtype ReleaseId = ReleaseId {getReleaseId :: UUID} (Display) via ShowInstance UUID -{- | a wrapper that attaches from and tofield instances +{-| a wrapper that attaches from and tofield instances for a text db row for LucidHtml -} newtype TextHtml = MkTextHtml (Lucid.Html ()) diff --git a/src/Flora/Publish.hs b/src/Flora/Publish.hs index 12f99b5f..c3a6699c 100644 --- a/src/Flora/Publish.hs +++ b/src/Flora/Publish.hs @@ -23,14 +23,14 @@ import Flora.Model.Requirement (Requirement) {- TODO: Audit log of the published package TODO: Publish artifacts -} -publishPackage :: - ([DB, Logging, Time, IOE] :>> es) => - [Requirement] -> - [PackageComponent] -> - Release -> - [UserPackageCategory] -> - Package -> - Eff es Package +publishPackage + :: ([DB, Logging, Time, IOE] :>> es) + => [Requirement] + -> [PackageComponent] + -> Release + -> [UserPackageCategory] + -> Package + -> Eff es Package publishPackage requirements components release userPackageCategories package = do liftIO $ T.putStrLn $ "[+] Package " <> display (package.name) <> ": " result <- Query.getPackageByNamespaceAndName (package.namespace) (package.name) diff --git a/src/FloraWeb/Components/Navbar.hs b/src/FloraWeb/Components/Navbar.hs index 6a3f7f19..4d8db412 100644 --- a/src/FloraWeb/Components/Navbar.hs +++ b/src/FloraWeb/Components/Navbar.hs @@ -44,16 +44,16 @@ brand = do div_ [class_ $ containerBaseClasses <> " md:hidden", xOn_ "click.prevent" "menuOpen = !menuOpen"] $ link defaultLinkOptions{href = "/", classes = "font-bold text-white dark:text-gray-100", childNode = text mobileTitle} -navBarLink :: - -- | Additional classes - Text -> - -- | href attribute - Text -> - -- | label - Text -> - -- | is the element active - Bool -> - FloraHTML +navBarLink + :: Text + -- ^ Additional classes + -> Text + -- ^ href attribute + -> Text + -- ^ label + -> Bool + -- ^ is the element active + -> FloraHTML navBarLink additionalClasses href label isActive' = let baseClasses = "font-bold inline-flex items-center py-3 mx-4 text-white dark:text-gray-100 " in a_ [href_ href, class_ (baseClasses <> additionalClasses <> " " <> isActive isActive')] (text label) diff --git a/src/FloraWeb/Components/PackageListHeader.hs b/src/FloraWeb/Components/PackageListHeader.hs index 1ae50c2f..02b58322 100644 --- a/src/FloraWeb/Components/PackageListHeader.hs +++ b/src/FloraWeb/Components/PackageListHeader.hs @@ -5,14 +5,14 @@ import Data.Text.Display (display) import FloraWeb.Templates.Types import Lucid -presentationHeader :: - -- | Title of the listing. It can be a Category name, a search term - Text -> - -- | Subtitle; It can be a category description, or being empty - Text -> - -- | Number of packages - Word -> - FloraHTML +presentationHeader + :: Text + -- ^ Title of the listing. It can be a Category name, a search term + -> Text + -- ^ Subtitle; It can be a category description, or being empty + -> Word + -- ^ Number of packages + -> FloraHTML presentationHeader title subtitle numberOfPackages = do div_ [class_ "divider"] $ do div_ [class_ "px-4 py-5 sm:px-6 sm:py-24 lg:py-4 lg:px-8"] $ diff --git a/src/FloraWeb/Components/PaginationNav.hs b/src/FloraWeb/Components/PaginationNav.hs index a3c0157c..d875b944 100644 --- a/src/FloraWeb/Components/PaginationNav.hs +++ b/src/FloraWeb/Components/PaginationNav.hs @@ -12,14 +12,14 @@ import Lucid (class_, li_, nav_, ul_, xmlns_) import Lucid.Svg (clip_rule_, d_, fill_, fill_rule_, path_, svg_, viewBox_) import Servant.API (toUrlPiece) -paginationNav :: - -- | Total results - Word -> - -- | Current page - Word -> - -- | Search term - SearchAction -> - FloraHTML +paginationNav + :: Word + -- ^ Total results + -> Word + -- ^ Current page + -> SearchAction + -- ^ Search term + -> FloraHTML paginationNav totalResults currentPage searchAction = do let (totalPages :: Word) = (totalResults `div` 30) + 1 nav_ [class_ "pagination-area"] $ @@ -46,12 +46,12 @@ mkURL ListAllPackages pageNumber = "/" <> toUrlPiece (Links.packageIndexLink pag mkURL (SearchPackages searchTerm) pageNumber = "/" <> toUrlPiece (Links.packageSearchLink searchTerm pageNumber) -paginate :: - -- | Current page - Word -> - -- | Total pages - Word -> - Vector Word +paginate + :: Word + -- ^ Current page + -> Word + -- ^ Total pages + -> Vector Word paginate currentPage totalPages | currentPage <= 2 = Vector.fromList [1 .. 5] | (currentPage + 2) >= totalPages = Vector.fromList [(currentPage - 2) .. totalPages] diff --git a/src/FloraWeb/Components/VersionListHeader.hs b/src/FloraWeb/Components/VersionListHeader.hs index 3fb30319..3025f1d1 100644 --- a/src/FloraWeb/Components/VersionListHeader.hs +++ b/src/FloraWeb/Components/VersionListHeader.hs @@ -8,11 +8,11 @@ import FloraWeb.Components.Utils (text) import FloraWeb.Templates.Types import Lucid -presentationHeader :: - Namespace -> - PackageName -> - Word -> - FloraHTML +presentationHeader + :: Namespace + -> PackageName + -> Word + -> FloraHTML presentationHeader namespace packageName numberOfReleases = do div_ [class_ "divider"] $ do div_ [class_ "px-4 py-5 sm:px-6 sm:py-24 lg:py-4 lg:px-8"] $ diff --git a/src/FloraWeb/Routes/Pages/Packages.hs b/src/FloraWeb/Routes/Pages/Packages.hs index 50e68fad..9b56e09d 100644 --- a/src/FloraWeb/Routes/Pages/Packages.hs +++ b/src/FloraWeb/Routes/Pages/Packages.hs @@ -14,35 +14,35 @@ import Servant.HTML.Lucid type Routes = NamedRoutes Routes' data Routes' mode = Routes' - { index :: - mode + { index + :: mode :- QueryParam "page" Word :> Get '[HTML] (Html ()) - , show :: - mode + , show + :: mode :- Capture "namespace" Namespace :> Capture "package" PackageName :> Get '[HTML] (Html ()) - , showDependents :: - mode + , showDependents + :: mode :- Capture "namespace" Namespace :> Capture "package" PackageName :> "dependents" :> Get '[HTML] (Html ()) - , showDependencies :: - mode + , showDependencies + :: mode :- Capture "namespace" Namespace :> Capture "package" PackageName :> "dependencies" :> Get '[HTML] (Html ()) - , showVersion :: - mode + , showVersion + :: mode :- Capture "namespace" Namespace :> Capture "package" PackageName :> Capture "version" Version :> Get '[HTML] (Html ()) - , listVersions :: - mode + , listVersions + :: mode :- Capture "namespace" Namespace :> Capture "package" PackageName :> "versions" diff --git a/src/FloraWeb/Routes/Pages/Search.hs b/src/FloraWeb/Routes/Pages/Search.hs index befb7bc4..f78277a9 100644 --- a/src/FloraWeb/Routes/Pages/Search.hs +++ b/src/FloraWeb/Routes/Pages/Search.hs @@ -11,8 +11,8 @@ import Servant.HTML.Lucid (HTML) type Routes = NamedRoutes Routes' data Routes' mode = Routes' - { displaySearch :: - mode + { displaySearch + :: mode :- QueryParam "q" Text :> QueryParam "page" Word :> Get '[HTML] (Html ()) diff --git a/src/FloraWeb/Server.hs b/src/FloraWeb/Server.hs index 0df6f411..cdd860ec 100644 --- a/src/FloraWeb/Server.hs +++ b/src/FloraWeb/Server.hs @@ -81,11 +81,11 @@ shutdownFlora env = liftIO $ Pool.destroyAllResources (env.pool) -logException :: - DeploymentEnv -> - Logger -> - Safe.SomeException -> - IO () +logException + :: DeploymentEnv + -> Logger + -> Safe.SomeException + -> IO () logException env logger exception = runEff . runCurrentTimeIO diff --git a/src/FloraWeb/Server/Auth.hs b/src/FloraWeb/Server/Auth.hs index ef896f3f..005c3193 100644 --- a/src/FloraWeb/Server/Auth.hs +++ b/src/FloraWeb/Server/Auth.hs @@ -77,10 +77,10 @@ getSessionId cookies = Nothing -> pure Nothing Just sessionId -> pure $ Just sessionId -getInTheFuckingSessionShinji :: - ([Logging, DB, IOE] :>> es) => - Maybe PersistentSessionId -> - Eff es (Maybe PersistentSession) +getInTheFuckingSessionShinji + :: ([Logging, DB, IOE] :>> es) + => Maybe PersistentSessionId + -> Eff es (Maybe PersistentSession) getInTheFuckingSessionShinji Nothing = pure Nothing getInTheFuckingSessionShinji (Just persistentSessionId) = do result <- getPersistentSession persistentSessionId diff --git a/src/FloraWeb/Server/Auth/Types.hs b/src/FloraWeb/Server/Auth/Types.hs index 56c72850..fa859859 100644 --- a/src/FloraWeb/Server/Auth/Types.hs +++ b/src/FloraWeb/Server/Auth/Types.hs @@ -30,11 +30,11 @@ data IsAdmin :: Effect type instance DispatchOf IsAdmin = Static NoSideEffects newtype instance StaticRep IsAdmin = IsAdmin () -runAdminSession :: - forall (es :: [Effect]) (a :: Type). - () => - Eff (IsAdmin : es) a -> - Eff es a +runAdminSession + :: forall (es :: [Effect]) (a :: Type) + . () + => Eff (IsAdmin : es) a + -> Eff es a runAdminSession computation = evalStaticRep (IsAdmin ()) computation data IsVisitor :: Effect @@ -42,25 +42,25 @@ data IsVisitor :: Effect type instance DispatchOf IsVisitor = Static NoSideEffects newtype instance StaticRep IsVisitor = IsVisitor () -runVisitorSession :: - forall (es :: [Effect]) (a :: Type). - () => - Eff (IsVisitor : es) a -> - Eff es a +runVisitorSession + :: forall (es :: [Effect]) (a :: Type) + . () + => Eff (IsVisitor : es) a + -> Eff es a runVisitorSession computation = evalStaticRep (IsVisitor ()) computation -putVisitorTag :: - forall (es :: [Effect]) (a :: Type). - () => - Eff es a -> - Eff (IsVisitor : es) a +putVisitorTag + :: forall (es :: [Effect]) (a :: Type) + . () + => Eff es a + -> Eff (IsVisitor : es) a putVisitorTag m = raise m -demoteSession :: - forall (es :: [Effect]) (a :: Type). - () => - Eff (IsAdmin : es) a -> - Eff (IsVisitor : es) a +demoteSession + :: forall (es :: [Effect]) (a :: Type) + . () + => Eff (IsAdmin : es) a + -> Eff (IsVisitor : es) a demoteSession = putVisitorTag . runAdminSession -- | Datatypes used for every route that doesn't *need* an authenticated user diff --git a/src/FloraWeb/Server/Guards.hs b/src/FloraWeb/Server/Guards.hs index cf579729..03e0efb1 100644 --- a/src/FloraWeb/Server/Guards.hs +++ b/src/FloraWeb/Server/Guards.hs @@ -12,12 +12,12 @@ import FloraWeb.Templates (defaultTemplateEnv, fromSession) import FloraWeb.Templates.Error (renderError) import Network.HTTP.Types (notFound404) -guardThatPackageExists :: - -- | Namespace - Namespace -> - -- | Package name - PackageName -> - FloraPage Package +guardThatPackageExists + :: Namespace + -- ^ Namespace + -> PackageName + -- ^ Package name + -> FloraPage Package guardThatPackageExists namespace packageName = do session <- getSession templateEnv <- fromSession session defaultTemplateEnv diff --git a/src/FloraWeb/Server/Logging.hs b/src/FloraWeb/Server/Logging.hs index 02d32d70..b22b3381 100644 --- a/src/FloraWeb/Server/Logging.hs +++ b/src/FloraWeb/Server/Logging.hs @@ -20,13 +20,13 @@ import Effectful.Log.Backend.StandardOutput qualified as Log import Effectful.Time -- | Wrapper around 'Log.runLogT' with necessary metadata -runLog :: - forall (es :: [Effect]) (a :: Type). - (IOE :> es) => - DeploymentEnv -> - Logger -> - Eff (Logging : es) a -> - Eff es a +runLog + :: forall (es :: [Effect]) (a :: Type) + . (IOE :> es) + => DeploymentEnv + -> Logger + -> Eff (Logging : es) a + -> Eff es a runLog env logger logAction = Log.runLogging ("flora-" <> suffix) logger defaultLogLevel logAction where @@ -37,11 +37,11 @@ makeLogger StdOut = Log.withStdOutLogger makeLogger Json = Log.withJsonStdOutLogger makeLogger JSONFile = withJSONFileBackend FileBackendConfig{destinationFile = "logs/flora.json"} -timeAction :: - forall (es :: [Effect]) (a :: Type). - (Time :> es) => - Eff es a -> - Eff es (a, NominalDiffTime) +timeAction + :: forall (es :: [Effect]) (a :: Type) + . (Time :> es) + => Eff es a + -> Eff es (a, NominalDiffTime) timeAction action = do start <- Time.getCurrentTime result <- action diff --git a/src/FloraWeb/Server/Metrics.hs b/src/FloraWeb/Server/Metrics.hs index 4c77ad76..d938f960 100644 --- a/src/FloraWeb/Server/Metrics.hs +++ b/src/FloraWeb/Server/Metrics.hs @@ -33,16 +33,16 @@ normalizeWaiRequestRoute req = pathInfo pathInfo :: Text pathInfo = "/" <> T.intercalate "/" (Wai.pathInfo req) -countRoute :: - -- | handler - Text -> - -- | method - Text -> - -- | status - Text -> - -- | environment - Text -> - IO () +countRoute + :: Text + -- ^ handler + -> Text + -- ^ method + -> Text + -- ^ status + -> Text + -- ^ environment + -> IO () countRoute handler method status_code environment = P.withLabel routeCounter (handler, method, status_code, environment) P.incCounter @@ -55,16 +55,16 @@ routeCounter = info = P.Info "route_counter" "How many times was this route accessed" {-# NOINLINE routeCounter #-} -instrumentHandlerValueWithFilter :: - DeploymentEnv -> - -- | Response filter - (Wai.Response -> Maybe Wai.Response) -> - -- | The function used to derive the "handler" value in Prometheus - (Wai.Request -> Text) -> - -- | The app to instrument - Wai.Application -> - -- | The instrumented app - Wai.Application +instrumentHandlerValueWithFilter + :: DeploymentEnv + -> (Wai.Response -> Maybe Wai.Response) + -- ^ Response filter + -> (Wai.Request -> Text) + -- ^ The function used to derive the "handler" value in Prometheus + -> Wai.Application + -- ^ The app to instrument + -> Wai.Application + -- ^ The instrumented app instrumentHandlerValueWithFilter environment resFilter f app req respond = do start <- getTime Monotonic app req $ \res -> do diff --git a/src/FloraWeb/Server/Pages/Admin.hs b/src/FloraWeb/Server/Pages/Admin.hs index a0282ee8..4ec47e3c 100644 --- a/src/FloraWeb/Server/Pages/Admin.hs +++ b/src/FloraWeb/Server/Pages/Admin.hs @@ -45,7 +45,7 @@ server cfg env = , importIndex = indexImportJobHandler } -{- | This function converts a sub-tree of routes that require 'Admin' role +{-| This function converts a sub-tree of routes that require 'Admin' role to a sub-tree of Flora pages. It acts as the safeguard that rejects non-admins from protected routes. -} diff --git a/src/FloraWeb/Session.hs b/src/FloraWeb/Session.hs index b644db95..86d3e652 100644 --- a/src/FloraWeb/Session.hs +++ b/src/FloraWeb/Session.hs @@ -23,9 +23,9 @@ import Flora.Model.PersistentSession import FloraWeb.Server.Auth.Types import FloraWeb.Types (fetchFloraEnv) -getSession :: - (Reader (Headers '[Header "Set-Cookie" SetCookie] Session) :> es) => - Eff es Session +getSession + :: (Reader (Headers '[Header "Set-Cookie" SetCookie] Session) :> es) + => Eff es Session getSession = asks (getResponse @'[Header "Set-Cookie" SetCookie]) getEnv :: (Reader (Headers '[Header "Set-Cookie" SetCookie] Session) :> es) => Eff es FloraEnv @@ -34,12 +34,12 @@ getEnv = do unsafeEff_ $ fetchFloraEnv webEnvStore -- | This function builds a cookie with the provided content -craftSessionCookie :: - -- | Cookie content - PersistentSessionId -> - -- | Remember the cookie for 1 week - Bool -> - SetCookie +craftSessionCookie + :: PersistentSessionId + -- ^ Cookie content + -> Bool + -- ^ Remember the cookie for 1 week + -> SetCookie craftSessionCookie (PersistentSessionId content) rememberSession = defaultSetCookie { setCookieValue = UUID.toASCIIBytes content @@ -59,10 +59,10 @@ emptySessionCookie = , setCookieMaxAge = Just 0 } -addCookie :: - SetCookie -> - a -> - Headers '[Header "Set-Cookie" SetCookie] a +addCookie + :: SetCookie + -> a + -> Headers '[Header "Set-Cookie" SetCookie] a addCookie = addHeader deleteCookie :: a -> Headers '[Header "Set-Cookie" SetCookie] a diff --git a/src/FloraWeb/Templates/Error.hs b/src/FloraWeb/Templates/Error.hs index d7cf2d91..366b8d18 100644 --- a/src/FloraWeb/Templates/Error.hs +++ b/src/FloraWeb/Templates/Error.hs @@ -14,12 +14,12 @@ import Effectful.Error.Static (Error, throwError) import FloraWeb.Templates import Servant (ServerError (..)) -renderError :: - forall (es :: [Effect]) (a :: Type). - (Error ServerError :> es) => - TemplateEnv -> - Status -> - Eff es a +renderError + :: forall (es :: [Effect]) (a :: Type) + . (Error ServerError :> es) + => TemplateEnv + -> Status + -> Eff es a renderError env status = do let templateEnv = env & (#title .~ "Flora :: *** Exception") let body = mkErrorPage templateEnv $ showError status diff --git a/src/FloraWeb/Templates/Pages/Packages.hs b/src/FloraWeb/Templates/Pages/Packages.hs index a45a58e1..91b8d34d 100644 --- a/src/FloraWeb/Templates/Pages/Packages.hs +++ b/src/FloraWeb/Templates/Pages/Packages.hs @@ -34,17 +34,17 @@ instance Display Target where displayBuilder Dependencies = "dependencies" displayBuilder Versions = "versions" -showPackage :: - Release -> - Vector Release -> - Word -> - Package -> - Vector Package -> - Word -> - Vector (Namespace, PackageName, Text) -> - Word -> - Vector Category -> - FloraHTML +showPackage + :: Release + -> Vector Release + -> Word + -> Package + -> Vector Package + -> Word + -> Vector (Namespace, PackageName, Text) + -> Word + -> Vector Category + -> FloraHTML showPackage latestRelease packageReleases @@ -78,17 +78,17 @@ presentationHeader release namespace name synopsis = do div_ [class_ "synopsis lg:text-xl text-center"] $ p_ [class_ ""] (toHtml synopsis) -packageBody :: - Package -> - Release -> - Vector Release -> - Word -> - Vector (Namespace, PackageName, Text) -> - Word -> - Vector Package -> - Word -> - Vector Category -> - FloraHTML +packageBody + :: Package + -> Release + -> Vector Release + -> Word + -> Vector (Namespace, PackageName, Text) + -> Word + -> Vector Package + -> Word + -> Vector Category + -> FloraHTML packageBody Package{namespace, name = packageName} latestRelease@Release{metadata} @@ -176,14 +176,14 @@ displayVersions namespace packageName versions numberOfReleases = Just ts -> span_ [] (toHtml $ Time.formatTime defaultTimeLocale "%a, %_d %b %Y" ts) -displayDependencies :: - -- | The package namespace and name - (Namespace, PackageName) -> - -- | Number of dependencies - Word -> - -- | (Namespace, Name, Version requirement, Synopsis of the dependency) - Vector (Namespace, PackageName, Text) -> - FloraHTML +displayDependencies + :: (Namespace, PackageName) + -- ^ The package namespace and name + -> Word + -- ^ Number of dependencies + -> Vector (Namespace, PackageName, Text) + -- ^ (Namespace, Name, Version requirement, Synopsis of the dependency) + -> FloraHTML displayDependencies (namespace, packageName) numberOfDependencies dependencies = do li_ [class_ "mb-5"] $ do h3_ [class_ "lg:text-2xl package-body-section mb-3"] (toHtml $ "Dependencies (" <> display numberOfDependencies <> ")") @@ -221,11 +221,11 @@ displayMaintainer maintainerInfo = do h3_ [class_ "lg:text-2xl package-body-section mb-3"] "Maintainer" p_ [class_ "maintainer-info"] (toHtml maintainerInfo) -displayDependents :: - (Namespace, PackageName) -> - Word -> - Vector Package -> - FloraHTML +displayDependents + :: (Namespace, PackageName) + -> Word + -> Vector Package + -> FloraHTML displayDependents (namespace, packageName) numberOfDependents dependents = do li_ [class_ "mb-5 dependents"] $ do h3_ [class_ "lg:text-2xl package-body-section dependents mb-3"] (toHtml $ "Dependents (" <> display numberOfDependents <> ")") diff --git a/src/FloraWeb/Templates/Types.hs b/src/FloraWeb/Templates/Types.hs index f97bbc12..5f50c98e 100644 --- a/src/FloraWeb/Templates/Types.hs +++ b/src/FloraWeb/Templates/Types.hs @@ -105,11 +105,11 @@ defaultsToEnv TemplateDefaults{..} = let sessionId = PersistentSessionId UUID.nil in TemplateEnv{..} -fromSession :: - (MonadIO m) => - Session -> - TemplateDefaults -> - m TemplateEnv +fromSession + :: (MonadIO m) + => Session + -> TemplateDefaults + -> m TemplateEnv fromSession session defaults = do let sessionId = session.sessionId let muser = session.mUser diff --git a/src/Log/Backend/File.hs b/src/Log/Backend/File.hs index 5a51b448..f98a28fa 100644 --- a/src/Log/Backend/File.hs +++ b/src/Log/Backend/File.hs @@ -15,12 +15,12 @@ data FileBackendConfig = FileBackendConfig } deriving stock (Eq, Ord, Show, Generic) -withJSONFileBackend :: - forall (es :: [Effect]) (a :: Type). - IOE :> es => - FileBackendConfig -> - (Logger -> Eff es a) -> - Eff es a +withJSONFileBackend + :: forall (es :: [Effect]) (a :: Type) + . IOE :> es + => FileBackendConfig + -> (Logger -> Eff es a) + -> Eff es a withJSONFileBackend FileBackendConfig{destinationFile} action = do liftIO $ BS.hPutStrLn stdout $ BS.pack $ "Redirecting logs to " <> destinationFile logger <- Log.mkLogger "file-json" $ \msg -> liftIO $ do