├── stack.yaml ├── .gitignore ├── executables └── Main.hs ├── Setup.hs ├── migrations ├── 2017-10-06-00-00-00-rename-packages-to-package-names.sql ├── 2017-10-06-00-00-02-rename-versions-parts-to-content.sql ├── 2017-10-06-00-00-01-rename-package-names-name-to-content.sql ├── 2017-10-09-00-00-08-rename-packages-sequence.sql ├── 2017-10-09-00-00-07-rename-package-names-sequence.sql ├── 2017-10-04-00-00-00-create-packages.sql ├── 2017-10-06-00-00-03-create-licenses.sql ├── 2017-10-05-00-00-00-create-versions.sql ├── 2017-10-06-00-00-05-create-categories.sql ├── 2017-10-09-00-00-00-create-repo-kinds.sql ├── 2017-10-09-00-00-01-create-repo-types.sql ├── 2017-10-17-00-00-01-create-conditions.sql ├── 2017-10-18-00-00-08-create-test-names.sql ├── 2017-10-07-00-00-00-create-module-names.sql ├── 2017-10-07-00-00-01-create-constraints.sql ├── 2017-10-09-00-00-02-populate-repo-types.sql ├── 2017-10-09-00-00-03-populate-repo-kinds.sql ├── 2017-10-17-00-00-00-create-library-names.sql ├── 2017-10-18-00-00-11-create-benchmark-names.sql ├── 2017-10-18-00-00-00-populate-library-names.sql ├── 2017-10-18-00-00-05-create-executable-names.sql ├── 2017-10-13-00-00-03-fix-libraries.sql ├── 2017-10-18-00-00-01-populate-conditions.sql ├── 2017-10-09-00-00-04-alter-repos.sql ├── 2017-10-08-00-00-01-create-repos.sql ├── 2017-10-18-00-00-03-update-libraries.sql ├── 2017-10-13-00-00-00-create-libraries.sql ├── 2017-10-18-00-00-02-alter-libraries.sql ├── 2017-10-08-00-00-02-create-packages-repos.sql ├── 2017-10-18-00-00-04-alter-libraries.sql ├── 2017-10-09-00-00-06-alter-repos-again.sql ├── 2017-10-18-00-00-10-create-dependencies-tests.sql ├── 2017-10-06-00-00-06-create-categories-packages.sql ├── 2017-10-08-00-00-00-create-dependencies.sql ├── 2017-10-13-00-00-01-create-libraries-module-names.sql ├── 2017-10-13-00-00-02-create-dependencies-libraries.sql ├── 2017-10-18-00-00-13-create-dependencies-benchmarks.sql ├── 2017-10-18-00-00-07-create-dependencies-executables.sql ├── 2017-10-09-00-00-05-populate-repos.sql ├── 2017-10-18-00-00-09-create-tests.sql ├── 2017-10-18-00-00-12-create-benchmarks.sql ├── 2017-10-18-00-00-06-create-executables.sql └── 2017-10-06-00-00-04-create-packages.sql ├── .hindent.yaml ├── CHANGELOG.markdown ├── library └── Grawlix │ ├── Options.hs │ ├── Query │ ├── SelectTrue.hs │ ├── InsertLicense.hs │ ├── InsertCategory.hs │ ├── InsertRepoKind.hs │ ├── InsertRepoType.hs │ ├── InsertTestName.hs │ ├── InsertCondition.hs │ ├── InsertConstraint.hs │ ├── InsertLibraryName.hs │ ├── InsertPackageName.hs │ ├── InsertBenchmarkName.hs │ ├── InsertVersion.hs │ ├── InsertExecutableName.hs │ ├── InsertModuleName.hs │ ├── SelectPackageNames.hs │ ├── SelectCategoryId.hs │ ├── SelectRepoKindId.hs │ ├── SelectRepoTypeId.hs │ ├── SelectTestNameId.hs │ ├── SelectConditionId.hs │ ├── SelectConstraintId.hs │ ├── SelectLibraryNameId.hs │ ├── SelectPackageNameId.hs │ ├── InsertPackageRepo.hs │ ├── SelectBenchmarkNameId.hs │ ├── SelectExecutableNameId.hs │ ├── SelectModuleNameId.hs │ ├── InsertDependency.hs │ ├── InsertDependencyTest.hs │ ├── InsertCategoryPackage.hs │ ├── InsertDependencyLibrary.hs │ ├── InsertLibraryModuleName.hs │ ├── InsertRepo.hs │ ├── InsertDependencyBenchmark.hs │ ├── InsertDependencyExecutable.hs │ ├── InsertTest.hs │ ├── InsertLibrary.hs │ ├── InsertBenchmark.hs │ ├── InsertExecutable.hs │ ├── SelectDependencyId.hs │ ├── SelectRepoId.hs │ ├── SelectTestId.hs │ ├── SelectVersions.hs │ ├── SelectLibraryId.hs │ ├── SelectBenchmarkId.hs │ ├── SelectExecutableId.hs │ ├── SelectRevisions.hs │ ├── SelectPackageId.hs │ ├── SelectLibraries.hs │ ├── SelectModules.hs │ ├── InsertPackage.hs │ └── Common.hs │ ├── Type │ ├── Dependency.hs │ ├── Repo.hs │ ├── Test.hs │ ├── RepoId.hs │ ├── TestId.hs │ ├── License.hs │ ├── RepoUrl.hs │ ├── Repos.hs │ ├── Synopsis.hs │ ├── Tests.hs │ ├── Category.hs │ ├── RepoKind.hs │ ├── RepoType.hs │ ├── TestName.hs │ ├── Benchmark.hs │ ├── Condition.hs │ ├── PackageId.hs │ ├── Executable.hs │ ├── PackageUrl.hs │ ├── CategoryId.hs │ ├── Constraint.hs │ ├── RepoKindId.hs │ ├── RepoTypeId.hs │ ├── TestNameId.hs │ ├── Description.hs │ ├── BenchmarkId.hs │ ├── ConditionId.hs │ ├── LibraryName.hs │ ├── ConstraintId.hs │ ├── DependencyId.hs │ ├── ExecutableId.hs │ ├── ModuleNameId.hs │ ├── Libraries.hs │ ├── Library.hs │ ├── BenchmarkName.hs │ ├── LibraryNameId.hs │ ├── PackageNameId.hs │ ├── Revision.hs │ ├── Categories.hs │ ├── Benchmarks.hs │ ├── ExecutableName.hs │ ├── LibraryId.hs │ ├── BenchmarkNameId.hs │ ├── Executables.hs │ ├── ModuleNames.hs │ ├── VersionBound.hs │ ├── ExecutableNameId.hs │ ├── PackageName.hs │ ├── Dependencies.hs │ ├── Options.hs │ ├── ModuleName.hs │ ├── Package.hs │ ├── Version.hs │ ├── Common.hs │ └── Config.hs │ ├── Handler │ ├── Common.hs │ ├── GetHealthCheck.hs │ ├── GetPackages.hs │ ├── GetVersions.hs │ ├── GetRevisions.hs │ ├── GetLibraries.hs │ ├── GetModules.hs │ └── GetHaddock.hs │ ├── Config.hs │ ├── Main.hs │ ├── Database.hs │ ├── Server.hs │ └── Sync.hs ├── README.markdown ├── .travis.yml ├── LICENSE.markdown └── package.yaml /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2017-11-25 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *.cabal 3 | *.hi 4 | *.hp 5 | *.o 6 | *.prof 7 | *.tix 8 | data/ 9 | -------------------------------------------------------------------------------- /executables/Main.hs: -------------------------------------------------------------------------------- 1 | module Main 2 | ( main 3 | ) where 4 | 5 | import Grawlix.Main (main) 6 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import qualified Distribution.Simple as Cabal 2 | 3 | main :: IO () 4 | main = Cabal.defaultMain 5 | -------------------------------------------------------------------------------- /migrations/2017-10-06-00-00-00-rename-packages-to-package-names.sql: -------------------------------------------------------------------------------- 1 | alter table packages rename to package_names 2 | -------------------------------------------------------------------------------- /migrations/2017-10-06-00-00-02-rename-versions-parts-to-content.sql: -------------------------------------------------------------------------------- 1 | alter table versions rename parts to content 2 | -------------------------------------------------------------------------------- /migrations/2017-10-06-00-00-01-rename-package-names-name-to-content.sql: -------------------------------------------------------------------------------- 1 | alter table package_names rename name to content 2 | -------------------------------------------------------------------------------- /migrations/2017-10-09-00-00-08-rename-packages-sequence.sql: -------------------------------------------------------------------------------- 1 | alter sequence packages_id_seq1 2 | rename to packages_id_seq 3 | -------------------------------------------------------------------------------- /migrations/2017-10-09-00-00-07-rename-package-names-sequence.sql: -------------------------------------------------------------------------------- 1 | alter sequence packages_id_seq 2 | rename to package_names_id_seq 3 | -------------------------------------------------------------------------------- /migrations/2017-10-04-00-00-00-create-packages.sql: -------------------------------------------------------------------------------- 1 | create table packages ( 2 | id serial primary key, 3 | name text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-06-00-00-03-create-licenses.sql: -------------------------------------------------------------------------------- 1 | create table licenses ( 2 | id serial primary key, 3 | content text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /.hindent.yaml: -------------------------------------------------------------------------------- 1 | force-trailing-newline: true 2 | indent-size: 2 3 | line-breaks: 4 | - :<|> 5 | - :> 6 | line-length: 79 7 | sort-imports: true 8 | -------------------------------------------------------------------------------- /migrations/2017-10-05-00-00-00-create-versions.sql: -------------------------------------------------------------------------------- 1 | create table versions ( 2 | id serial primary key, 3 | parts integer[] not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-06-00-00-05-create-categories.sql: -------------------------------------------------------------------------------- 1 | create table categories ( 2 | id serial primary key, 3 | content text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-09-00-00-00-create-repo-kinds.sql: -------------------------------------------------------------------------------- 1 | create table repo_kinds ( 2 | id serial primary key, 3 | content text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-09-00-00-01-create-repo-types.sql: -------------------------------------------------------------------------------- 1 | create table repo_types ( 2 | id serial primary key, 3 | content text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-17-00-00-01-create-conditions.sql: -------------------------------------------------------------------------------- 1 | create table conditions ( 2 | id serial primary key, 3 | content text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-08-create-test-names.sql: -------------------------------------------------------------------------------- 1 | create table test_names ( 2 | id serial primary key, 3 | content text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-07-00-00-00-create-module-names.sql: -------------------------------------------------------------------------------- 1 | create table module_names ( 2 | id serial primary key, 3 | content text[] not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-07-00-00-01-create-constraints.sql: -------------------------------------------------------------------------------- 1 | create table constraints ( 2 | id serial primary key, 3 | content text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-09-00-00-02-populate-repo-types.sql: -------------------------------------------------------------------------------- 1 | insert into repo_types ( content ) 2 | select distinct type 3 | from repos 4 | order by type asc 5 | -------------------------------------------------------------------------------- /migrations/2017-10-09-00-00-03-populate-repo-kinds.sql: -------------------------------------------------------------------------------- 1 | insert into repo_kinds ( content ) 2 | select distinct kind 3 | from repos 4 | order by kind asc 5 | -------------------------------------------------------------------------------- /migrations/2017-10-17-00-00-00-create-library-names.sql: -------------------------------------------------------------------------------- 1 | create table library_names ( 2 | id serial primary key, 3 | content text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-11-create-benchmark-names.sql: -------------------------------------------------------------------------------- 1 | create table benchmark_names ( 2 | id serial primary key, 3 | content text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-00-populate-library-names.sql: -------------------------------------------------------------------------------- 1 | insert into library_names ( content ) 2 | select distinct name 3 | from libraries 4 | order by name asc 5 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-05-create-executable-names.sql: -------------------------------------------------------------------------------- 1 | create table executable_names ( 2 | id serial primary key, 3 | content text not null unique 4 | ) 5 | -------------------------------------------------------------------------------- /migrations/2017-10-13-00-00-03-fix-libraries.sql: -------------------------------------------------------------------------------- 1 | alter table libraries 2 | drop constraint libraries_name_conditions_key, 3 | add unique (package_id, name, conditions) 4 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-01-populate-conditions.sql: -------------------------------------------------------------------------------- 1 | insert into conditions ( content ) 2 | select distinct conditions 3 | from libraries 4 | order by conditions asc 5 | -------------------------------------------------------------------------------- /migrations/2017-10-09-00-00-04-alter-repos.sql: -------------------------------------------------------------------------------- 1 | alter table repos 2 | add column repo_kind_id integer references repo_kinds (id), 3 | add column repo_type_id integer references repo_types (id) 4 | -------------------------------------------------------------------------------- /migrations/2017-10-08-00-00-01-create-repos.sql: -------------------------------------------------------------------------------- 1 | create table repos ( 2 | id serial primary key, 3 | kind text not null, 4 | type text not null, 5 | url text not null, 6 | unique (kind, type, url) 7 | ) 8 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-03-update-libraries.sql: -------------------------------------------------------------------------------- 1 | update libraries 2 | set library_name_id = ( select id from library_names where content = libraries.name ), 3 | condition_id = ( select id from conditions where content = libraries.conditions ) 4 | -------------------------------------------------------------------------------- /migrations/2017-10-13-00-00-00-create-libraries.sql: -------------------------------------------------------------------------------- 1 | create table libraries ( 2 | id serial primary key, 3 | package_id integer references packages (id) not null, 4 | name text not null, 5 | conditions text not null, 6 | unique (name, conditions) 7 | ) 8 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-02-alter-libraries.sql: -------------------------------------------------------------------------------- 1 | alter table libraries 2 | add column library_name_id integer references library_names (id), 3 | add column condition_id integer references conditions (id), 4 | add unique (package_id, library_name_id, condition_id) 5 | -------------------------------------------------------------------------------- /CHANGELOG.markdown: -------------------------------------------------------------------------------- 1 | # Change log 2 | 3 | Grawlix uses [Semantic Versioning][]. 4 | Changes are logged the [the releases page][] on GitHub. 5 | 6 | [Semantic Versioning]: http://semver.org/spec/v2.0.0.html 7 | [the releases page]: https://github.com/tfausak/grawlix/releases 8 | -------------------------------------------------------------------------------- /migrations/2017-10-08-00-00-02-create-packages-repos.sql: -------------------------------------------------------------------------------- 1 | create table packages_repos ( 2 | id serial primary key, 3 | package_id integer references packages (id) not null, 4 | repo_id integer references repos (id) not null, 5 | unique (package_id, repo_id) 6 | ) 7 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-04-alter-libraries.sql: -------------------------------------------------------------------------------- 1 | alter table libraries 2 | drop constraint libraries_package_id_name_conditions_key, 3 | drop column name, 4 | drop column conditions, 5 | alter column library_name_id set not null, 6 | alter column condition_id set not null 7 | -------------------------------------------------------------------------------- /migrations/2017-10-09-00-00-06-alter-repos-again.sql: -------------------------------------------------------------------------------- 1 | alter table repos 2 | drop constraint repos_kind_type_url_key, 3 | drop column kind, 4 | drop column type, 5 | alter repo_kind_id set not null, 6 | alter repo_type_id set not null, 7 | add unique (repo_kind_id, repo_type_id, url) 8 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-10-create-dependencies-tests.sql: -------------------------------------------------------------------------------- 1 | create table dependencies_tests ( 2 | id serial primary key, 3 | dependency_id integer references dependencies (id) not null, 4 | test_id integer references tests (id) not null, 5 | unique (dependency_id, test_id) 6 | ) 7 | -------------------------------------------------------------------------------- /migrations/2017-10-06-00-00-06-create-categories-packages.sql: -------------------------------------------------------------------------------- 1 | create table categories_packages ( 2 | id serial primary key, 3 | category_id integer references categories (id) not null, 4 | package_id integer references packages (id) not null, 5 | unique (category_id, package_id) 6 | ) 7 | -------------------------------------------------------------------------------- /migrations/2017-10-08-00-00-00-create-dependencies.sql: -------------------------------------------------------------------------------- 1 | create table dependencies ( 2 | id serial primary key, 3 | constraint_id integer references constraints (id) not null, 4 | package_name_id integer references package_names (id) not null, 5 | unique (constraint_id, package_name_id) 6 | ) 7 | -------------------------------------------------------------------------------- /library/Grawlix/Options.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Options 2 | ( getOptions 3 | ) where 4 | 5 | import Grawlix.Type.Options 6 | 7 | import qualified Data.Text as Text 8 | import qualified Options.Generic as Cli 9 | 10 | getOptions :: IO Options 11 | getOptions = Cli.getRecord $ Text.pack "Grawlix" 12 | -------------------------------------------------------------------------------- /migrations/2017-10-13-00-00-01-create-libraries-module-names.sql: -------------------------------------------------------------------------------- 1 | create table libraries_module_names ( 2 | id serial primary key, 3 | library_id integer references libraries (id) not null, 4 | module_name_id integer references module_names (id) not null, 5 | unique (library_id, module_name_id) 6 | ) 7 | -------------------------------------------------------------------------------- /migrations/2017-10-13-00-00-02-create-dependencies-libraries.sql: -------------------------------------------------------------------------------- 1 | create table dependencies_libraries ( 2 | id serial primary key, 3 | dependency_id integer references dependencies (id) not null, 4 | library_id integer references libraries (id) not null, 5 | unique (dependency_id, library_id) 6 | ) 7 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectTrue.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectTrue 2 | ( selectTrue 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | 7 | import qualified Hasql.Decoders as D 8 | 9 | selectTrue :: Query () Bool 10 | selectTrue = makeQuery "select true" encodeUnit (D.singleRow $ D.value D.bool) 11 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-13-create-dependencies-benchmarks.sql: -------------------------------------------------------------------------------- 1 | create table dependencies_benchmarks ( 2 | id serial primary key, 3 | dependency_id integer references dependencies (id) not null, 4 | benchmark_id integer references benchmarks (id) not null, 5 | unique (dependency_id, benchmark_id) 6 | ) 7 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-07-create-dependencies-executables.sql: -------------------------------------------------------------------------------- 1 | create table dependencies_executables ( 2 | id serial primary key, 3 | dependency_id integer references dependencies (id) not null, 4 | executable_id integer references executables (id) not null, 5 | unique (dependency_id, executable_id) 6 | ) 7 | -------------------------------------------------------------------------------- /migrations/2017-10-09-00-00-05-populate-repos.sql: -------------------------------------------------------------------------------- 1 | update repos 2 | set 3 | repo_kind_id = ( 4 | select repo_kinds.id 5 | from repo_kinds 6 | where repo_kinds.content = repos.kind 7 | ), 8 | repo_type_id = ( 9 | select repo_types.id 10 | from repo_types 11 | where repo_types.content = repos.type 12 | ) 13 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Dependency.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Dependency 2 | ( Dependency(..) 3 | ) where 4 | 5 | import Grawlix.Type.PackageName 6 | import Grawlix.Type.VersionBound 7 | 8 | data Dependency = Dependency 9 | { dependencyPackage :: PackageName 10 | , dependencyVersionBound :: VersionBound 11 | } deriving (Eq, Show) 12 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Repo.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Repo 2 | ( Repo(..) 3 | ) where 4 | 5 | import Grawlix.Type.RepoKind 6 | import Grawlix.Type.RepoType 7 | import Grawlix.Type.RepoUrl 8 | 9 | data Repo = Repo 10 | { repoKind :: RepoKind 11 | , repoType :: RepoType 12 | , repoUrl :: RepoUrl 13 | } deriving (Eq, Ord, Show) 14 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-09-create-tests.sql: -------------------------------------------------------------------------------- 1 | create table tests ( 2 | id serial primary key, 3 | package_id integer references packages (id) not null, 4 | test_name_id integer references test_names (id) not null, 5 | condition_id integer references conditions (id) not null, 6 | unique (package_id, test_name_id, condition_id) 7 | ) 8 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Test.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Test 2 | ( Test(..) 3 | ) where 4 | 5 | import Grawlix.Type.Condition 6 | import Grawlix.Type.Dependencies 7 | import Grawlix.Type.TestName 8 | 9 | data Test = Test 10 | { testName :: TestName 11 | , testCondition :: Condition 12 | , testDependencies :: Dependencies 13 | } deriving (Eq, Ord, Show) 14 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-12-create-benchmarks.sql: -------------------------------------------------------------------------------- 1 | create table benchmarks ( 2 | id serial primary key, 3 | package_id integer references packages (id) not null, 4 | benchmark_name_id integer references benchmark_names (id) not null, 5 | condition_id integer references conditions (id) not null, 6 | unique (package_id, benchmark_name_id, condition_id) 7 | ) 8 | -------------------------------------------------------------------------------- /library/Grawlix/Type/RepoId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.RepoId 2 | ( RepoId 3 | , toRepoId 4 | , fromRepoId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype RepoId = 10 | RepoId Int32 11 | deriving (Eq, Show) 12 | 13 | toRepoId :: Int32 -> RepoId 14 | toRepoId = RepoId 15 | 16 | fromRepoId :: RepoId -> Int32 17 | fromRepoId (RepoId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/TestId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.TestId 2 | ( TestId 3 | , toTestId 4 | , fromTestId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype TestId = 10 | TestId Int32 11 | deriving (Eq, Show) 12 | 13 | toTestId :: Int32 -> TestId 14 | toTestId = TestId 15 | 16 | fromTestId :: TestId -> Int32 17 | fromTestId (TestId x) = x 18 | -------------------------------------------------------------------------------- /migrations/2017-10-18-00-00-06-create-executables.sql: -------------------------------------------------------------------------------- 1 | create table executables ( 2 | id serial primary key, 3 | package_id integer references packages (id) not null, 4 | executable_name_id integer references executable_names (id) not null, 5 | condition_id integer references conditions (id) not null, 6 | unique (package_id, executable_name_id, condition_id) 7 | ) 8 | -------------------------------------------------------------------------------- /library/Grawlix/Type/License.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.License 2 | ( License 3 | , toLicense 4 | , fromLicense 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype License = 10 | License Text 11 | deriving (Eq, Show) 12 | 13 | toLicense :: Text -> License 14 | toLicense = License 15 | 16 | fromLicense :: License -> Text 17 | fromLicense (License x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/RepoUrl.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.RepoUrl 2 | ( RepoUrl 3 | , toRepoUrl 4 | , fromRepoUrl 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype RepoUrl = 10 | RepoUrl Text 11 | deriving (Eq, Ord, Show) 12 | 13 | toRepoUrl :: Text -> RepoUrl 14 | toRepoUrl = RepoUrl 15 | 16 | fromRepoUrl :: RepoUrl -> Text 17 | fromRepoUrl (RepoUrl x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Repos.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Repos 2 | ( Repos 3 | , toRepos 4 | , fromRepos 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | import Grawlix.Type.Repo 9 | 10 | newtype Repos = 11 | Repos (Set Repo) 12 | deriving (Eq, Show) 13 | 14 | toRepos :: Set Repo -> Repos 15 | toRepos = Repos 16 | 17 | fromRepos :: Repos -> Set Repo 18 | fromRepos (Repos x) = x 19 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Synopsis.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Synopsis 2 | ( Synopsis 3 | , toSynopsis 4 | , fromSynopsis 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype Synopsis = 10 | Synopsis Text 11 | deriving (Eq, Show) 12 | 13 | toSynopsis :: Text -> Synopsis 14 | toSynopsis = Synopsis 15 | 16 | fromSynopsis :: Synopsis -> Text 17 | fromSynopsis (Synopsis x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Tests.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Tests 2 | ( Tests 3 | , toTests 4 | , fromTests 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | import Grawlix.Type.Test 9 | 10 | newtype Tests = 11 | Tests (Set Test) 12 | deriving (Eq, Show) 13 | 14 | toTests :: Set Test -> Tests 15 | toTests = Tests 16 | 17 | fromTests :: Tests -> Set Test 18 | fromTests (Tests x) = x 19 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Category.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Category 2 | ( Category 3 | , toCategory 4 | , fromCategory 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype Category = 10 | Category Text 11 | deriving (Eq, Ord, Show) 12 | 13 | toCategory :: Text -> Category 14 | toCategory = Category 15 | 16 | fromCategory :: Category -> Text 17 | fromCategory (Category x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/RepoKind.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.RepoKind 2 | ( RepoKind 3 | , toRepoKind 4 | , fromRepoKind 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype RepoKind = 10 | RepoKind Text 11 | deriving (Eq, Ord, Show) 12 | 13 | toRepoKind :: Text -> RepoKind 14 | toRepoKind = RepoKind 15 | 16 | fromRepoKind :: RepoKind -> Text 17 | fromRepoKind (RepoKind x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/RepoType.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.RepoType 2 | ( RepoType 3 | , toRepoType 4 | , fromRepoType 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype RepoType = 10 | RepoType Text 11 | deriving (Eq, Ord, Show) 12 | 13 | toRepoType :: Text -> RepoType 14 | toRepoType = RepoType 15 | 16 | fromRepoType :: RepoType -> Text 17 | fromRepoType (RepoType x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/TestName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.TestName 2 | ( TestName 3 | , toTestName 4 | , fromTestName 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype TestName = 10 | TestName Text 11 | deriving (Eq, Ord, Show) 12 | 13 | toTestName :: Text -> TestName 14 | toTestName = TestName 15 | 16 | fromTestName :: TestName -> Text 17 | fromTestName (TestName x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Benchmark.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Benchmark 2 | ( Benchmark(..) 3 | ) where 4 | 5 | import Grawlix.Type.BenchmarkName 6 | import Grawlix.Type.Condition 7 | import Grawlix.Type.Dependencies 8 | 9 | data Benchmark = Benchmark 10 | { benchmarkName :: BenchmarkName 11 | , benchmarkCondition :: Condition 12 | , benchmarkDependencies :: Dependencies 13 | } deriving (Eq, Ord, Show) 14 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Condition.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Condition 2 | ( Condition 3 | , toCondition 4 | , fromCondition 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype Condition = 10 | Condition Text 11 | deriving (Eq, Ord, Show) 12 | 13 | toCondition :: Text -> Condition 14 | toCondition = Condition 15 | 16 | fromCondition :: Condition -> Text 17 | fromCondition (Condition x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/PackageId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.PackageId 2 | ( PackageId 3 | , toPackageId 4 | , fromPackageId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype PackageId = 10 | PackageId Int32 11 | deriving (Eq, Show) 12 | 13 | toPackageId :: Int32 -> PackageId 14 | toPackageId = PackageId 15 | 16 | fromPackageId :: PackageId -> Int32 17 | fromPackageId (PackageId x) = x 18 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | # Grawlix 2 | 3 | [![Build badge][]][build status] 4 | 5 | > Grawlix: A string of typographical symbols, especially `@#$%&!`, used 6 | > (especially in comic strips) to represent an obscenity or swearword. 7 | 8 | Grawlix lets you comment on Haskell documentation. 9 | 10 | [Build badge]: https://travis-ci.org/tfausak/grawlix.svg?branch=master 11 | [build status]: https://travis-ci.org/tfausak/grawlix 12 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Executable.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Executable 2 | ( Executable(..) 3 | ) where 4 | 5 | import Grawlix.Type.Condition 6 | import Grawlix.Type.Dependencies 7 | import Grawlix.Type.ExecutableName 8 | 9 | data Executable = Executable 10 | { executableName :: ExecutableName 11 | , executableCondition :: Condition 12 | , executableDependencies :: Dependencies 13 | } deriving (Eq, Ord, Show) 14 | -------------------------------------------------------------------------------- /library/Grawlix/Type/PackageUrl.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.PackageUrl 2 | ( PackageUrl 3 | , toPackageUrl 4 | , fromPackageUrl 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype PackageUrl = 10 | PackageUrl Text 11 | deriving (Eq, Show) 12 | 13 | toPackageUrl :: Text -> PackageUrl 14 | toPackageUrl = PackageUrl 15 | 16 | fromPackageUrl :: PackageUrl -> Text 17 | fromPackageUrl (PackageUrl x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/CategoryId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.CategoryId 2 | ( CategoryId 3 | , toCategoryId 4 | , fromCategoryId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype CategoryId = 10 | CategoryId Int32 11 | deriving (Eq, Show) 12 | 13 | toCategoryId :: Int32 -> CategoryId 14 | toCategoryId = CategoryId 15 | 16 | fromCategoryId :: CategoryId -> Int32 17 | fromCategoryId (CategoryId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Constraint.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Constraint 2 | ( Constraint 3 | , toConstraint 4 | , fromConstraint 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype Constraint = 10 | Constraint Text 11 | deriving (Eq, Ord, Show) 12 | 13 | toConstraint :: Text -> Constraint 14 | toConstraint = Constraint 15 | 16 | fromConstraint :: Constraint -> Text 17 | fromConstraint (Constraint x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/RepoKindId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.RepoKindId 2 | ( RepoKindId 3 | , toRepoKindId 4 | , fromRepoKindId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype RepoKindId = 10 | RepoKindId Int32 11 | deriving (Eq, Show) 12 | 13 | toRepoKindId :: Int32 -> RepoKindId 14 | toRepoKindId = RepoKindId 15 | 16 | fromRepoKindId :: RepoKindId -> Int32 17 | fromRepoKindId (RepoKindId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/RepoTypeId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.RepoTypeId 2 | ( RepoTypeId 3 | , toRepoTypeId 4 | , fromRepoTypeId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype RepoTypeId = 10 | RepoTypeId Int32 11 | deriving (Eq, Show) 12 | 13 | toRepoTypeId :: Int32 -> RepoTypeId 14 | toRepoTypeId = RepoTypeId 15 | 16 | fromRepoTypeId :: RepoTypeId -> Int32 17 | fromRepoTypeId (RepoTypeId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/TestNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.TestNameId 2 | ( TestNameId 3 | , toTestNameId 4 | , fromTestNameId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype TestNameId = 10 | TestNameId Int32 11 | deriving (Eq, Show) 12 | 13 | toTestNameId :: Int32 -> TestNameId 14 | toTestNameId = TestNameId 15 | 16 | fromTestNameId :: TestNameId -> Int32 17 | fromTestNameId (TestNameId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertLicense.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertLicense 2 | ( insertLicense 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.License 7 | 8 | insertLicense :: Query License () 9 | insertLicense = 10 | makeQuery 11 | " insert into licenses ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromLicense encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Description.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Description 2 | ( Description 3 | , toDescription 4 | , fromDescription 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype Description = 10 | Description Text 11 | deriving (Eq, Show) 12 | 13 | toDescription :: Text -> Description 14 | toDescription = Description 15 | 16 | fromDescription :: Description -> Text 17 | fromDescription (Description x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertCategory.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertCategory 2 | ( insertCategory 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.Category 7 | 8 | insertCategory :: Query Category () 9 | insertCategory = 10 | makeQuery 11 | " insert into categories ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromCategory encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertRepoKind.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertRepoKind 2 | ( insertRepoKind 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.RepoKind 7 | 8 | insertRepoKind :: Query RepoKind () 9 | insertRepoKind = 10 | makeQuery 11 | " insert into repo_kinds ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromRepoKind encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertRepoType.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertRepoType 2 | ( insertRepoType 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.RepoType 7 | 8 | insertRepoType :: Query RepoType () 9 | insertRepoType = 10 | makeQuery 11 | " insert into repo_types ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromRepoType encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertTestName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertTestName 2 | ( insertTestName 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.TestName 7 | 8 | insertTestName :: Query TestName () 9 | insertTestName = 10 | makeQuery 11 | " insert into test_names ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromTestName encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Type/BenchmarkId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.BenchmarkId 2 | ( BenchmarkId 3 | , toBenchmarkId 4 | , fromBenchmarkId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype BenchmarkId = 10 | BenchmarkId Int32 11 | deriving (Eq, Show) 12 | 13 | toBenchmarkId :: Int32 -> BenchmarkId 14 | toBenchmarkId = BenchmarkId 15 | 16 | fromBenchmarkId :: BenchmarkId -> Int32 17 | fromBenchmarkId (BenchmarkId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/ConditionId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.ConditionId 2 | ( ConditionId 3 | , toConditionId 4 | , fromConditionId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype ConditionId = 10 | ConditionId Int32 11 | deriving (Eq, Show) 12 | 13 | toConditionId :: Int32 -> ConditionId 14 | toConditionId = ConditionId 15 | 16 | fromConditionId :: ConditionId -> Int32 17 | fromConditionId (ConditionId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/LibraryName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.LibraryName 2 | ( LibraryName 3 | , toLibraryName 4 | , fromLibraryName 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype LibraryName = 10 | LibraryName Text 11 | deriving (Eq, Ord, Show) 12 | 13 | toLibraryName :: Text -> LibraryName 14 | toLibraryName = LibraryName 15 | 16 | fromLibraryName :: LibraryName -> Text 17 | fromLibraryName (LibraryName x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertCondition.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertCondition 2 | ( insertCondition 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.Condition 7 | 8 | insertCondition :: Query Condition () 9 | insertCondition = 10 | makeQuery 11 | " insert into conditions ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromCondition encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertConstraint.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertConstraint 2 | ( insertConstraint 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.Constraint 7 | 8 | insertConstraint :: Query Constraint () 9 | insertConstraint = 10 | makeQuery 11 | " insert into constraints ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromConstraint encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Type/ConstraintId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.ConstraintId 2 | ( ConstraintId 3 | , toConstraintId 4 | , fromConstraintId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype ConstraintId = 10 | ConstraintId Int32 11 | deriving (Eq, Show) 12 | 13 | toConstraintId :: Int32 -> ConstraintId 14 | toConstraintId = ConstraintId 15 | 16 | fromConstraintId :: ConstraintId -> Int32 17 | fromConstraintId (ConstraintId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/DependencyId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.DependencyId 2 | ( DependencyId 3 | , toDependencyId 4 | , fromDependencyId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype DependencyId = 10 | DependencyId Int32 11 | deriving (Eq, Show) 12 | 13 | toDependencyId :: Int32 -> DependencyId 14 | toDependencyId = DependencyId 15 | 16 | fromDependencyId :: DependencyId -> Int32 17 | fromDependencyId (DependencyId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/ExecutableId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.ExecutableId 2 | ( ExecutableId 3 | , toExecutableId 4 | , fromExecutableId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype ExecutableId = 10 | ExecutableId Int32 11 | deriving (Eq, Show) 12 | 13 | toExecutableId :: Int32 -> ExecutableId 14 | toExecutableId = ExecutableId 15 | 16 | fromExecutableId :: ExecutableId -> Int32 17 | fromExecutableId (ExecutableId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/ModuleNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.ModuleNameId 2 | ( ModuleNameId 3 | , toModuleNameId 4 | , fromModuleNameId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype ModuleNameId = 10 | ModuleNameId Int32 11 | deriving (Eq, Show) 12 | 13 | toModuleNameId :: Int32 -> ModuleNameId 14 | toModuleNameId = ModuleNameId 15 | 16 | fromModuleNameId :: ModuleNameId -> Int32 17 | fromModuleNameId (ModuleNameId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Libraries.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Libraries 2 | ( Libraries 3 | , toLibraries 4 | , fromLibraries 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | import Grawlix.Type.Library 9 | 10 | newtype Libraries = 11 | Libraries (Set Library) 12 | deriving (Eq, Show) 13 | 14 | toLibraries :: Set Library -> Libraries 15 | toLibraries = Libraries 16 | 17 | fromLibraries :: Libraries -> Set Library 18 | fromLibraries (Libraries x) = x 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertLibraryName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertLibraryName 2 | ( insertLibraryName 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.LibraryName 7 | 8 | insertLibraryName :: Query LibraryName () 9 | insertLibraryName = 10 | makeQuery 11 | " insert into library_names ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromLibraryName encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertPackageName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertPackageName 2 | ( insertPackageName 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.PackageName 7 | 8 | insertPackageName :: Query PackageName () 9 | insertPackageName = 10 | makeQuery 11 | " insert into package_names ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromPackageName encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Library.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Library 2 | ( Library(..) 3 | ) where 4 | 5 | import Grawlix.Type.Condition 6 | import Grawlix.Type.Dependencies 7 | import Grawlix.Type.LibraryName 8 | import Grawlix.Type.ModuleNames 9 | 10 | data Library = Library 11 | { libraryName :: LibraryName 12 | , libraryCondition :: Condition 13 | , libraryModules :: ModuleNames 14 | , libraryDependencies :: Dependencies 15 | } deriving (Eq, Ord, Show) 16 | -------------------------------------------------------------------------------- /library/Grawlix/Handler/Common.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Handler.Common 2 | ( Capture 3 | , Connection 4 | , Get 5 | , Handler 6 | , HTML 7 | , JSON 8 | , (:>) 9 | , liftIO 10 | , runQuery 11 | ) where 12 | 13 | import Control.Monad.IO.Class (liftIO) 14 | import Grawlix.Database (runQuery) 15 | import Hasql.Connection (Connection) 16 | import Servant.API ((:>), Capture, Get, JSON) 17 | import Servant.HTML.Lucid (HTML) 18 | import Servant.Server (Handler) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Type/BenchmarkName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.BenchmarkName 2 | ( BenchmarkName 3 | , toBenchmarkName 4 | , fromBenchmarkName 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype BenchmarkName = 10 | BenchmarkName Text 11 | deriving (Eq, Ord, Show) 12 | 13 | toBenchmarkName :: Text -> BenchmarkName 14 | toBenchmarkName = BenchmarkName 15 | 16 | fromBenchmarkName :: BenchmarkName -> Text 17 | fromBenchmarkName (BenchmarkName x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/LibraryNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.LibraryNameId 2 | ( LibraryNameId 3 | , toLibraryNameId 4 | , fromLibraryNameId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype LibraryNameId = 10 | LibraryNameId Int32 11 | deriving (Eq, Show) 12 | 13 | toLibraryNameId :: Int32 -> LibraryNameId 14 | toLibraryNameId = LibraryNameId 15 | 16 | fromLibraryNameId :: LibraryNameId -> Int32 17 | fromLibraryNameId (LibraryNameId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/PackageNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.PackageNameId 2 | ( PackageNameId 3 | , toPackageNameId 4 | , fromPackageNameId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype PackageNameId = 10 | PackageNameId Int32 11 | deriving (Eq, Show) 12 | 13 | toPackageNameId :: Int32 -> PackageNameId 14 | toPackageNameId = PackageNameId 15 | 16 | fromPackageNameId :: PackageNameId -> Int32 17 | fromPackageNameId (PackageNameId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Revision.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | 3 | module Grawlix.Type.Revision 4 | ( Revision 5 | , toRevision 6 | , fromRevision 7 | ) where 8 | 9 | import Grawlix.Type.Common 10 | 11 | newtype Revision = 12 | Revision Int32 13 | deriving (Eq, FromHttpApiData, Show, ToJSON) 14 | 15 | toRevision :: Int32 -> Revision 16 | toRevision = Revision 17 | 18 | fromRevision :: Revision -> Int32 19 | fromRevision (Revision x) = x 20 | -------------------------------------------------------------------------------- /migrations/2017-10-06-00-00-04-create-packages.sql: -------------------------------------------------------------------------------- 1 | create table packages ( 2 | id serial primary key, 3 | package_name_id integer references package_names (id) not null, 4 | version_id integer references versions (id) not null, 5 | revision integer not null, 6 | license_id integer references licenses (id) not null, 7 | synopsis text not null, 8 | description text not null, 9 | url text not null, 10 | unique (package_name_id, version_id, revision) 11 | ) 12 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Categories.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Categories 2 | ( Categories 3 | , toCategories 4 | , fromCategories 5 | ) where 6 | 7 | import Grawlix.Type.Category 8 | import Grawlix.Type.Common 9 | 10 | newtype Categories = 11 | Categories (Set Category) 12 | deriving (Eq, Show) 13 | 14 | toCategories :: Set Category -> Categories 15 | toCategories = Categories 16 | 17 | fromCategories :: Categories -> Set Category 18 | fromCategories (Categories x) = x 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertBenchmarkName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertBenchmarkName 2 | ( insertBenchmarkName 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.BenchmarkName 7 | 8 | insertBenchmarkName :: Query BenchmarkName () 9 | insertBenchmarkName = 10 | makeQuery 11 | " insert into benchmark_names ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromBenchmarkName encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertVersion.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertVersion 2 | ( insertVersion 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.Version 7 | 8 | import qualified Hasql.Encoders as E 9 | 10 | insertVersion :: Query Version () 11 | insertVersion = 12 | makeQuery 13 | " insert into versions ( content ) \ 14 | \ values ( $1 ) \ 15 | \ on conflict do nothing " 16 | (contramap fromVersion $ encodeList E.int4) 17 | decodeUnit 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Benchmarks.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Benchmarks 2 | ( Benchmarks 3 | , toBenchmarks 4 | , fromBenchmarks 5 | ) where 6 | 7 | import Grawlix.Type.Benchmark 8 | import Grawlix.Type.Common 9 | 10 | newtype Benchmarks = 11 | Benchmarks (Set Benchmark) 12 | deriving (Eq, Show) 13 | 14 | toBenchmarks :: Set Benchmark -> Benchmarks 15 | toBenchmarks = Benchmarks 16 | 17 | fromBenchmarks :: Benchmarks -> Set Benchmark 18 | fromBenchmarks (Benchmarks x) = x 19 | -------------------------------------------------------------------------------- /library/Grawlix/Type/ExecutableName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.ExecutableName 2 | ( ExecutableName 3 | , toExecutableName 4 | , fromExecutableName 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype ExecutableName = 10 | ExecutableName Text 11 | deriving (Eq, Ord, Show) 12 | 13 | toExecutableName :: Text -> ExecutableName 14 | toExecutableName = ExecutableName 15 | 16 | fromExecutableName :: ExecutableName -> Text 17 | fromExecutableName (ExecutableName x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/LibraryId.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | 3 | module Grawlix.Type.LibraryId 4 | ( LibraryId 5 | , toLibraryId 6 | , fromLibraryId 7 | ) where 8 | 9 | import Grawlix.Type.Common 10 | 11 | newtype LibraryId = 12 | LibraryId Int32 13 | deriving (Eq, FromHttpApiData, Show, ToJSON) 14 | 15 | toLibraryId :: Int32 -> LibraryId 16 | toLibraryId = LibraryId 17 | 18 | fromLibraryId :: LibraryId -> Int32 19 | fromLibraryId (LibraryId x) = x 20 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertExecutableName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertExecutableName 2 | ( insertExecutableName 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ExecutableName 7 | 8 | insertExecutableName :: Query ExecutableName () 9 | insertExecutableName = 10 | makeQuery 11 | " insert into executable_names ( content ) \ 12 | \ values ( $1 ) \ 13 | \ on conflict do nothing " 14 | (contramap fromExecutableName encodeText) 15 | decodeUnit 16 | -------------------------------------------------------------------------------- /library/Grawlix/Type/BenchmarkNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.BenchmarkNameId 2 | ( BenchmarkNameId 3 | , toBenchmarkNameId 4 | , fromBenchmarkNameId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype BenchmarkNameId = 10 | BenchmarkNameId Int32 11 | deriving (Eq, Show) 12 | 13 | toBenchmarkNameId :: Int32 -> BenchmarkNameId 14 | toBenchmarkNameId = BenchmarkNameId 15 | 16 | fromBenchmarkNameId :: BenchmarkNameId -> Int32 17 | fromBenchmarkNameId (BenchmarkNameId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Executables.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Executables 2 | ( Executables 3 | , toExecutables 4 | , fromExecutables 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | import Grawlix.Type.Executable 9 | 10 | newtype Executables = 11 | Executables (Set Executable) 12 | deriving (Eq, Show) 13 | 14 | toExecutables :: Set Executable -> Executables 15 | toExecutables = Executables 16 | 17 | fromExecutables :: Executables -> Set Executable 18 | fromExecutables (Executables x) = x 19 | -------------------------------------------------------------------------------- /library/Grawlix/Type/ModuleNames.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.ModuleNames 2 | ( ModuleNames 3 | , toModuleNames 4 | , fromModuleNames 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | import Grawlix.Type.ModuleName 9 | 10 | newtype ModuleNames = 11 | ModuleNames (Set ModuleName) 12 | deriving (Eq, Ord, Show) 13 | 14 | toModuleNames :: Set ModuleName -> ModuleNames 15 | toModuleNames = ModuleNames 16 | 17 | fromModuleNames :: ModuleNames -> Set ModuleName 18 | fromModuleNames (ModuleNames x) = x 19 | -------------------------------------------------------------------------------- /library/Grawlix/Type/VersionBound.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.VersionBound 2 | ( VersionBound 3 | , toVersionBound 4 | , fromVersionBound 5 | ) where 6 | 7 | import qualified Distribution.Version as Cabal 8 | 9 | newtype VersionBound = 10 | VersionBound Cabal.VersionRange 11 | deriving (Eq, Show) 12 | 13 | toVersionBound :: Cabal.VersionRange -> VersionBound 14 | toVersionBound = VersionBound 15 | 16 | fromVersionBound :: VersionBound -> Cabal.VersionRange 17 | fromVersionBound (VersionBound x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertModuleName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertModuleName 2 | ( insertModuleName 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ModuleName 7 | 8 | import qualified Hasql.Encoders as E 9 | 10 | insertModuleName :: Query ModuleName () 11 | insertModuleName = 12 | makeQuery 13 | " insert into module_names ( content ) \ 14 | \ values ( $1 ) \ 15 | \ on conflict do nothing " 16 | (contramap fromModuleName $ encodeList E.text) 17 | decodeUnit 18 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectPackageNames.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectPackageNames 2 | ( selectPackageNames 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.PackageName 7 | 8 | import qualified Hasql.Decoders as D 9 | 10 | selectPackageNames :: Query () [PackageName] 11 | selectPackageNames = 12 | makeQuery 13 | " select distinct content \ 14 | \ from package_names \ 15 | \ order by content asc " 16 | encodeUnit 17 | (map toPackageName <$> D.rowsList decodeText) 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/ExecutableNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.ExecutableNameId 2 | ( ExecutableNameId 3 | , toExecutableNameId 4 | , fromExecutableNameId 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | newtype ExecutableNameId = 10 | ExecutableNameId Int32 11 | deriving (Eq, Show) 12 | 13 | toExecutableNameId :: Int32 -> ExecutableNameId 14 | toExecutableNameId = ExecutableNameId 15 | 16 | fromExecutableNameId :: ExecutableNameId -> Int32 17 | fromExecutableNameId (ExecutableNameId x) = x 18 | -------------------------------------------------------------------------------- /library/Grawlix/Type/PackageName.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | 3 | module Grawlix.Type.PackageName 4 | ( PackageName 5 | , toPackageName 6 | , fromPackageName 7 | ) where 8 | 9 | import Grawlix.Type.Common 10 | 11 | newtype PackageName = 12 | PackageName Text 13 | deriving (Eq, FromHttpApiData, Ord, Show, ToJSON) 14 | 15 | toPackageName :: Text -> PackageName 16 | toPackageName = PackageName 17 | 18 | fromPackageName :: PackageName -> Text 19 | fromPackageName (PackageName x) = x 20 | -------------------------------------------------------------------------------- /library/Grawlix/Handler/GetHealthCheck.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | 4 | module Grawlix.Handler.GetHealthCheck 5 | ( GetHealthCheck 6 | , getHealthCheckHandler 7 | ) where 8 | 9 | import Grawlix.Handler.Common 10 | import Grawlix.Query.SelectTrue 11 | 12 | type GetHealthCheck 13 | = "health-check" 14 | :> Get '[ JSON] Bool 15 | 16 | getHealthCheckHandler :: Connection -> Handler Bool 17 | getHealthCheckHandler connection = liftIO $ runQuery connection selectTrue () 18 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectCategoryId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectCategoryId 2 | ( selectCategoryId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.Category 7 | import Grawlix.Type.CategoryId 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectCategoryId :: Query Category CategoryId 12 | selectCategoryId = 13 | makeQuery 14 | " select id \ 15 | \ from categories \ 16 | \ where content = $1 " 17 | (contramap fromCategory encodeText) 18 | (toCategoryId <$> D.singleRow decodeInt32) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectRepoKindId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectRepoKindId 2 | ( selectRepoKindId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.RepoKind 7 | import Grawlix.Type.RepoKindId 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectRepoKindId :: Query RepoKind RepoKindId 12 | selectRepoKindId = 13 | makeQuery 14 | " select id \ 15 | \ from repo_kinds \ 16 | \ where content = $1 " 17 | (contramap fromRepoKind encodeText) 18 | (toRepoKindId <$> D.singleRow decodeInt32) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectRepoTypeId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectRepoTypeId 2 | ( selectRepoTypeId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.RepoType 7 | import Grawlix.Type.RepoTypeId 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectRepoTypeId :: Query RepoType RepoTypeId 12 | selectRepoTypeId = 13 | makeQuery 14 | " select id \ 15 | \ from repo_types \ 16 | \ where content = $1 " 17 | (contramap fromRepoType encodeText) 18 | (toRepoTypeId <$> D.singleRow decodeInt32) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectTestNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectTestNameId 2 | ( selectTestNameId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.TestName 7 | import Grawlix.Type.TestNameId 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectTestNameId :: Query TestName TestNameId 12 | selectTestNameId = 13 | makeQuery 14 | " select id \ 15 | \ from test_names \ 16 | \ where content = $1 " 17 | (contramap fromTestName encodeText) 18 | (toTestNameId <$> D.singleRow decodeInt32) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Config.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Config 2 | ( getConfig 3 | ) where 4 | 5 | import Grawlix.Type.Config 6 | import Grawlix.Type.Options 7 | 8 | import qualified Data.Yaml as Yaml 9 | 10 | getConfig :: Options -> IO Config 11 | getConfig options = 12 | case optionsConfigFile options of 13 | Nothing -> pure defaultConfig 14 | Just file -> do 15 | result <- Yaml.decodeFileEither file 16 | case result of 17 | Left problem -> fail $ Yaml.prettyPrintParseException problem 18 | Right config -> pure config 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectConditionId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectConditionId 2 | ( selectConditionId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.Condition 7 | import Grawlix.Type.ConditionId 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectConditionId :: Query Condition ConditionId 12 | selectConditionId = 13 | makeQuery 14 | " select id \ 15 | \ from conditions \ 16 | \ where content = $1 " 17 | (contramap fromCondition encodeText) 18 | (toConditionId <$> D.singleRow decodeInt32) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectConstraintId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectConstraintId 2 | ( selectConstraintId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.Constraint 7 | import Grawlix.Type.ConstraintId 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectConstraintId :: Query Constraint ConstraintId 12 | selectConstraintId = 13 | makeQuery 14 | " select id \ 15 | \ from constraints \ 16 | \ where content = $1 " 17 | (contramap fromConstraint encodeText) 18 | (toConstraintId <$> D.singleRow decodeInt32) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Handler/GetPackages.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | 4 | module Grawlix.Handler.GetPackages 5 | ( GetPackages 6 | , getPackagesHandler 7 | ) where 8 | 9 | import Grawlix.Handler.Common 10 | import Grawlix.Query.SelectPackageNames 11 | import Grawlix.Type.PackageName 12 | 13 | type GetPackages 14 | = "packages" 15 | :> Get '[ JSON] [PackageName] 16 | 17 | getPackagesHandler :: Connection -> Handler [PackageName] 18 | getPackagesHandler connection = 19 | liftIO $ runQuery connection selectPackageNames () 20 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectLibraryNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectLibraryNameId 2 | ( selectLibraryNameId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.LibraryName 7 | import Grawlix.Type.LibraryNameId 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectLibraryNameId :: Query LibraryName LibraryNameId 12 | selectLibraryNameId = 13 | makeQuery 14 | " select id \ 15 | \ from library_names \ 16 | \ where content = $1 " 17 | (contramap fromLibraryName encodeText) 18 | (toLibraryNameId <$> D.singleRow decodeInt32) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectPackageNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectPackageNameId 2 | ( selectPackageNameId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.PackageName 7 | import Grawlix.Type.PackageNameId 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectPackageNameId :: Query PackageName PackageNameId 12 | selectPackageNameId = 13 | makeQuery 14 | " select id \ 15 | \ from package_names \ 16 | \ where content = $1 " 17 | (contramap fromPackageName encodeText) 18 | (toPackageNameId <$> D.singleRow decodeInt32) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertPackageRepo.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertPackageRepo 2 | ( insertPackageRepo 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.PackageId 7 | import Grawlix.Type.RepoId 8 | 9 | insertPackageRepo :: Query (PackageId, RepoId) () 10 | insertPackageRepo = 11 | makeQuery 12 | " insert into packages_repos ( package_id, repo_id ) \ 13 | \ values ( $1, $2 ) \ 14 | \ on conflict do nothing " 15 | (contrazip2 16 | (contramap fromPackageId encodeInt32) 17 | (contramap fromRepoId encodeInt32)) 18 | decodeUnit 19 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Dependencies.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Dependencies 2 | ( Dependencies 3 | , toDependencies 4 | , fromDependencies 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | import Grawlix.Type.Constraint 9 | import Grawlix.Type.PackageName 10 | 11 | newtype Dependencies = 12 | Dependencies (Map PackageName Constraint) 13 | deriving (Eq, Ord, Show) 14 | 15 | toDependencies :: Map PackageName Constraint -> Dependencies 16 | toDependencies = Dependencies 17 | 18 | fromDependencies :: Dependencies -> Map PackageName Constraint 19 | fromDependencies (Dependencies x) = x 20 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectBenchmarkNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectBenchmarkNameId 2 | ( selectBenchmarkNameId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.BenchmarkName 7 | import Grawlix.Type.BenchmarkNameId 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectBenchmarkNameId :: Query BenchmarkName BenchmarkNameId 12 | selectBenchmarkNameId = 13 | makeQuery 14 | " select id \ 15 | \ from benchmark_names \ 16 | \ where content = $1 " 17 | (contramap fromBenchmarkName encodeText) 18 | (toBenchmarkNameId <$> D.singleRow decodeInt32) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | 3 | module Grawlix.Type.Options 4 | ( Options(..) 5 | ) where 6 | 7 | import Grawlix.Type.Common 8 | 9 | import qualified Data.Aeson as Json 10 | import qualified Options.Generic as Cli 11 | 12 | newtype Options = Options 13 | { optionsConfigFile :: Maybe FilePath 14 | } deriving (Eq, Generic, Show) 15 | 16 | instance Cli.ParseRecord Options where 17 | parseRecord = 18 | Cli.parseRecordWithModifiers 19 | Cli.defaultModifiers 20 | {Cli.fieldNameModifier = Json.camelTo2 '-' . partialDropPrefix "options"} 21 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectExecutableNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectExecutableNameId 2 | ( selectExecutableNameId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ExecutableName 7 | import Grawlix.Type.ExecutableNameId 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectExecutableNameId :: Query ExecutableName ExecutableNameId 12 | selectExecutableNameId = 13 | makeQuery 14 | " select id \ 15 | \ from executable_names \ 16 | \ where content = $1 " 17 | (contramap fromExecutableName encodeText) 18 | (toExecutableNameId <$> D.singleRow decodeInt32) 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectModuleNameId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectModuleNameId 2 | ( selectModuleNameId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ModuleName 7 | import Grawlix.Type.ModuleNameId 8 | 9 | import qualified Hasql.Decoders as D 10 | import qualified Hasql.Encoders as E 11 | 12 | selectModuleNameId :: Query ModuleName ModuleNameId 13 | selectModuleNameId = 14 | makeQuery 15 | " select id \ 16 | \ from module_names \ 17 | \ where content = $1 " 18 | (contramap fromModuleName $ encodeList E.text) 19 | (toModuleNameId <$> D.singleRow decodeInt32) 20 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertDependency.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertDependency 2 | ( insertDependency 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ConstraintId 7 | import Grawlix.Type.PackageNameId 8 | 9 | insertDependency :: Query (ConstraintId, PackageNameId) () 10 | insertDependency = 11 | makeQuery 12 | " insert into dependencies ( constraint_id, package_name_id ) \ 13 | \ values ( $1, $2 ) \ 14 | \ on conflict do nothing " 15 | (contrazip2 16 | (contramap fromConstraintId encodeInt32) 17 | (contramap fromPackageNameId encodeInt32)) 18 | decodeUnit 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertDependencyTest.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertDependencyTest 2 | ( insertDependencyTest 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.DependencyId 7 | import Grawlix.Type.TestId 8 | 9 | insertDependencyTest :: Query (DependencyId, TestId) () 10 | insertDependencyTest = 11 | makeQuery 12 | " insert into dependencies_tests ( dependency_id, test_id ) \ 13 | \ values ( $1, $2 ) \ 14 | \ on conflict do nothing " 15 | (contrazip2 16 | (contramap fromDependencyId encodeInt32) 17 | (contramap fromTestId encodeInt32)) 18 | decodeUnit 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertCategoryPackage.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertCategoryPackage 2 | ( insertCategoryPackage 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.CategoryId 7 | import Grawlix.Type.PackageId 8 | 9 | insertCategoryPackage :: Query (CategoryId, PackageId) () 10 | insertCategoryPackage = 11 | makeQuery 12 | " insert into categories_packages ( category_id, package_id ) \ 13 | \ values ( $1, $2 ) \ 14 | \ on conflict do nothing " 15 | (contrazip2 16 | (contramap fromCategoryId encodeInt32) 17 | (contramap fromPackageId encodeInt32)) 18 | decodeUnit 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertDependencyLibrary.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertDependencyLibrary 2 | ( insertDependencyLibrary 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.DependencyId 7 | import Grawlix.Type.LibraryId 8 | 9 | insertDependencyLibrary :: Query (DependencyId, LibraryId) () 10 | insertDependencyLibrary = 11 | makeQuery 12 | " insert into dependencies_libraries ( dependency_id, library_id ) \ 13 | \ values ( $1, $2 ) \ 14 | \ on conflict do nothing " 15 | (contrazip2 16 | (contramap fromDependencyId encodeInt32) 17 | (contramap fromLibraryId encodeInt32)) 18 | decodeUnit 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertLibraryModuleName.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertLibraryModuleName 2 | ( insertLibraryModuleName 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.LibraryId 7 | import Grawlix.Type.ModuleNameId 8 | 9 | insertLibraryModuleName :: Query (LibraryId, ModuleNameId) () 10 | insertLibraryModuleName = 11 | makeQuery 12 | " insert into libraries_module_names ( library_id, module_name_id ) \ 13 | \ values ( $1, $2 ) \ 14 | \ on conflict do nothing " 15 | (contrazip2 16 | (contramap fromLibraryId encodeInt32) 17 | (contramap fromModuleNameId encodeInt32)) 18 | decodeUnit 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertRepo.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertRepo 2 | ( insertRepo 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.RepoKindId 7 | import Grawlix.Type.RepoTypeId 8 | import Grawlix.Type.RepoUrl 9 | 10 | insertRepo :: Query (RepoKindId, RepoTypeId, RepoUrl) () 11 | insertRepo = 12 | makeQuery 13 | " insert into repos ( repo_kind_id, repo_type_id, url ) \ 14 | \ values ( $1, $2, $3 ) \ 15 | \ on conflict do nothing " 16 | (contrazip3 17 | (contramap fromRepoKindId encodeInt32) 18 | (contramap fromRepoTypeId encodeInt32) 19 | (contramap fromRepoUrl encodeText)) 20 | decodeUnit 21 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertDependencyBenchmark.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertDependencyBenchmark 2 | ( insertDependencyBenchmark 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.BenchmarkId 7 | import Grawlix.Type.DependencyId 8 | 9 | insertDependencyBenchmark :: Query (DependencyId, BenchmarkId) () 10 | insertDependencyBenchmark = 11 | makeQuery 12 | " insert into dependencies_benchmarks ( dependency_id, benchmark_id ) \ 13 | \ values ( $1, $2 ) \ 14 | \ on conflict do nothing " 15 | (contrazip2 16 | (contramap fromDependencyId encodeInt32) 17 | (contramap fromBenchmarkId encodeInt32)) 18 | decodeUnit 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertDependencyExecutable.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertDependencyExecutable 2 | ( insertDependencyExecutable 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.DependencyId 7 | import Grawlix.Type.ExecutableId 8 | 9 | insertDependencyExecutable :: Query (DependencyId, ExecutableId) () 10 | insertDependencyExecutable = 11 | makeQuery 12 | " insert into dependencies_executables ( dependency_id, executable_id ) \ 13 | \ values ( $1, $2 ) \ 14 | \ on conflict do nothing " 15 | (contrazip2 16 | (contramap fromDependencyId encodeInt32) 17 | (contramap fromExecutableId encodeInt32)) 18 | decodeUnit 19 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertTest.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertTest 2 | ( insertTest 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ConditionId 7 | import Grawlix.Type.PackageId 8 | import Grawlix.Type.TestNameId 9 | 10 | insertTest :: Query (PackageId, TestNameId, ConditionId) () 11 | insertTest = 12 | makeQuery 13 | " insert into tests ( package_id, test_name_id, condition_id ) \ 14 | \ values ( $1, $2, $3 ) \ 15 | \ on conflict do nothing " 16 | (contrazip3 17 | (contramap fromPackageId encodeInt32) 18 | (contramap fromTestNameId encodeInt32) 19 | (contramap fromConditionId encodeInt32)) 20 | decodeUnit 21 | -------------------------------------------------------------------------------- /library/Grawlix/Handler/GetVersions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | 4 | module Grawlix.Handler.GetVersions 5 | ( GetVersions 6 | , getVersionsHandler 7 | ) where 8 | 9 | import Grawlix.Handler.Common 10 | import Grawlix.Query.SelectVersions 11 | import Grawlix.Type.PackageName 12 | import Grawlix.Type.Version 13 | 14 | type GetVersions 15 | = "packages" 16 | :> Capture "package" PackageName 17 | :> "versions" 18 | :> Get '[ JSON] [Version] 19 | 20 | getVersionsHandler :: Connection -> PackageName -> Handler [Version] 21 | getVersionsHandler connection package = 22 | liftIO $ runQuery connection selectVersions package 23 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertLibrary.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertLibrary 2 | ( insertLibrary 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ConditionId 7 | import Grawlix.Type.LibraryNameId 8 | import Grawlix.Type.PackageId 9 | 10 | insertLibrary :: Query (PackageId, LibraryNameId, ConditionId) () 11 | insertLibrary = 12 | makeQuery 13 | " insert into libraries ( package_id, library_name_id, condition_id ) \ 14 | \ values ( $1, $2, $3 ) \ 15 | \ on conflict do nothing " 16 | (contrazip3 17 | (contramap fromPackageId encodeInt32) 18 | (contramap fromLibraryNameId encodeInt32) 19 | (contramap fromConditionId encodeInt32)) 20 | decodeUnit 21 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertBenchmark.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertBenchmark 2 | ( insertBenchmark 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.BenchmarkNameId 7 | import Grawlix.Type.ConditionId 8 | import Grawlix.Type.PackageId 9 | 10 | insertBenchmark :: Query (PackageId, BenchmarkNameId, ConditionId) () 11 | insertBenchmark = 12 | makeQuery 13 | " insert into benchmarks ( package_id, benchmark_name_id, condition_id ) \ 14 | \ values ( $1, $2, $3 ) \ 15 | \ on conflict do nothing " 16 | (contrazip3 17 | (contramap fromPackageId encodeInt32) 18 | (contramap fromBenchmarkNameId encodeInt32) 19 | (contramap fromConditionId encodeInt32)) 20 | decodeUnit 21 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertExecutable.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertExecutable 2 | ( insertExecutable 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ConditionId 7 | import Grawlix.Type.ExecutableNameId 8 | import Grawlix.Type.PackageId 9 | 10 | insertExecutable :: Query (PackageId, ExecutableNameId, ConditionId) () 11 | insertExecutable = 12 | makeQuery 13 | " insert into executables ( package_id, executable_name_id, condition_id ) \ 14 | \ values ( $1, $2, $3 ) \ 15 | \ on conflict do nothing " 16 | (contrazip3 17 | (contramap fromPackageId encodeInt32) 18 | (contramap fromExecutableNameId encodeInt32) 19 | (contramap fromConditionId encodeInt32)) 20 | decodeUnit 21 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectDependencyId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectDependencyId 2 | ( selectDependencyId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ConstraintId 7 | import Grawlix.Type.DependencyId 8 | import Grawlix.Type.PackageNameId 9 | 10 | import qualified Hasql.Decoders as D 11 | 12 | selectDependencyId :: Query (ConstraintId, PackageNameId) DependencyId 13 | selectDependencyId = 14 | makeQuery 15 | " select id \ 16 | \ from dependencies \ 17 | \ where constraint_id = $1 \ 18 | \ and package_name_id = $2 " 19 | (contrazip2 20 | (contramap fromConstraintId encodeInt32) 21 | (contramap fromPackageNameId encodeInt32)) 22 | (toDependencyId <$> D.singleRow decodeInt32) 23 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: generic 2 | 3 | addons: 4 | apt: 5 | packages: 6 | - libgmp-dev 7 | 8 | cache: 9 | directories: 10 | - $HOME/.local/bin 11 | - $HOME/.stack 12 | 13 | before_install: 14 | - | 15 | if ! test -f "$HOME/.local/bin/stack" 16 | then 17 | curl --location 'https://www.stackage.org/stack/linux-x86_64' > stack.tar.gz 18 | gunzip stack.tar.gz 19 | tar --extract --file stack.tar --strip-components 1 20 | mkdir --parents "$HOME/.local/bin" 21 | mv stack "$HOME/.local/bin/" 22 | rm stack.tar 23 | fi 24 | stack --version 25 | 26 | install: 27 | - stack setup 28 | - stack build --only-dependencies 29 | 30 | script: 31 | - stack build --pedantic 32 | - stack sdist --pvp-bounds both 33 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectRepoId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectRepoId 2 | ( selectRepoId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.RepoId 7 | import Grawlix.Type.RepoKindId 8 | import Grawlix.Type.RepoTypeId 9 | import Grawlix.Type.RepoUrl 10 | 11 | import qualified Hasql.Decoders as D 12 | 13 | selectRepoId :: Query (RepoKindId, RepoTypeId, RepoUrl) RepoId 14 | selectRepoId = 15 | makeQuery 16 | " select id \ 17 | \ from repos \ 18 | \ where repo_kind_id = $1 \ 19 | \ and repo_type_id = $2 \ 20 | \ and url = $3 " 21 | (contrazip3 22 | (contramap fromRepoKindId encodeInt32) 23 | (contramap fromRepoTypeId encodeInt32) 24 | (contramap fromRepoUrl encodeText)) 25 | (toRepoId <$> D.singleRow decodeInt32) 26 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectTestId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectTestId 2 | ( selectTestId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ConditionId 7 | import Grawlix.Type.PackageId 8 | import Grawlix.Type.TestId 9 | import Grawlix.Type.TestNameId 10 | 11 | import qualified Hasql.Decoders as D 12 | 13 | selectTestId :: Query (PackageId, TestNameId, ConditionId) TestId 14 | selectTestId = 15 | makeQuery 16 | " select id \ 17 | \ from tests \ 18 | \ where package_id = $1 \ 19 | \ and test_name_id = $2 \ 20 | \ and condition_id = $3 " 21 | (contrazip3 22 | (contramap fromPackageId encodeInt32) 23 | (contramap fromTestNameId encodeInt32) 24 | (contramap fromConditionId encodeInt32)) 25 | (toTestId <$> D.singleRow decodeInt32) 26 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectVersions.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectVersions 2 | ( selectVersions 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.PackageName 7 | import Grawlix.Type.Version 8 | 9 | import qualified Hasql.Decoders as D 10 | 11 | selectVersions :: Query PackageName [Version] 12 | selectVersions = 13 | makeQuery 14 | " select distinct versions.content \ 15 | \ from versions \ 16 | \ inner join packages \ 17 | \ on packages.version_id = versions.id \ 18 | \ inner join package_names \ 19 | \ on package_names.id = packages.package_name_id \ 20 | \ where package_names.content = $1 \ 21 | \ order by versions.content asc " 22 | (contramap fromPackageName encodeText) 23 | (fmap (map toVersion) . D.rowsList $ decodeList D.int4) 24 | -------------------------------------------------------------------------------- /library/Grawlix/Handler/GetRevisions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | 4 | module Grawlix.Handler.GetRevisions 5 | ( GetRevisions 6 | , getRevisionsHandler 7 | ) where 8 | 9 | import Grawlix.Handler.Common 10 | import Grawlix.Query.SelectRevisions 11 | import Grawlix.Type.PackageName 12 | import Grawlix.Type.Revision 13 | import Grawlix.Type.Version 14 | 15 | type GetRevisions 16 | = "packages" 17 | :> Capture "package" PackageName 18 | :> "versions" 19 | :> Capture "version" Version 20 | :> "revisions" 21 | :> Get '[ JSON] [Revision] 22 | 23 | getRevisionsHandler :: 24 | Connection -> PackageName -> Version -> Handler [Revision] 25 | getRevisionsHandler connection package version = 26 | liftIO $ runQuery connection selectRevisions (package, version) 27 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectLibraryId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectLibraryId 2 | ( selectLibraryId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ConditionId 7 | import Grawlix.Type.LibraryId 8 | import Grawlix.Type.LibraryNameId 9 | import Grawlix.Type.PackageId 10 | 11 | import qualified Hasql.Decoders as D 12 | 13 | selectLibraryId :: Query (PackageId, LibraryNameId, ConditionId) LibraryId 14 | selectLibraryId = 15 | makeQuery 16 | " select id \ 17 | \ from libraries \ 18 | \ where package_id = $1 \ 19 | \ and library_name_id = $2 \ 20 | \ and condition_id = $3 " 21 | (contrazip3 22 | (contramap fromPackageId encodeInt32) 23 | (contramap fromLibraryNameId encodeInt32) 24 | (contramap fromConditionId encodeInt32)) 25 | (toLibraryId <$> D.singleRow decodeInt32) 26 | -------------------------------------------------------------------------------- /library/Grawlix/Type/ModuleName.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | 3 | module Grawlix.Type.ModuleName 4 | ( ModuleName 5 | , toModuleName 6 | , fromModuleName 7 | ) where 8 | 9 | import Grawlix.Type.Common 10 | 11 | import qualified Data.Text as Text 12 | import qualified Distribution.ModuleName as Cabal 13 | import qualified Distribution.Text as Cabal 14 | 15 | newtype ModuleName = 16 | ModuleName [Text] 17 | deriving (Eq, Ord, Show, ToJSON) 18 | 19 | instance FromHttpApiData ModuleName where 20 | parseUrlPiece = 21 | fmap (toModuleName . map Text.pack . Cabal.components) . 22 | maybe (fail "invalid module name") pure . Cabal.simpleParse . Text.unpack 23 | 24 | toModuleName :: [Text] -> ModuleName 25 | toModuleName = ModuleName 26 | 27 | fromModuleName :: ModuleName -> [Text] 28 | fromModuleName (ModuleName x) = x 29 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectBenchmarkId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectBenchmarkId 2 | ( selectBenchmarkId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.BenchmarkId 7 | import Grawlix.Type.BenchmarkNameId 8 | import Grawlix.Type.ConditionId 9 | import Grawlix.Type.PackageId 10 | 11 | import qualified Hasql.Decoders as D 12 | 13 | selectBenchmarkId :: 14 | Query (PackageId, BenchmarkNameId, ConditionId) BenchmarkId 15 | selectBenchmarkId = 16 | makeQuery 17 | " select id \ 18 | \ from benchmarks \ 19 | \ where package_id = $1 \ 20 | \ and benchmark_name_id = $2 \ 21 | \ and condition_id = $3 " 22 | (contrazip3 23 | (contramap fromPackageId encodeInt32) 24 | (contramap fromBenchmarkNameId encodeInt32) 25 | (contramap fromConditionId encodeInt32)) 26 | (toBenchmarkId <$> D.singleRow decodeInt32) 27 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectExecutableId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectExecutableId 2 | ( selectExecutableId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.ConditionId 7 | import Grawlix.Type.ExecutableId 8 | import Grawlix.Type.ExecutableNameId 9 | import Grawlix.Type.PackageId 10 | 11 | import qualified Hasql.Decoders as D 12 | 13 | selectExecutableId :: 14 | Query (PackageId, ExecutableNameId, ConditionId) ExecutableId 15 | selectExecutableId = 16 | makeQuery 17 | " select id \ 18 | \ from executables \ 19 | \ where package_id = $1 \ 20 | \ and executable_name_id = $2 \ 21 | \ and condition_id = $3 " 22 | (contrazip3 23 | (contramap fromPackageId encodeInt32) 24 | (contramap fromExecutableNameId encodeInt32) 25 | (contramap fromConditionId encodeInt32)) 26 | (toExecutableId <$> D.singleRow decodeInt32) 27 | -------------------------------------------------------------------------------- /library/Grawlix/Handler/GetLibraries.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | 4 | module Grawlix.Handler.GetLibraries 5 | ( GetLibraries 6 | , getLibrariesHandler 7 | ) where 8 | 9 | import Grawlix.Handler.Common 10 | import Grawlix.Query.SelectLibraries 11 | import Grawlix.Type.LibraryId 12 | import Grawlix.Type.PackageName 13 | import Grawlix.Type.Revision 14 | import Grawlix.Type.Version 15 | 16 | type GetLibraries 17 | = "packages" 18 | :> Capture "package" PackageName 19 | :> "versions" 20 | :> Capture "version" Version 21 | :> "revisions" 22 | :> Capture "revision" Revision 23 | :> "libraries" 24 | :> Get '[ JSON] [LibraryId] 25 | 26 | getLibrariesHandler :: 27 | Connection -> PackageName -> Version -> Revision -> Handler [LibraryId] 28 | getLibrariesHandler connection package version revision = 29 | liftIO $ runQuery connection selectLibraries (package, version, revision) 30 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectRevisions.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectRevisions 2 | ( selectRevisions 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.PackageName 7 | import Grawlix.Type.Revision 8 | import Grawlix.Type.Version 9 | 10 | import qualified Hasql.Decoders as D 11 | import qualified Hasql.Encoders as E 12 | 13 | selectRevisions :: Query (PackageName, Version) [Revision] 14 | selectRevisions = 15 | makeQuery 16 | " select distinct packages.revision \ 17 | \ from packages \ 18 | \ inner join package_names \ 19 | \ on package_names.id = packages.package_name_id \ 20 | \ inner join versions \ 21 | \ on versions.id = packages.version_id \ 22 | \ where package_names.content = $1 \ 23 | \ and versions.content = $2 \ 24 | \ order by packages.revision asc " 25 | (contrazip2 26 | (contramap fromPackageName encodeText) 27 | (contramap fromVersion $ encodeList E.int4)) 28 | (map toRevision <$> D.rowsList decodeInt32) 29 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Package.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Package 2 | ( Package(..) 3 | ) where 4 | 5 | import Grawlix.Type.Benchmarks 6 | import Grawlix.Type.Categories 7 | import Grawlix.Type.Description 8 | import Grawlix.Type.Executables 9 | import Grawlix.Type.Libraries 10 | import Grawlix.Type.License 11 | import Grawlix.Type.PackageName 12 | import Grawlix.Type.PackageUrl 13 | import Grawlix.Type.Repos 14 | import Grawlix.Type.Revision 15 | import Grawlix.Type.Synopsis 16 | import Grawlix.Type.Tests 17 | import Grawlix.Type.Version 18 | 19 | data Package = Package 20 | { packageName :: PackageName 21 | , packageVersion :: Version 22 | , packageRevision :: Revision 23 | , packageLicense :: License 24 | , packageSynopsis :: Synopsis 25 | , packageDescription :: Description 26 | , packageCategories :: Categories 27 | , packageUrl :: PackageUrl 28 | , packageRepos :: Repos 29 | , packageLibraries :: Libraries 30 | , packageExecutables :: Executables 31 | , packageTests :: Tests 32 | , packageBenchmarks :: Benchmarks 33 | } deriving (Eq, Show) 34 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectPackageId.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectPackageId 2 | ( selectPackageId 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.PackageId 7 | import Grawlix.Type.PackageName 8 | import Grawlix.Type.Revision 9 | import Grawlix.Type.Version 10 | 11 | import qualified Hasql.Decoders as D 12 | import qualified Hasql.Encoders as E 13 | 14 | selectPackageId :: Query (PackageName, Version, Revision) PackageId 15 | selectPackageId = 16 | makeQuery 17 | " select packages.id \ 18 | \ from packages \ 19 | \ inner join package_names \ 20 | \ on package_names.id = packages.package_name_id \ 21 | \ inner join versions \ 22 | \ on versions.id = packages.version_id \ 23 | \ where package_names.content = $1 \ 24 | \ and versions.content = $2 \ 25 | \ and packages.revision = $3 " 26 | (contrazip3 27 | (contramap fromPackageName encodeText) 28 | (contramap fromVersion $ encodeList E.int4) 29 | (contramap fromRevision encodeInt32)) 30 | (toPackageId <$> D.singleRow decodeInt32) 31 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Version.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | 3 | module Grawlix.Type.Version 4 | ( Version 5 | , toVersion 6 | , fromVersion 7 | ) where 8 | 9 | import Grawlix.Type.Common 10 | 11 | import qualified Control.Monad as Monad 12 | import qualified Data.Text as Text 13 | import qualified Distribution.Text as Cabal 14 | import qualified Distribution.Version as Cabal 15 | 16 | newtype Version = 17 | Version [Int32] 18 | deriving (Eq, Show, ToJSON) 19 | 20 | instance FromHttpApiData Version where 21 | parseUrlPiece = 22 | fmap toVersion . 23 | Monad.join . 24 | fmap (mapM intToInt32 . Cabal.versionNumbers) . 25 | maybe (fail "invalid version") pure . Cabal.simpleParse . Text.unpack 26 | 27 | toVersion :: [Int32] -> Version 28 | toVersion = Version 29 | 30 | fromVersion :: Version -> [Int32] 31 | fromVersion (Version x) = x 32 | 33 | intToInt32 :: Monad m => Int -> m Int32 34 | intToInt32 x = 35 | if x > fromIntegral (maxBound :: Int32) 36 | then fail "too big for int32" 37 | else pure (fromIntegral x) 38 | -------------------------------------------------------------------------------- /library/Grawlix/Handler/GetModules.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | 4 | module Grawlix.Handler.GetModules 5 | ( GetModules 6 | , getModulesHandler 7 | ) where 8 | 9 | import Grawlix.Handler.Common 10 | import Grawlix.Query.SelectModules 11 | import Grawlix.Type.LibraryId 12 | import Grawlix.Type.ModuleName 13 | import Grawlix.Type.PackageName 14 | import Grawlix.Type.Revision 15 | import Grawlix.Type.Version 16 | 17 | type GetModules 18 | = "packages" 19 | :> Capture "package" PackageName 20 | :> "versions" 21 | :> Capture "version" Version 22 | :> "revisions" 23 | :> Capture "revision" Revision 24 | :> "libraries" 25 | :> Capture "library" LibraryId 26 | :> "modules" 27 | :> Get '[ JSON] [ModuleName] 28 | 29 | getModulesHandler :: 30 | Connection 31 | -> PackageName 32 | -> Version 33 | -> Revision 34 | -> LibraryId 35 | -> Handler [ModuleName] 36 | getModulesHandler connection package version revision library = 37 | liftIO $ 38 | runQuery connection selectModules (package, version, revision, library) 39 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Common.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Type.Common 2 | ( FromHttpApiData 3 | , FromJSON 4 | , Generic 5 | , Int32 6 | , Map 7 | , Set 8 | , Text 9 | , ToJSON 10 | , parseUrlPiece 11 | , partialDropPrefix 12 | ) where 13 | 14 | import Data.Aeson (FromJSON, ToJSON) 15 | import Data.Int (Int32) 16 | import Data.Map (Map) 17 | import Data.Set (Set) 18 | import Data.Text (Text) 19 | import GHC.Generics (Generic) 20 | import Web.HttpApiData (FromHttpApiData, parseUrlPiece) 21 | 22 | import qualified Data.Maybe as Maybe 23 | import qualified GHC.Stack as Ghc 24 | 25 | dropPrefix :: Eq a => [a] -> [a] -> Maybe [a] 26 | dropPrefix prefix list = 27 | case prefix of 28 | [] -> Just list 29 | ph:pt -> 30 | case list of 31 | [] -> Nothing 32 | lh:lt -> 33 | if ph == lh 34 | then dropPrefix pt lt 35 | else Nothing 36 | 37 | partialDropPrefix :: (Ghc.HasCallStack, Eq a, Show a) => [a] -> [a] -> [a] 38 | partialDropPrefix prefix list = 39 | Maybe.fromMaybe 40 | (error $ unwords [show prefix, "is not a prefix of", show list]) 41 | (dropPrefix prefix list) 42 | -------------------------------------------------------------------------------- /LICENSE.markdown: -------------------------------------------------------------------------------- 1 | # [The MIT License](https://opensource.org/licenses/MIT) 2 | 3 | Copyright 2017 Taylor Fausak 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 9 | of the Software, and to permit persons to whom the Software is furnished to do 10 | so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectLibraries.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectLibraries 2 | ( selectLibraries 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.LibraryId 7 | import Grawlix.Type.PackageName 8 | import Grawlix.Type.Revision 9 | import Grawlix.Type.Version 10 | 11 | import qualified Hasql.Decoders as D 12 | import qualified Hasql.Encoders as E 13 | 14 | selectLibraries :: Query (PackageName, Version, Revision) [LibraryId] 15 | selectLibraries = 16 | makeQuery 17 | " select distinct libraries.id \ 18 | \ from packages \ 19 | \ inner join package_names \ 20 | \ on package_names.id = packages.package_name_id \ 21 | \ inner join versions \ 22 | \ on versions.id = packages.version_id \ 23 | \ inner join libraries \ 24 | \ on libraries.package_id = packages.id \ 25 | \ where package_names.content = $1 \ 26 | \ and versions.content = $2 \ 27 | \ and packages.revision = $3 \ 28 | \ order by libraries.id asc " 29 | (contrazip3 30 | (contramap fromPackageName encodeText) 31 | (contramap fromVersion $ encodeList E.int4) 32 | (contramap fromRevision encodeInt32)) 33 | (map toLibraryId <$> D.rowsList decodeInt32) 34 | -------------------------------------------------------------------------------- /library/Grawlix/Handler/GetHaddock.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | 4 | module Grawlix.Handler.GetHaddock 5 | ( GetHaddock 6 | , getHaddockHandler 7 | ) where 8 | 9 | import Grawlix.Handler.Common 10 | import Grawlix.Type.ModuleName 11 | import Grawlix.Type.PackageName 12 | import Grawlix.Type.Version 13 | 14 | import qualified Data.List as List 15 | import qualified Data.Text as Text 16 | import qualified Lucid 17 | import qualified Network.HTTP.Client as Client 18 | import qualified Network.HTTP.Client.TLS as Client 19 | 20 | type GetHaddock 21 | = Capture "package" PackageName 22 | :> Capture "version" Version 23 | :> Capture "module" ModuleName 24 | :> Get '[ HTML] (Lucid.Html ()) 25 | 26 | getHaddockHandler :: 27 | PackageName -> Version -> ModuleName -> Handler (Lucid.Html ()) 28 | getHaddockHandler packageName version moduleName = do 29 | let url = 30 | concat 31 | [ "https://hackage.haskell.org/package/" 32 | , Text.unpack $ fromPackageName packageName 33 | , "-" 34 | , List.intercalate "." . map show $ fromVersion version 35 | , "/docs/" 36 | , List.intercalate "-" . map Text.unpack $ fromModuleName moduleName 37 | , ".html" 38 | ] 39 | request <- Client.parseUrlThrow url 40 | manager <- Client.newTlsManager 41 | response <- liftIO $ Client.httpLbs request manager 42 | pure . Lucid.toHtmlRaw $ Client.responseBody response 43 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: grawlix 2 | version: 0.0.0 3 | 4 | category: Documentation 5 | description: Grawlix lets you comment on Haskell documentation. 6 | extra-source-files: 7 | - CHANGELOG.markdown 8 | - migrations/*.sql 9 | - README.markdown 10 | license-file: LICENSE.markdown 11 | license: MIT 12 | maintainer: Taylor Fausak 13 | synopsis: Comment on Haskell documentation. 14 | 15 | dependencies: 16 | - base 17 | ghc-options: 18 | - -Weverything 19 | - -Wno-implicit-prelude 20 | - -Wno-missing-import-lists 21 | - -Wno-safe 22 | - -Wno-unsafe 23 | 24 | library: 25 | dependencies: 26 | - aeson 27 | - async 28 | - base16-bytestring 29 | - base64-bytestring 30 | - bytestring 31 | - Cabal 32 | - containers 33 | - contravariant 34 | - contravariant-extras 35 | - directory 36 | - exceptions 37 | - filepath 38 | - flow 39 | - hasql 40 | - hasql-migration 41 | - hasql-transaction 42 | - http-api-data 43 | - http-client 44 | - http-client-tls 45 | - http-types 46 | - lucid 47 | - optparse-generic 48 | - servant 49 | - servant-lucid 50 | - servant-server 51 | - tagged 52 | - tar 53 | - template-haskell 54 | - text 55 | - time 56 | - wai 57 | - wai-extra 58 | - warp 59 | - yaml 60 | - zlib 61 | source-dirs: library 62 | 63 | executables: 64 | grawlix: 65 | dependencies: 66 | - grawlix 67 | ghc-options: 68 | - -rtsopts 69 | - -threaded 70 | source-dirs: executables 71 | main: Main.hs 72 | -------------------------------------------------------------------------------- /library/Grawlix/Query/SelectModules.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.SelectModules 2 | ( selectModules 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.LibraryId 7 | import Grawlix.Type.ModuleName 8 | import Grawlix.Type.PackageName 9 | import Grawlix.Type.Revision 10 | import Grawlix.Type.Version 11 | 12 | import qualified Hasql.Decoders as D 13 | import qualified Hasql.Encoders as E 14 | 15 | selectModules :: Query (PackageName, Version, Revision, LibraryId) [ModuleName] 16 | selectModules = 17 | makeQuery 18 | " select distinct module_names.content \ 19 | \ from packages \ 20 | \ inner join package_names \ 21 | \ on package_names.id = packages.package_name_id \ 22 | \ inner join versions \ 23 | \ on versions.id = packages.version_id \ 24 | \ inner join libraries \ 25 | \ on libraries.package_id = packages.id \ 26 | \ inner join libraries_module_names \ 27 | \ on libraries_module_names.library_id = libraries.id \ 28 | \ inner join module_names \ 29 | \ on module_names.id = libraries_module_names.module_name_id \ 30 | \ where package_names.content = $1 \ 31 | \ and versions.content = $2 \ 32 | \ and packages.revision = $3 \ 33 | \ and libraries.id = $4 \ 34 | \ order by module_names.content asc " 35 | (contrazip4 36 | (contramap fromPackageName encodeText) 37 | (contramap fromVersion $ encodeList E.int4) 38 | (contramap fromRevision encodeInt32) 39 | (contramap fromLibraryId encodeInt32)) 40 | (fmap (map toModuleName) . D.rowsList $ decodeList D.text) 41 | -------------------------------------------------------------------------------- /library/Grawlix/Query/InsertPackage.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.InsertPackage 2 | ( insertPackage 3 | ) where 4 | 5 | import Grawlix.Query.Common 6 | import Grawlix.Type.Description 7 | import Grawlix.Type.License 8 | import Grawlix.Type.PackageName 9 | import Grawlix.Type.PackageUrl 10 | import Grawlix.Type.Revision 11 | import Grawlix.Type.Synopsis 12 | import Grawlix.Type.Version 13 | 14 | import qualified Hasql.Encoders as E 15 | 16 | insertPackage :: 17 | Query ( PackageName 18 | , Version 19 | , Revision 20 | , License 21 | , Synopsis 22 | , Description 23 | , PackageUrl) () 24 | insertPackage = 25 | makeQuery 26 | " insert into packages ( \ 27 | \ package_name_id, \ 28 | \ version_id, \ 29 | \ revision, \ 30 | \ license_id, \ 31 | \ synopsis, \ 32 | \ description, \ 33 | \ url \ 34 | \ ) values ( \ 35 | \ ( select id from package_names where content = $1 ), \ 36 | \ ( select id from versions where content = $2 ), \ 37 | \ $3, \ 38 | \ ( select id from licenses where content = $4 ), \ 39 | \ $5, \ 40 | \ $6, \ 41 | \ $7 \ 42 | \ ) on conflict do nothing " 43 | (contrazip7 44 | (contramap fromPackageName encodeText) 45 | (contramap fromVersion $ encodeList E.int4) 46 | (contramap fromRevision encodeInt32) 47 | (contramap fromLicense encodeText) 48 | (contramap fromSynopsis encodeText) 49 | (contramap fromDescription encodeText) 50 | (contramap fromPackageUrl encodeText)) 51 | decodeUnit 52 | -------------------------------------------------------------------------------- /library/Grawlix/Query/Common.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Query.Common 2 | ( Query 3 | , contramap 4 | , contrazip2 5 | , contrazip3 6 | , contrazip4 7 | , contrazip5 8 | , contrazip6 9 | , contrazip7 10 | , decodeInt32 11 | , decodeList 12 | , decodeText 13 | , decodeUnit 14 | , encodeInt32 15 | , encodeList 16 | , encodeText 17 | , encodeUnit 18 | , makeQuery 19 | ) where 20 | 21 | import Contravariant.Extras 22 | ( contrazip2 23 | , contrazip3 24 | , contrazip4 25 | , contrazip5 26 | , contrazip6 27 | , contrazip7 28 | ) 29 | import Control.Monad (replicateM) 30 | import Data.Functor.Contravariant (contramap) 31 | import Data.Int (Int32) 32 | import Data.Text (Text, pack) 33 | import Data.Text.Encoding (encodeUtf8) 34 | import Hasql.Query (Query, statement) 35 | 36 | import qualified Hasql.Decoders as D 37 | import qualified Hasql.Encoders as E 38 | 39 | decodeInt32 :: D.Row Int32 40 | decodeInt32 = D.value D.int4 41 | 42 | decodeList :: D.Value a -> D.Row [a] 43 | decodeList = D.value . D.array . D.arrayDimension replicateM . D.arrayValue 44 | 45 | decodeText :: D.Row Text 46 | decodeText = D.value D.text 47 | 48 | decodeUnit :: D.Result () 49 | decodeUnit = D.unit 50 | 51 | encodeInt32 :: E.Params Int32 52 | encodeInt32 = E.value E.int4 53 | 54 | encodeList :: E.Value a -> E.Params [a] 55 | encodeList = E.value . E.array . E.arrayDimension foldl . E.arrayValue 56 | 57 | encodeText :: E.Params Text 58 | encodeText = E.value E.text 59 | 60 | encodeUnit :: E.Params () 61 | encodeUnit = E.unit 62 | 63 | makeQuery :: String -> E.Params a -> D.Result b -> Query a b 64 | makeQuery query params result = 65 | statement (encodeUtf8 $ pack query) params result True 66 | -------------------------------------------------------------------------------- /library/Grawlix/Main.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Main 2 | ( main 3 | ) where 4 | 5 | import Grawlix.Config 6 | import Grawlix.Database 7 | import Grawlix.Options 8 | import Grawlix.Server 9 | import Grawlix.Sync 10 | import Grawlix.Type.Config 11 | 12 | import qualified Control.Concurrent as Concurrent 13 | import qualified Control.Concurrent.Async as Async 14 | import qualified Control.Monad as Monad 15 | import qualified Data.Time as Time 16 | import qualified Hasql.Connection as Sql 17 | 18 | main :: IO () 19 | main = do 20 | options <- getOptions 21 | config <- getConfig options 22 | connection <- getConnection config 23 | runMigrations config connection 24 | Async.race_ 25 | (runSyncForever config connection) 26 | (runServerForever config connection) 27 | 28 | runSyncForever :: Config -> Sql.Connection -> IO () 29 | runSyncForever config connection = 30 | if configSyncEnabled config 31 | then Monad.forever $ do 32 | runSync config connection 33 | sleep $ configSyncDelay config 34 | else sleepForever 35 | 36 | runServerForever :: Config -> Sql.Connection -> IO () 37 | runServerForever config connection = 38 | if configServerEnabled config 39 | then runServer connection 40 | else sleepForever 41 | 42 | sleepForever :: IO () 43 | sleepForever = Monad.forever . sleep $ Time.secondsToDiffTime 1 44 | 45 | sleep :: Time.DiffTime -> IO () 46 | sleep = Concurrent.threadDelay . picoToMicro . Time.diffTimeToPicoseconds 47 | 48 | picoToMicro :: Integer -> Int 49 | picoToMicro = integerToInt . (`div` 1000000) 50 | 51 | integerToInt :: Integer -> Int 52 | integerToInt x = 53 | let h = maxBound :: Int 54 | l = minBound :: Int 55 | in if x > fromIntegral h 56 | then h 57 | else if x < fromIntegral l 58 | then l 59 | else fromIntegral x 60 | -------------------------------------------------------------------------------- /library/Grawlix/Database.hs: -------------------------------------------------------------------------------- 1 | module Grawlix.Database 2 | ( getConnection 3 | , runMigrations 4 | , runQuery 5 | ) where 6 | 7 | import Grawlix.Query.Common 8 | import Grawlix.Type.Config 9 | 10 | import qualified Data.Text.Encoding as Text 11 | import qualified Hasql.Connection as Sql 12 | import qualified Hasql.Migration as Sql 13 | import qualified Hasql.Session as Sql 14 | import qualified Hasql.Transaction as Sql.Transaction 15 | import qualified Hasql.Transaction.Sessions as Sql 16 | 17 | getConnection :: Config -> IO Sql.Connection 18 | getConnection config = do 19 | result <- Sql.acquire . Text.encodeUtf8 $ configPostgresUri config 20 | case result of 21 | Left problem -> fail $ show problem 22 | Right connection -> pure connection 23 | 24 | runMigrations :: Config -> Sql.Connection -> IO () 25 | runMigrations config connection = do 26 | runMigration connection Sql.MigrationInitialization 27 | migrations <- getMigrations config 28 | mapM_ (runMigration connection) migrations 29 | 30 | getMigrations :: Config -> IO [Sql.MigrationCommand] 31 | getMigrations = Sql.loadMigrationsFromDirectory . configMigrationDirectory 32 | 33 | runMigration :: Sql.Connection -> Sql.MigrationCommand -> IO () 34 | runMigration connection migration = do 35 | result <- Sql.run (transaction $ Sql.runMigration migration) connection 36 | case result of 37 | Right Sql.MigrationSuccess -> pure () 38 | _ -> fail (show result) 39 | 40 | runQuery :: Sql.Connection -> Query a b -> a -> IO b 41 | runQuery connection query params = do 42 | result <- Sql.run (Sql.query params query) connection 43 | case result of 44 | Left problem -> fail $ show problem 45 | Right value -> pure value 46 | 47 | transaction :: Sql.Transaction.Transaction a -> Sql.Session a 48 | transaction = 49 | Sql.transaction Sql.Transaction.Serializable Sql.Transaction.Write 50 | -------------------------------------------------------------------------------- /library/Grawlix/Server.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeOperators #-} 2 | 3 | module Grawlix.Server 4 | ( runServer 5 | ) where 6 | 7 | import Grawlix.Handler.GetHaddock 8 | import Grawlix.Handler.GetHealthCheck 9 | import Grawlix.Handler.GetLibraries 10 | import Grawlix.Handler.GetModules 11 | import Grawlix.Handler.GetPackages 12 | import Grawlix.Handler.GetRevisions 13 | import Grawlix.Handler.GetVersions 14 | import Servant ((:<|>)((:<|>))) 15 | 16 | import qualified Hasql.Connection as Sql 17 | import qualified Network.Wai as Wai 18 | import qualified Network.Wai.Handler.Warp as Warp 19 | import qualified Network.Wai.Middleware.Gzip as Middleware 20 | import qualified Network.Wai.Middleware.RequestLogger as Middleware 21 | import qualified Servant 22 | 23 | runServer :: Sql.Connection -> IO () 24 | runServer = Warp.runSettings settings . applyMiddleware . makeApplication 25 | 26 | settings :: Warp.Settings 27 | settings = 28 | Warp.setBeforeMainLoop (putStrLn "Starting server ...") . Warp.setPort 8080 $ 29 | Warp.setServerName mempty Warp.defaultSettings 30 | 31 | applyMiddleware :: Wai.Middleware 32 | applyMiddleware = Middleware.gzip Middleware.def . Middleware.logStdout 33 | 34 | makeApplication :: Sql.Connection -> Wai.Application 35 | makeApplication = Servant.serve api . makeServer 36 | 37 | api :: Servant.Proxy Api 38 | api = Servant.Proxy 39 | 40 | type Api 41 | = GetHealthCheck 42 | :<|> GetPackages 43 | :<|> GetVersions 44 | :<|> GetRevisions 45 | :<|> GetLibraries 46 | :<|> GetModules 47 | :<|> GetHaddock 48 | 49 | makeServer :: Sql.Connection -> Servant.Server Api 50 | makeServer connection = 51 | getHealthCheckHandler connection :<|> -- Force hindent newline. 52 | getPackagesHandler connection :<|> 53 | getVersionsHandler connection :<|> 54 | getRevisionsHandler connection :<|> 55 | getLibrariesHandler connection :<|> 56 | getModulesHandler connection :<|> 57 | getHaddockHandler 58 | -------------------------------------------------------------------------------- /library/Grawlix/Type/Config.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | 3 | module Grawlix.Type.Config 4 | ( Config(..) 5 | , defaultConfig 6 | ) where 7 | 8 | import Grawlix.Type.Common 9 | 10 | import qualified Data.Aeson as Json 11 | import qualified Data.Aeson.Types as Json 12 | import qualified Data.Text as Text 13 | import qualified Data.Time as Time 14 | import qualified System.FilePath as Path 15 | 16 | data Config = Config 17 | { configCacheDirectory :: FilePath 18 | , configIndexUrl :: String 19 | , configMigrationDirectory :: FilePath 20 | , configPostgresUri :: Text 21 | , configServerEnabled :: Bool 22 | , configSyncDelay :: Time.DiffTime 23 | , configSyncEnabled :: Bool 24 | } deriving (Eq, Generic, Show) 25 | 26 | instance FromJSON Config where 27 | parseJSON = 28 | Json.withObject "Config" $ \object -> 29 | Config <$> getWithDefault object "cache-directory" configCacheDirectory <*> 30 | getWithDefault object "index-url" configIndexUrl <*> 31 | getWithDefault object "migration-directory" configMigrationDirectory <*> 32 | getWithDefault object "postgres-uri" configPostgresUri <*> 33 | getWithDefault object "server-enabled" configServerEnabled <*> 34 | getWithDefault object "sync-delay" configSyncDelay <*> 35 | getWithDefault object "sync-enabled" configSyncEnabled 36 | 37 | getWithDefault :: 38 | FromJSON a => Json.Object -> String -> (Config -> a) -> Json.Parser a 39 | getWithDefault object key field = 40 | object Json..:? Text.pack key Json..!= field defaultConfig 41 | 42 | defaultConfig :: Config 43 | defaultConfig = 44 | Config 45 | { configCacheDirectory = Path.combine "data" "cache" 46 | , configIndexUrl = "https://hackage.haskell.org/01-index.tar.gz" 47 | , configMigrationDirectory = "migrations" 48 | , configPostgresUri = Text.empty 49 | , configServerEnabled = True 50 | , configSyncDelay = Time.secondsToDiffTime 60 51 | , configSyncEnabled = True 52 | } 53 | -------------------------------------------------------------------------------- /library/Grawlix/Sync.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NamedFieldPuns #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | 4 | module Grawlix.Sync 5 | ( runSync 6 | ) where 7 | 8 | import Flow ((|>)) 9 | import Grawlix.Database 10 | import Grawlix.Query.InsertBenchmark 11 | import Grawlix.Query.InsertBenchmarkName 12 | import Grawlix.Query.InsertCategory 13 | import Grawlix.Query.InsertCategoryPackage 14 | import Grawlix.Query.InsertCondition 15 | import Grawlix.Query.InsertConstraint 16 | import Grawlix.Query.InsertDependency 17 | import Grawlix.Query.InsertDependencyBenchmark 18 | import Grawlix.Query.InsertDependencyExecutable 19 | import Grawlix.Query.InsertDependencyLibrary 20 | import Grawlix.Query.InsertDependencyTest 21 | import Grawlix.Query.InsertExecutable 22 | import Grawlix.Query.InsertExecutableName 23 | import Grawlix.Query.InsertLibrary 24 | import Grawlix.Query.InsertLibraryModuleName 25 | import Grawlix.Query.InsertLibraryName 26 | import Grawlix.Query.InsertLicense 27 | import Grawlix.Query.InsertModuleName 28 | import Grawlix.Query.InsertPackage 29 | import Grawlix.Query.InsertPackageName 30 | import Grawlix.Query.InsertPackageRepo 31 | import Grawlix.Query.InsertRepo 32 | import Grawlix.Query.InsertRepoKind 33 | import Grawlix.Query.InsertRepoType 34 | import Grawlix.Query.InsertTest 35 | import Grawlix.Query.InsertTestName 36 | import Grawlix.Query.InsertVersion 37 | import Grawlix.Query.SelectBenchmarkId 38 | import Grawlix.Query.SelectBenchmarkNameId 39 | import Grawlix.Query.SelectCategoryId 40 | import Grawlix.Query.SelectConditionId 41 | import Grawlix.Query.SelectConstraintId 42 | import Grawlix.Query.SelectDependencyId 43 | import Grawlix.Query.SelectExecutableId 44 | import Grawlix.Query.SelectExecutableNameId 45 | import Grawlix.Query.SelectLibraryId 46 | import Grawlix.Query.SelectLibraryNameId 47 | import Grawlix.Query.SelectModuleNameId 48 | import Grawlix.Query.SelectPackageId 49 | import Grawlix.Query.SelectPackageNameId 50 | import Grawlix.Query.SelectRepoId 51 | import Grawlix.Query.SelectRepoKindId 52 | import Grawlix.Query.SelectRepoTypeId 53 | import Grawlix.Query.SelectTestId 54 | import Grawlix.Query.SelectTestNameId 55 | import Grawlix.Type.Benchmark 56 | import Grawlix.Type.BenchmarkName 57 | import Grawlix.Type.Benchmarks 58 | import Grawlix.Type.Categories 59 | import Grawlix.Type.Category 60 | import Grawlix.Type.Condition 61 | import Grawlix.Type.Config 62 | import Grawlix.Type.Constraint 63 | import Grawlix.Type.Dependencies 64 | import Grawlix.Type.Dependency 65 | import Grawlix.Type.Description 66 | import Grawlix.Type.Executable 67 | import Grawlix.Type.ExecutableName 68 | import Grawlix.Type.Executables 69 | import Grawlix.Type.Libraries 70 | import Grawlix.Type.Library 71 | import Grawlix.Type.LibraryName 72 | import Grawlix.Type.License 73 | import Grawlix.Type.ModuleName 74 | import Grawlix.Type.ModuleNames 75 | import Grawlix.Type.Package 76 | import Grawlix.Type.PackageName 77 | import Grawlix.Type.PackageUrl 78 | import Grawlix.Type.Repo 79 | import Grawlix.Type.RepoKind 80 | import Grawlix.Type.RepoType 81 | import Grawlix.Type.RepoUrl 82 | import Grawlix.Type.Repos 83 | import Grawlix.Type.Revision 84 | import Grawlix.Type.Synopsis 85 | import Grawlix.Type.Test 86 | import Grawlix.Type.TestName 87 | import Grawlix.Type.Tests 88 | import Grawlix.Type.Version 89 | import Grawlix.Type.VersionBound 90 | 91 | import qualified Codec.Archive.Tar as Tar 92 | import qualified Codec.Compression.GZip as Gzip 93 | import qualified Control.Arrow as Arrow 94 | import qualified Control.Exception as Exception 95 | import qualified Control.Monad as Monad 96 | import qualified Control.Monad.Catch as Catch 97 | import qualified Data.ByteString as Bytes 98 | import qualified Data.ByteString.Base16 as Base16 99 | import qualified Data.ByteString.Base64 as Base64 100 | import qualified Data.ByteString.Lazy as LazyBytes 101 | import qualified Data.Foldable as Foldable 102 | import qualified Data.Functor as Functor 103 | import qualified Data.Int as Int 104 | import qualified Data.List as List 105 | import qualified Data.Map as Map 106 | import qualified Data.Maybe as Maybe 107 | import qualified Data.Set as Set 108 | import qualified Data.Text as Text 109 | import qualified Data.Text.Encoding as Text 110 | import qualified Data.Text.Lazy as LazyText 111 | import qualified Data.Text.Lazy.Encoding as LazyText 112 | import qualified Data.Tree as Tree 113 | import qualified Data.Word as Word 114 | import qualified Debug.Trace as Debug 115 | import qualified Distribution.ModuleName as Cabal 116 | import qualified Distribution.Package as Cabal 117 | import qualified Distribution.PackageDescription as Cabal 118 | import qualified Distribution.PackageDescription.Parse as Cabal 119 | import qualified Distribution.Text as Cabal 120 | import qualified Distribution.Types.CondTree as Cabal 121 | import qualified Distribution.Types.UnqualComponentName as Cabal 122 | import qualified Distribution.Version as Cabal 123 | import qualified Hasql.Connection as Sql 124 | import qualified Network.HTTP.Client as Client 125 | import qualified Network.HTTP.Client.TLS as Client 126 | import qualified Network.HTTP.Types as Http 127 | import qualified System.Directory as Directory 128 | import qualified System.FilePath as Path 129 | import qualified System.IO as IO 130 | import qualified Text.Printf as Printf 131 | import qualified Text.Read as Read 132 | 133 | runSync :: Config -> Sql.Connection -> IO () 134 | runSync config connection = do 135 | manager <- Client.newTlsManager 136 | md5 <- getLatestIndexMd5 (configIndexUrl config) manager 137 | let file = Path.addExtension md5 "tgz" 138 | index <- 139 | getCached (configCacheDirectory config) file $ 140 | getLatestIndex (configIndexUrl config) manager 141 | index |> Gzip.decompress |> Tar.read |> fromEntries |> filter isCabal |> 142 | Maybe.mapMaybe 143 | (\entry -> 144 | either 145 | (\problem -> 146 | Debug.trace 147 | (Printf.printf "%s: %s" (Tar.entryPath entry) (show problem)) 148 | Nothing) 149 | Just 150 | (do bytes <- getEntryContents entry 151 | text <- bytes |> fixEncoding |> lazyDecodeUtf8 152 | description <- text |> stripBom |> parseDescription 153 | toPackage description)) |> 154 | mapM_ (handlePackage connection) 155 | 156 | -- There is a single Cabal file in the entire Hackage index that is encoded 157 | -- with ISO-8859-1 (also known as Latin-1 or Windows-1252) instead of UTF-8. It 158 | -- contains a single 0xF6 byte (for U+00F6) that should be encoded as 0xC3 0xB6 159 | -- instead. This function is responsible for fixing that single byte. 160 | -- 161 | fixEncoding :: LazyBytes.ByteString -> LazyBytes.ByteString 162 | fixEncoding = LazyBytes.concatMap fixByte 163 | 164 | fixByte :: Word.Word8 -> LazyBytes.ByteString 165 | fixByte byte = 166 | if byte == 0xf6 167 | then LazyBytes.pack [0xc3, 0xb6] 168 | else LazyBytes.singleton byte 169 | 170 | -- There are a few Cabal files in the Hackage index that start with the UTF-16 171 | -- byte order mark U+FEFF (0xFE 0xFF). Cabal is supposed to be able to handle 172 | -- this, but it must do so somewhere other than its parser. This function is 173 | -- responsible for removing the BOM at the start of the package description. 174 | -- 175 | -- 176 | -- 177 | stripBom :: LazyText.Text -> LazyText.Text 178 | stripBom = LazyText.dropWhile isBom 179 | 180 | isBom :: Char -> Bool 181 | isBom = (== '\xfeff') 182 | 183 | handlePackage :: Sql.Connection -> Package -> IO () 184 | handlePackage connection package = do 185 | let name = packageName package 186 | let version = packageVersion package 187 | let revision = packageRevision package 188 | exists <- 189 | Exception.catch 190 | (do Functor.void 191 | (runQuery connection selectPackageId (name, version, revision)) 192 | pure True) 193 | (\(_ :: Exception.IOException) -> pure False) 194 | logPackage package exists 195 | Monad.unless 196 | exists 197 | (do runQuery connection insertPackageName name 198 | runQuery connection insertVersion version 199 | let license = packageLicense package 200 | runQuery connection insertLicense license 201 | runQuery 202 | connection 203 | insertPackage 204 | ( name 205 | , version 206 | , revision 207 | , license 208 | , packageSynopsis package 209 | , packageDescription package 210 | , packageUrl package) 211 | packageId <- 212 | runQuery connection selectPackageId (name, version, revision) 213 | package |> packageCategories |> fromCategories |> Set.toList |> 214 | mapM_ 215 | (\category -> do 216 | runQuery connection insertCategory category 217 | categoryId <- runQuery connection selectCategoryId category 218 | runQuery 219 | connection 220 | insertCategoryPackage 221 | (categoryId, packageId)) 222 | package |> packageRepos |> fromRepos |> Set.toList |> 223 | mapM_ 224 | (\repo -> do 225 | let kind = repoKind repo 226 | runQuery connection insertRepoKind kind 227 | kindId <- runQuery connection selectRepoKindId kind 228 | let type_ = repoType repo 229 | runQuery connection insertRepoType type_ 230 | typeId <- runQuery connection selectRepoTypeId type_ 231 | let url = repoUrl repo 232 | runQuery connection insertRepo (kindId, typeId, url) 233 | repoId <- runQuery connection selectRepoId (kindId, typeId, url) 234 | runQuery connection insertPackageRepo (packageId, repoId)) 235 | package |> packageLibraries |> fromLibraries |> Set.toList |> 236 | mapM_ 237 | (\library -> do 238 | let Library {libraryName, libraryCondition} = library 239 | runQuery connection insertLibraryName libraryName 240 | libraryNameId <- 241 | runQuery connection selectLibraryNameId libraryName 242 | runQuery connection insertCondition libraryCondition 243 | conditionId <- 244 | runQuery connection selectConditionId libraryCondition 245 | runQuery 246 | connection 247 | insertLibrary 248 | (packageId, libraryNameId, conditionId) 249 | libraryId <- 250 | runQuery 251 | connection 252 | selectLibraryId 253 | (packageId, libraryNameId, conditionId) 254 | library |> libraryModules |> fromModuleNames |> Set.toList |> 255 | mapM_ 256 | (\moduleName -> do 257 | runQuery connection insertModuleName moduleName 258 | moduleNameId <- 259 | runQuery connection selectModuleNameId moduleName 260 | runQuery 261 | connection 262 | insertLibraryModuleName 263 | (libraryId, moduleNameId)) 264 | library |> libraryDependencies |> fromDependencies |> 265 | Map.toAscList |> 266 | mapM_ 267 | (\(packageName, constraint) -> do 268 | runQuery connection insertConstraint constraint 269 | constraintId <- 270 | runQuery connection selectConstraintId constraint 271 | runQuery connection insertPackageName packageName 272 | packageNameId <- 273 | runQuery connection selectPackageNameId packageName 274 | runQuery 275 | connection 276 | insertDependency 277 | (constraintId, packageNameId) 278 | dependencyId <- 279 | runQuery 280 | connection 281 | selectDependencyId 282 | (constraintId, packageNameId) 283 | runQuery 284 | connection 285 | insertDependencyLibrary 286 | (dependencyId, libraryId))) 287 | package |> packageExecutables |> fromExecutables |> Set.toList |> 288 | mapM_ 289 | (\executable -> do 290 | let Executable {executableName, executableCondition} = 291 | executable 292 | runQuery connection insertExecutableName executableName 293 | executableNameId <- 294 | runQuery connection selectExecutableNameId executableName 295 | runQuery connection insertCondition executableCondition 296 | conditionId <- 297 | runQuery connection selectConditionId executableCondition 298 | runQuery 299 | connection 300 | insertExecutable 301 | (packageId, executableNameId, conditionId) 302 | executableId <- 303 | runQuery 304 | connection 305 | selectExecutableId 306 | (packageId, executableNameId, conditionId) 307 | executable |> executableDependencies |> fromDependencies |> 308 | Map.toAscList |> 309 | mapM_ 310 | (\(packageName, constraint) -> do 311 | runQuery connection insertConstraint constraint 312 | constraintId <- 313 | runQuery connection selectConstraintId constraint 314 | runQuery connection insertPackageName packageName 315 | packageNameId <- 316 | runQuery connection selectPackageNameId packageName 317 | runQuery 318 | connection 319 | insertDependency 320 | (constraintId, packageNameId) 321 | dependencyId <- 322 | runQuery 323 | connection 324 | selectDependencyId 325 | (constraintId, packageNameId) 326 | runQuery 327 | connection 328 | insertDependencyExecutable 329 | (dependencyId, executableId))) 330 | package |> packageTests |> fromTests |> Set.toList |> 331 | mapM_ 332 | (\test -> do 333 | let Test {testName, testCondition} = test 334 | runQuery connection insertTestName testName 335 | testNameId <- runQuery connection selectTestNameId testName 336 | runQuery connection insertCondition testCondition 337 | conditionId <- 338 | runQuery connection selectConditionId testCondition 339 | runQuery 340 | connection 341 | insertTest 342 | (packageId, testNameId, conditionId) 343 | testId <- 344 | runQuery 345 | connection 346 | selectTestId 347 | (packageId, testNameId, conditionId) 348 | test |> testDependencies |> fromDependencies |> Map.toAscList |> 349 | mapM_ 350 | (\(packageName, constraint) -> do 351 | runQuery connection insertConstraint constraint 352 | constraintId <- 353 | runQuery connection selectConstraintId constraint 354 | runQuery connection insertPackageName packageName 355 | packageNameId <- 356 | runQuery connection selectPackageNameId packageName 357 | runQuery 358 | connection 359 | insertDependency 360 | (constraintId, packageNameId) 361 | dependencyId <- 362 | runQuery 363 | connection 364 | selectDependencyId 365 | (constraintId, packageNameId) 366 | runQuery 367 | connection 368 | insertDependencyTest 369 | (dependencyId, testId))) 370 | package |> packageBenchmarks |> fromBenchmarks |> Set.toList |> 371 | mapM_ 372 | (\benchmark -> do 373 | let Benchmark {benchmarkName, benchmarkCondition} = benchmark 374 | runQuery connection insertBenchmarkName benchmarkName 375 | benchmarkNameId <- 376 | runQuery connection selectBenchmarkNameId benchmarkName 377 | runQuery connection insertCondition benchmarkCondition 378 | conditionId <- 379 | runQuery connection selectConditionId benchmarkCondition 380 | runQuery 381 | connection 382 | insertBenchmark 383 | (packageId, benchmarkNameId, conditionId) 384 | benchmarkId <- 385 | runQuery 386 | connection 387 | selectBenchmarkId 388 | (packageId, benchmarkNameId, conditionId) 389 | benchmark |> benchmarkDependencies |> fromDependencies |> 390 | Map.toAscList |> 391 | mapM_ 392 | (\(packageName, constraint) -> do 393 | runQuery connection insertConstraint constraint 394 | constraintId <- 395 | runQuery connection selectConstraintId constraint 396 | runQuery connection insertPackageName packageName 397 | packageNameId <- 398 | runQuery connection selectPackageNameId packageName 399 | runQuery 400 | connection 401 | insertDependency 402 | (constraintId, packageNameId) 403 | dependencyId <- 404 | runQuery 405 | connection 406 | selectDependencyId 407 | (constraintId, packageNameId) 408 | runQuery 409 | connection 410 | insertDependencyBenchmark 411 | (dependencyId, benchmarkId)))) 412 | 413 | logPackage :: Package -> Bool -> IO () 414 | logPackage package exists = 415 | Printf.printf 416 | "%s\t%s\t%d\t%s\n" 417 | (package |> packageName |> fromPackageName |> Text.unpack) 418 | (package |> packageVersion |> fromVersion |> map show |> 419 | List.intercalate ".") 420 | (package |> packageRevision |> fromRevision) 421 | (if exists 422 | then "old" 423 | else "new") 424 | 425 | toPackage :: Catch.MonadThrow m => Cabal.GenericPackageDescription -> m Package 426 | toPackage package = do 427 | revision <- 428 | package |> Cabal.packageDescription |> Cabal.customFieldsPD |> 429 | lookup "x-revision" |> 430 | Maybe.fromMaybe "0" |> 431 | Read.readMaybe |> 432 | fromJust "failed to read revision" |> 433 | fmap intToInt32 |> 434 | Monad.join |> 435 | fmap toRevision 436 | repos <- 437 | package |> Cabal.packageDescription |> Cabal.sourceRepos |> mapM toRepo 438 | version <- 439 | package |> Cabal.packageDescription |> Cabal.package |> Cabal.pkgVersion |> 440 | Cabal.versionNumbers |> 441 | mapM intToInt32 |> 442 | fmap toVersion 443 | pure 444 | Package 445 | { packageName = 446 | package |> Cabal.packageDescription |> Cabal.package |> Cabal.pkgName |> 447 | Cabal.unPackageName |> 448 | Text.pack |> 449 | toPackageName 450 | , packageVersion = version 451 | , packageRevision = revision 452 | , packageLicense = 453 | package |> Cabal.packageDescription |> Cabal.license |> Cabal.display |> 454 | Text.pack |> 455 | toLicense 456 | , packageSynopsis = 457 | package |> Cabal.packageDescription |> Cabal.synopsis |> Text.pack |> 458 | toSynopsis 459 | , packageDescription = 460 | package |> Cabal.packageDescription |> Cabal.description |> Text.pack |> 461 | toDescription 462 | , packageCategories = 463 | package |> Cabal.packageDescription |> Cabal.category |> Text.pack |> 464 | Text.splitOn (Text.singleton ',') |> 465 | map Text.strip |> 466 | filter (\x -> x |> Text.null |> not) |> 467 | map toCategory |> 468 | Set.fromList |> 469 | toCategories 470 | , packageUrl = 471 | package |> Cabal.packageDescription |> Cabal.homepage |> Text.pack |> 472 | toPackageUrl 473 | , packageRepos = repos |> Set.fromList |> toRepos 474 | , packageLibraries = 475 | let name = 476 | package |> Cabal.packageDescription |> Cabal.package |> 477 | Cabal.pkgName |> 478 | Cabal.unPackageName |> 479 | Text.pack |> 480 | toLibraryName 481 | library = 482 | package |> Cabal.packageDescription |> Cabal.library |> 483 | Foldable.toList |> 484 | map withoutConditionsOrConstraints 485 | libraries = 486 | package |> Cabal.packageDescription |> Cabal.subLibraries |> 487 | map withoutConditionsOrConstraints 488 | condLibrary = 489 | package |> Cabal.condLibrary |> Foldable.toList |> 490 | concatMap fromCondTree 491 | in [library, libraries, condLibrary] |> concat |> map (toLibrary name) |> 492 | Set.fromList |> 493 | toLibraries 494 | , packageExecutables = 495 | let executables = 496 | package |> Cabal.packageDescription |> Cabal.executables |> 497 | map withoutConditionsOrConstraints 498 | condExecutables = 499 | package |> Cabal.condExecutables |> 500 | concatMap 501 | (\(name, tree) -> 502 | tree |> fromCondTree |> 503 | map (Arrow.first (\x -> x {Cabal.exeName = name}))) 504 | in [executables, condExecutables] |> concat |> map toExecutable |> 505 | Set.fromList |> 506 | toExecutables 507 | , packageTests = 508 | let tests = 509 | package |> Cabal.packageDescription |> Cabal.testSuites |> 510 | map withoutConditionsOrConstraints 511 | condTests = 512 | package |> Cabal.condTestSuites |> 513 | concatMap 514 | (\(name, tree) -> 515 | tree |> fromCondTree |> 516 | map (Arrow.first (\x -> x {Cabal.testName = name}))) 517 | in [tests, condTests] |> concat |> map toTest |> Set.fromList |> 518 | toTests 519 | , packageBenchmarks = 520 | let benchmarks = 521 | package |> Cabal.packageDescription |> Cabal.benchmarks |> 522 | map withoutConditionsOrConstraints 523 | condBenchmarks = 524 | package |> Cabal.condBenchmarks |> 525 | concatMap 526 | (\(name, tree) -> 527 | tree |> fromCondTree |> 528 | map (Arrow.first (\x -> x {Cabal.benchmarkName = name}))) 529 | in [benchmarks, condBenchmarks] |> concat |> map toBenchmark |> 530 | Set.fromList |> 531 | toBenchmarks 532 | } 533 | 534 | toRepo :: Catch.MonadThrow m => Cabal.SourceRepo -> m Repo 535 | toRepo repo = do 536 | let repoKind = 537 | repo |> Cabal.repoKind |> Cabal.display |> Text.pack |> toRepoKind 538 | rawRepoType <- Cabal.repoType repo |> fromJust "could not get repo type" 539 | let repoType = rawRepoType |> Cabal.display |> Text.pack |> toRepoType 540 | rawRepoUrl <- Cabal.repoLocation repo |> fromJust "could not get repo URL" 541 | let repoUrl = rawRepoUrl |> Text.pack |> toRepoUrl 542 | pure Repo {repoKind, repoType, repoUrl} 543 | 544 | toLibrary :: 545 | LibraryName 546 | -> (Cabal.Library, ([Cabal.Condition Cabal.ConfVar], [Cabal.Dependency])) 547 | -> Library 548 | toLibrary name (library, (conditions, constraints)) = 549 | Library 550 | { libraryName = 551 | library |> Cabal.libName |> fmap Cabal.unUnqualComponentName |> 552 | fmap Text.pack |> 553 | fmap toLibraryName |> 554 | Maybe.fromMaybe name 555 | , libraryCondition = fromCabalConditions conditions 556 | , libraryModules = 557 | library |> Cabal.exposedModules |> 558 | map 559 | (\moduleName -> 560 | moduleName |> Cabal.components |> map Text.pack |> toModuleName) |> 561 | Set.fromList |> 562 | toModuleNames 563 | , libraryDependencies = 564 | library |> Cabal.libBuildInfo |> Cabal.targetBuildDepends |> 565 | map toDependency |> 566 | (++ map toDependency constraints) |> 567 | fromDependencyList 568 | } 569 | 570 | fromCabalConditions :: [Cabal.Condition Cabal.ConfVar] -> Condition 571 | fromCabalConditions conditions = 572 | conditions |> combineConditions |> simplifyCondition |> renderCondition |> 573 | Text.pack |> 574 | toCondition 575 | 576 | combineConditions :: 577 | [Cabal.Condition Cabal.ConfVar] -> Cabal.Condition Cabal.ConfVar 578 | combineConditions = foldr Cabal.CAnd (Cabal.Lit True) 579 | 580 | simplifyCondition :: 581 | Cabal.Condition Cabal.ConfVar -> Cabal.Condition Cabal.ConfVar 582 | simplifyCondition condition = 583 | case condition of 584 | Cabal.CNot this -> 585 | case simplifyCondition this of 586 | Cabal.Lit boolean -> Cabal.Lit (not boolean) 587 | Cabal.CNot that -> that 588 | that -> Cabal.CNot that 589 | Cabal.CAnd left right -> 590 | case (simplifyCondition left, simplifyCondition right) of 591 | (_, Cabal.Lit False) -> Cabal.Lit False 592 | (Cabal.Lit False, _) -> Cabal.Lit False 593 | (newLeft, Cabal.Lit True) -> newLeft 594 | (Cabal.Lit True, newRight) -> newRight 595 | (newLeft, newRight) -> Cabal.CAnd newLeft newRight 596 | Cabal.COr left right -> 597 | case (simplifyCondition left, simplifyCondition right) of 598 | (_, Cabal.Lit True) -> Cabal.Lit True 599 | (Cabal.Lit True, _) -> Cabal.Lit True 600 | (newLeft, Cabal.Lit False) -> newLeft 601 | (Cabal.Lit False, newRight) -> newRight 602 | (newLeft, newRight) -> Cabal.COr newLeft newRight 603 | _ -> condition 604 | 605 | renderCondition :: Cabal.Condition Cabal.ConfVar -> String 606 | renderCondition condition = 607 | case condition of 608 | Cabal.CAnd left right -> 609 | concat ["(", renderCondition left, " && ", renderCondition right, ")"] 610 | Cabal.CNot this -> concat ["!(", renderCondition this, ")"] 611 | Cabal.COr left right -> 612 | unwords ["(", renderCondition left, " || ", renderCondition right, ")"] 613 | Cabal.Lit boolean -> 614 | if boolean 615 | then "true" 616 | else "false" 617 | Cabal.Var confVar -> renderConfVar confVar 618 | 619 | renderConfVar :: Cabal.ConfVar -> String 620 | renderConfVar confVar = 621 | case confVar of 622 | Cabal.Arch arch -> concat ["arch(", Cabal.display arch, ")"] 623 | Cabal.Flag flag -> concat ["flag(", Cabal.unFlagName flag, ")"] 624 | Cabal.Impl compiler constraint -> 625 | concat 626 | [ "impl(" 627 | , Cabal.display compiler 628 | , " " 629 | , constraint |> Cabal.simplifyVersionRange |> Cabal.display 630 | , ")" 631 | ] 632 | Cabal.OS os -> concat ["os(", Cabal.display os, ")"] 633 | 634 | fromDependencyList :: [Dependency] -> Dependencies 635 | fromDependencyList dependencies = 636 | dependencies |> 637 | map 638 | (\dependency -> 639 | ( dependencyPackage dependency 640 | , dependency |> dependencyVersionBound |> fromVersionBound)) |> 641 | Map.fromListWith Cabal.intersectVersionRanges |> 642 | Map.map 643 | (\versionRange -> 644 | versionRange |> Cabal.simplifyVersionRange |> Cabal.display |> Text.pack |> 645 | toConstraint) |> 646 | toDependencies 647 | 648 | toDependency :: Cabal.Dependency -> Dependency 649 | toDependency (Cabal.Dependency packageName versionRange) = 650 | Dependency 651 | { dependencyPackage = 652 | packageName |> Cabal.unPackageName |> Text.pack |> toPackageName 653 | , dependencyVersionBound = toVersionBound versionRange 654 | } 655 | 656 | toExecutable :: 657 | (Cabal.Executable, ([Cabal.Condition Cabal.ConfVar], [Cabal.Dependency])) 658 | -> Executable 659 | toExecutable (executable, (conditions, constraints)) = 660 | Executable 661 | { executableName = 662 | executable |> Cabal.exeName |> Cabal.unUnqualComponentName |> Text.pack |> 663 | toExecutableName 664 | , executableCondition = fromCabalConditions conditions 665 | , executableDependencies = 666 | executable |> Cabal.buildInfo |> Cabal.targetBuildDepends |> 667 | map toDependency |> 668 | (++ map toDependency constraints) |> 669 | fromDependencyList 670 | } 671 | 672 | toTest :: 673 | (Cabal.TestSuite, ([Cabal.Condition Cabal.ConfVar], [Cabal.Dependency])) 674 | -> Test 675 | toTest (test, (conditions, constraints)) = 676 | Test 677 | { testName = 678 | toTestName . Text.pack . Cabal.unUnqualComponentName $ 679 | Cabal.testName test 680 | , testCondition = fromCabalConditions conditions 681 | , testDependencies = 682 | fromDependencyList . 683 | (++ map toDependency constraints) . 684 | map toDependency . Cabal.targetBuildDepends $ 685 | Cabal.testBuildInfo test 686 | } 687 | 688 | toBenchmark :: 689 | (Cabal.Benchmark, ([Cabal.Condition Cabal.ConfVar], [Cabal.Dependency])) 690 | -> Benchmark 691 | toBenchmark (benchmark, (conditions, constraints)) = 692 | Benchmark 693 | { benchmarkName = 694 | toBenchmarkName . Text.pack . Cabal.unUnqualComponentName $ 695 | Cabal.benchmarkName benchmark 696 | , benchmarkCondition = fromCabalConditions conditions 697 | , benchmarkDependencies = 698 | fromDependencyList . 699 | (++ map toDependency constraints) . 700 | map toDependency . Cabal.targetBuildDepends $ 701 | Cabal.benchmarkBuildInfo benchmark 702 | } 703 | 704 | withoutConditionsOrConstraints :: 705 | a -> (a, ([Cabal.Condition Cabal.ConfVar], [Cabal.Dependency])) 706 | withoutConditionsOrConstraints x = (x, ([], [])) 707 | 708 | nodeToTree :: 709 | Cabal.Condition v 710 | -> Cabal.CondTree v c a 711 | -> Tree.Tree (Cabal.Condition v, c, a) 712 | nodeToTree condition node = 713 | Tree.Node 714 | { Tree.rootLabel = 715 | (condition, Cabal.condTreeConstraints node, Cabal.condTreeData node) 716 | , Tree.subForest = concatMap branchToForest $ Cabal.condTreeComponents node 717 | } 718 | 719 | branchToForest :: 720 | Cabal.CondBranch v c a -> Tree.Forest (Cabal.Condition v, c, a) 721 | branchToForest branch = 722 | let condition = Cabal.condBranchCondition branch 723 | ifTrue = Cabal.condBranchIfTrue branch 724 | maybeIfFalse = Cabal.condBranchIfFalse branch 725 | first = nodeToTree condition ifTrue 726 | rest = maybe [] (pure . nodeToTree (Cabal.CNot condition)) maybeIfFalse 727 | in first : rest 728 | 729 | fromCondTree :: Cabal.CondTree v [c] a -> [(a, ([Cabal.Condition v], [c]))] 730 | fromCondTree = foldTree [] [] . nodeToTree (Cabal.Lit True) 731 | 732 | foldTree :: 733 | [Cabal.Condition v] 734 | -> [c] 735 | -> Tree.Tree (Cabal.Condition v, [c], a) 736 | -> [(a, ([Cabal.Condition v], [c]))] 737 | foldTree conditions constraints tree = 738 | case Tree.rootLabel tree of 739 | (condition, newConstraints, x) -> 740 | let allConditions = condition : conditions 741 | allConstraints = newConstraints ++ constraints 742 | first = (x, (allConditions, allConstraints)) 743 | rest = 744 | concatMap (foldTree allConditions allConstraints) $ 745 | Tree.subForest tree 746 | in first : rest 747 | 748 | fromEntries :: Tar.Entries a -> [Tar.Entry] 749 | fromEntries = Tar.foldEntries (:) [] (const []) 750 | 751 | parseDescription :: 752 | Catch.MonadThrow m => LazyText.Text -> m Cabal.GenericPackageDescription 753 | parseDescription = 754 | fromParseResult . Cabal.parseGenericPackageDescription . LazyText.unpack 755 | 756 | fromParseResult :: Catch.MonadThrow m => Cabal.ParseResult a -> m a 757 | fromParseResult result = 758 | case result of 759 | Cabal.ParseOk _ value -> pure value 760 | Cabal.ParseFailed problem -> 761 | throw $ "failed to parse package description: " ++ show problem 762 | 763 | getEntryContents :: Catch.MonadThrow m => Tar.Entry -> m LazyBytes.ByteString 764 | getEntryContents entry = 765 | case Tar.entryContent entry of 766 | Tar.NormalFile contents _ -> pure contents 767 | problem -> throw $ "failed to get entry contents: " ++ show problem 768 | 769 | isCabal :: Tar.Entry -> Bool 770 | isCabal = (== ".cabal") . Path.takeExtension . Tar.entryPath 771 | 772 | getCached :: 773 | FilePath -> FilePath -> IO LazyBytes.ByteString -> IO LazyBytes.ByteString 774 | getCached cacheDirectory file miss = do 775 | let path = Path.combine cacheDirectory file 776 | Exception.catch 777 | (LazyBytes.readFile path) 778 | (handleCacheMiss cacheDirectory miss path) 779 | 780 | handleCacheMiss :: 781 | FilePath 782 | -> IO LazyBytes.ByteString 783 | -> FilePath 784 | -> Exception.IOException 785 | -> IO LazyBytes.ByteString 786 | handleCacheMiss cacheDirectory miss path exception = do 787 | IO.hPrint IO.stderr exception 788 | contents <- miss 789 | Directory.createDirectoryIfMissing True cacheDirectory 790 | LazyBytes.writeFile path contents 791 | pure contents 792 | 793 | getLatestIndex :: String -> Client.Manager -> IO LazyBytes.ByteString 794 | getLatestIndex indexUrl manager = do 795 | request <- Client.parseRequest indexUrl 796 | response <- Client.httpLbs request manager 797 | pure $ Client.responseBody response 798 | 799 | getLatestIndexMd5 :: String -> Client.Manager -> IO String 800 | getLatestIndexMd5 indexUrl manager = do 801 | request <- Client.parseRequest indexUrl 802 | response <- 803 | Client.httpNoBody request {Client.method = Http.methodHead} manager 804 | getContentMd5 response 805 | 806 | getContentMd5 :: Catch.MonadThrow m => Client.Response body -> m String 807 | getContentMd5 response = do 808 | base64 <- 809 | fromJust "could not find Content-MD5 header" . lookup Http.hContentMD5 $ 810 | Client.responseHeaders response 811 | md5 <- fromRight $ Base64.decode base64 812 | base16 <- decodeUtf8 $ Base16.encode md5 813 | pure $ Text.unpack base16 814 | 815 | decodeUtf8 :: Catch.MonadThrow m => Bytes.ByteString -> m Text.Text 816 | decodeUtf8 = fromRight . Text.decodeUtf8' 817 | 818 | lazyDecodeUtf8 :: Catch.MonadThrow m => LazyBytes.ByteString -> m LazyText.Text 819 | lazyDecodeUtf8 = fromRight . LazyText.decodeUtf8' 820 | 821 | fromJust :: Catch.MonadThrow m => String -> Maybe a -> m a 822 | fromJust message = maybe (throw message) pure 823 | 824 | throw :: Catch.MonadThrow m => String -> m a 825 | throw = Catch.throwM . userError 826 | 827 | fromRight :: (Catch.MonadThrow m, Show left) => Either left right -> m right 828 | fromRight = either (throw . show) pure 829 | 830 | intToInt32 :: Catch.MonadThrow m => Int -> m Int.Int32 831 | intToInt32 x = 832 | if x > fromIntegral (maxBound :: Int.Int32) 833 | then throw $ show x ++ " is too big for Int32" 834 | else pure $ fromIntegral x 835 | --------------------------------------------------------------------------------