new structure, nix does not like symlinks
This commit is contained in:
parent
b61dc2d4fc
commit
e276c802a8
17 changed files with 677 additions and 223 deletions
7
.gitignore
vendored
7
.gitignore
vendored
|
|
@ -1,3 +1,4 @@
|
|||
dist-newstyle/**
|
||||
result
|
||||
dist/**
|
||||
**/dist-newstyle
|
||||
**/result
|
||||
**/dist
|
||||
server/db
|
||||
|
|
|
|||
8
client/cabal.project
Normal file
8
client/cabal.project
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
packages: rcv-site-client.cabal
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/haskell-servant/servant.git
|
||||
branch: master
|
||||
subdir: servant-client-ghcjs
|
||||
tag: 7ef9730f77bd2a20c9c5b3effce1b4126c79b8f7
|
||||
--sha256: botajkhbIiBi/MRUL6ES5w+FtY1kK07v1P6P6Yx6kmU=
|
||||
72
flake.lock → client/flake.lock
generated
72
flake.lock → client/flake.lock
generated
|
|
@ -20,10 +20,10 @@
|
|||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1603716527,
|
||||
"narHash": "sha256-sDbrmur9Zfp4mPKohCD8IDZfXJ0Tjxpmr2R+kg5PpSY=",
|
||||
"narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=",
|
||||
"owner": "haskell",
|
||||
"repo": "cabal",
|
||||
"rev": "94aaa8e4720081f9c75497e2735b90f6a819b08e",
|
||||
"rev": "48bf10787e27364730dd37a42b603cee8d6af7ee",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -36,11 +36,11 @@
|
|||
"cabal-34": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1622475795,
|
||||
"narHash": "sha256-chwTL304Cav+7p38d9mcb+egABWmxo2Aq+xgVBgEb/U=",
|
||||
"lastModified": 1640353650,
|
||||
"narHash": "sha256-N1t6M3/wqj90AEdRkeC8i923gQYUpzSr8b40qVOZ1Rk=",
|
||||
"owner": "haskell",
|
||||
"repo": "cabal",
|
||||
"rev": "b086c1995cdd616fc8d91f46a21e905cc50a1049",
|
||||
"rev": "942639c18c0cd8ec53e0a6f8d120091af35312cd",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -53,11 +53,11 @@
|
|||
"cabal-36": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1640163203,
|
||||
"narHash": "sha256-TwDWP2CffT0j40W6zr0J1Qbu+oh3nsF1lUx9446qxZM=",
|
||||
"lastModified": 1641652457,
|
||||
"narHash": "sha256-BlFPKP4C4HRUJeAbdembX1Rms1LD380q9s0qVDeoAak=",
|
||||
"owner": "haskell",
|
||||
"repo": "cabal",
|
||||
"rev": "ecf418050c1821f25e2e218f1be94c31e0465df1",
|
||||
"rev": "f27667f8ec360c475027dcaee0138c937477b070",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -85,11 +85,11 @@
|
|||
},
|
||||
"flake-utils": {
|
||||
"locked": {
|
||||
"lastModified": 1642700792,
|
||||
"narHash": "sha256-XqHrk7hFb+zBvRg6Ghl+AZDq03ov6OshJLiSWOoX5es=",
|
||||
"lastModified": 1644229661,
|
||||
"narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"rev": "846b2ae0fc4cc943637d3d1def4454213e203cba",
|
||||
"rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -100,11 +100,11 @@
|
|||
},
|
||||
"flake-utils_2": {
|
||||
"locked": {
|
||||
"lastModified": 1623875721,
|
||||
"narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=",
|
||||
"lastModified": 1644229661,
|
||||
"narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"rev": "f7e004a55b120c02ecb6219596820fcd32ca8772",
|
||||
"rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -133,11 +133,11 @@
|
|||
"hackage": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1642813925,
|
||||
"narHash": "sha256-YC6tY9mz1nbHONQugv6/20Tn8eJLHK0ijx3NUU+6/Cw=",
|
||||
"lastModified": 1646097829,
|
||||
"narHash": "sha256-PcHDDV8NuUxZhPV/p++IkZC+SDZ1Db7m7K+9HN4/0S4=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "hackage.nix",
|
||||
"rev": "a10b0a43b4672fc919c23a9c65002811c3da35ee",
|
||||
"rev": "283f096976b48e54183905e7bdde7f213c6ee5cd",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -160,7 +160,7 @@
|
|||
"nix-tools": "nix-tools",
|
||||
"nixpkgs": [
|
||||
"haskellNix",
|
||||
"nixpkgs-2111"
|
||||
"nixpkgs-unstable"
|
||||
],
|
||||
"nixpkgs-2003": "nixpkgs-2003",
|
||||
"nixpkgs-2105": "nixpkgs-2105",
|
||||
|
|
@ -170,11 +170,11 @@
|
|||
"stackage": "stackage"
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1642814073,
|
||||
"narHash": "sha256-dTG11aKY5N3vnq3jX9AqfvE4+ub/TaoAH8VyDwDprlw=",
|
||||
"lastModified": 1646097976,
|
||||
"narHash": "sha256-EiyrBqayw67dw8pr1XCVU9tIZ+/jzXCQycW1S9a+KFA=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "haskell.nix",
|
||||
"rev": "c11e9ee499a674ef236a6972a0081d920361faae",
|
||||
"rev": "f0308ed1df3ce9f10f9da1a7c0c8591921d0b4e5",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -202,11 +202,11 @@
|
|||
"nix-tools": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1636018067,
|
||||
"narHash": "sha256-ng306fkuwr6V/malWtt3979iAC4yMVDDH2ViwYB6sQE=",
|
||||
"lastModified": 1644395812,
|
||||
"narHash": "sha256-BVFk/BEsTLq5MMZvdy3ZYHKfaS3dHrsKh4+tb5t5b58=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "nix-tools",
|
||||
"rev": "ed5bd7215292deba55d6ab7a4e8c21f8b1564dda",
|
||||
"rev": "d847c63b99bbec78bf83be2a61dc9f09b8a9ccc1",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -233,11 +233,11 @@
|
|||
},
|
||||
"nixpkgs-2105": {
|
||||
"locked": {
|
||||
"lastModified": 1640283157,
|
||||
"narHash": "sha256-6Ddfop+rKE+Gl9Tjp9YIrkfoYPzb8F80ergdjcq3/MY=",
|
||||
"lastModified": 1642244250,
|
||||
"narHash": "sha256-vWpUEqQdVP4srj+/YLJRTN9vjpTs4je0cdWKXPbDItc=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "dde1557825c5644c869c5efc7448dc03722a8f09",
|
||||
"rev": "0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -249,11 +249,11 @@
|
|||
},
|
||||
"nixpkgs-2111": {
|
||||
"locked": {
|
||||
"lastModified": 1640283207,
|
||||
"narHash": "sha256-SCwl7ZnCfMDsuSYvwIroiAlk7n33bW8HFfY8NvKhcPA=",
|
||||
"lastModified": 1644510859,
|
||||
"narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "64c7e3388bbd9206e437713351e814366e0c3284",
|
||||
"rev": "0d1d5d7e3679fec9d07f2eb804d9f9fdb98378d3",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -265,11 +265,11 @@
|
|||
},
|
||||
"nixpkgs-unstable": {
|
||||
"locked": {
|
||||
"lastModified": 1641285291,
|
||||
"narHash": "sha256-KYaOBNGar3XWTxTsYPr9P6u74KAqNq0wobEC236U+0c=",
|
||||
"lastModified": 1644486793,
|
||||
"narHash": "sha256-EeijR4guVHgVv+JpOX3cQO+1XdrkJfGmiJ9XVsVU530=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "0432195a4b8d68faaa7d3d4b355260a3120aeeae",
|
||||
"rev": "1882c6b7368fd284ad01b0a5b5601ef136321292",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -309,11 +309,11 @@
|
|||
"stackage": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1642727755,
|
||||
"narHash": "sha256-30kMVckFauVEyzn+k32/0ugvSwK9w8H/Z/+KkJpRuAM=",
|
||||
"lastModified": 1646010978,
|
||||
"narHash": "sha256-NpioQiTXyYm+Gm111kcDEE/ghflmnTNwPhWff54GYA4=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "stackage.nix",
|
||||
"rev": "c430e00491da7502bf8812719ee7ab61dd035fab",
|
||||
"rev": "9cce3e0d420f6c38cdbbe1c5e5bbc07fd2adfc3a",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
@ -36,6 +36,6 @@
|
|||
};
|
||||
in flake // {
|
||||
# Built by `nix build .`
|
||||
defaultPackage = flake.packages."rcv-site:exe:client";
|
||||
defaultPackage = flake.packages."rcv-site-client:exe:client";
|
||||
});
|
||||
}
|
||||
36
client/rcv-site-client.cabal
Normal file
36
client/rcv-site-client.cabal
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
cabal-version: 3.0
|
||||
name: rcv-site-client
|
||||
version: 0.1.0.0
|
||||
category: Web
|
||||
build-type: Simple
|
||||
|
||||
-- this has to be built with ghcjs to be useful,
|
||||
-- but ghc should still be able build it
|
||||
executable client
|
||||
main-is:
|
||||
Main.hs
|
||||
default-extensions:
|
||||
DataKinds,
|
||||
DeriveGeneric,
|
||||
DuplicateRecordFields,
|
||||
OverloadedLists,
|
||||
OverloadedStrings,
|
||||
RecordWildCards,
|
||||
ScopedTypeVariables,
|
||||
TypeOperators
|
||||
ghcjs-options:
|
||||
-dedupe -DGHCJS_GC_INTERVAL=5000
|
||||
hs-source-dirs:
|
||||
src,
|
||||
shared-src
|
||||
build-depends:
|
||||
aeson,
|
||||
base < 5,
|
||||
containers,
|
||||
miso,
|
||||
servant,
|
||||
beam-core,
|
||||
text,
|
||||
servant-client-ghcjs
|
||||
default-language:
|
||||
Haskell2010
|
||||
1
client/shared-src
Symbolic link
1
client/shared-src
Symbolic link
|
|
@ -0,0 +1 @@
|
|||
../shared-src
|
||||
|
|
@ -1,93 +0,0 @@
|
|||
cabal-version: 3.0
|
||||
name: rcv-site
|
||||
version: 0.1.0.0
|
||||
category: Web
|
||||
build-type: Simple
|
||||
|
||||
executable server
|
||||
main-is:
|
||||
Main.hs
|
||||
default-extensions:
|
||||
DataKinds,
|
||||
DeriveAnyClass,
|
||||
DeriveGeneric,
|
||||
DuplicateRecordFields,
|
||||
FlexibleContexts,
|
||||
FlexibleInstances,
|
||||
MultiParamTypeClasses,
|
||||
OverloadedLabels,
|
||||
OverloadedLists,
|
||||
OverloadedStrings,
|
||||
RankNTypes,
|
||||
RecordWildCards,
|
||||
RecursiveDo,
|
||||
ScopedTypeVariables,
|
||||
TemplateHaskell,
|
||||
TupleSections,
|
||||
TypeFamilies,
|
||||
TypeOperators,
|
||||
UndecidableInstances,
|
||||
StandaloneDeriving
|
||||
hs-source-dirs:
|
||||
server,
|
||||
shared
|
||||
build-depends:
|
||||
aeson,
|
||||
base,
|
||||
beam-core,
|
||||
beam-sqlite,
|
||||
beam-migrate,
|
||||
containers,
|
||||
http-types,
|
||||
lucid,
|
||||
miso,
|
||||
mtl,
|
||||
network-uri,
|
||||
servant,
|
||||
servant-lucid,
|
||||
servant-server,
|
||||
sqlite-simple,
|
||||
text,
|
||||
wai,
|
||||
wai-app-static,
|
||||
wai-extra,
|
||||
warp
|
||||
default-language:
|
||||
Haskell2010
|
||||
other-modules:
|
||||
API
|
||||
Database
|
||||
InstantRunoff
|
||||
|
||||
|
||||
|
||||
-- this has to be built with ghcjs to be useful,
|
||||
-- but ghc should still be able build it
|
||||
executable client
|
||||
main-is:
|
||||
Main.hs
|
||||
default-extensions:
|
||||
DataKinds,
|
||||
DeriveGeneric,
|
||||
DuplicateRecordFields,
|
||||
OverloadedLists,
|
||||
OverloadedStrings,
|
||||
RecordWildCards,
|
||||
ScopedTypeVariables,
|
||||
TypeOperators
|
||||
ghcjs-options:
|
||||
-dedupe -DGHCJS_GC_INTERVAL=5000
|
||||
hs-source-dirs:
|
||||
client,
|
||||
shared
|
||||
build-depends:
|
||||
aeson,
|
||||
base < 5,
|
||||
containers,
|
||||
miso,
|
||||
servant,
|
||||
-- beam-core,
|
||||
text
|
||||
-- servant-client-ghcjs
|
||||
default-language:
|
||||
Haskell2010
|
||||
|
|
@ -1,83 +0,0 @@
|
|||
module Database where
|
||||
|
||||
import qualified Database.Beam as B
|
||||
|
||||
import qualified Database.SQLite.Simple as SQLS
|
||||
import qualified Database.Beam.Sqlite as BS
|
||||
import qualified Database.Beam.Sqlite.Migrate as BSM
|
||||
import GHC.Generics (Generic)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.List.NonEmpty as LN
|
||||
import Data.Aeson
|
||||
import qualified Database.Beam.Migrate as BM
|
||||
import qualified Database.Beam.Migrate.Simple as BMS
|
||||
import Data.Word
|
||||
import Database.Beam.Sqlite (runBeamSqlite)
|
||||
import qualified Database.Beam.Sqlite.Migrate as BSM
|
||||
-- import qualified Database.Beam.Postgres as BP
|
||||
|
||||
data PollT f = PollT {
|
||||
identity :: B.C f Word32,
|
||||
question :: B.C f T.Text
|
||||
} deriving (Generic, B.Beamable)
|
||||
|
||||
data OptionT f = OptionT {
|
||||
identity:: B.C f Word32,
|
||||
name :: B.C f T.Text,
|
||||
forPoll :: B.PrimaryKey PollT f
|
||||
} deriving (Generic, B.Beamable)
|
||||
|
||||
newtype BallotT f = BallotT {
|
||||
identity:: B.C f Word32
|
||||
} deriving (Generic, B.Beamable)
|
||||
|
||||
data VoteT f = VoteT {
|
||||
order :: B.C f Word32,
|
||||
option :: B.PrimaryKey PollT f,
|
||||
ballot :: B.PrimaryKey BallotT f
|
||||
} deriving (Generic, B.Beamable)
|
||||
|
||||
instance B.Table PollT where
|
||||
data PrimaryKey PollT f = PollId (B.Columnar f Word32) deriving (Generic, B.Beamable)
|
||||
primaryKey = PollId . (identity :: PollT f -> B.C f Word32)
|
||||
|
||||
instance B.Table OptionT where
|
||||
data PrimaryKey OptionT f = OptionId (B.Columnar f Word32) deriving (Generic, B.Beamable)
|
||||
primaryKey = OptionId . (identity :: OptionT f -> B.Columnar f Word32)
|
||||
|
||||
instance B.Table BallotT where
|
||||
data PrimaryKey BallotT f = BallotId (B.Columnar f Word32) deriving (Generic, B.Beamable)
|
||||
primaryKey = BallotId . (identity :: BallotT f -> B.Columnar f Word32)
|
||||
|
||||
instance B.Table VoteT where
|
||||
data PrimaryKey VoteT f = VoteId (B.C f Word32) (B.PrimaryKey PollT f) (B.PrimaryKey BallotT f) deriving (Generic, B.Beamable)
|
||||
primaryKey = VoteId <$> order <*> option <*> ballot
|
||||
|
||||
type PollId = B.PrimaryKey PollT B.Identity
|
||||
|
||||
-- the actual database
|
||||
data PollDatabase f = PollDatabase {
|
||||
polls :: f (B.TableEntity PollT),
|
||||
options :: f (B.TableEntity PollT),
|
||||
ballots :: f (B.TableEntity BallotT),
|
||||
votes :: f (B.TableEntity VoteT)
|
||||
} deriving (Generic, B.Database e)
|
||||
|
||||
|
||||
-- settings :: B.DatabaseSettings be PollDatabase
|
||||
-- settings = B.defaultDbSettings
|
||||
|
||||
migrateSettings :: BM.CheckedDatabaseSettings BS.Sqlite PollDatabase
|
||||
migrateSettings = BM.defaultMigratableDbSettings
|
||||
|
||||
connection :: IO SQLS.Connection
|
||||
connection = SQLS.open "rcv-site.db"
|
||||
|
||||
-- beamConnection = BS.runBeamSqliteDebug
|
||||
-- makeDB :: BS.Sqlite
|
||||
makeDB = do
|
||||
BMS.createSchema BSM.migrationBackend migrateSettings
|
||||
-- connection' <- connection
|
||||
-- BS.runBeamSqlite putStrLn connection
|
||||
|
||||
-- createdschema :: BMS.createSchema
|
||||
328
server/flake.lock
generated
Normal file
328
server/flake.lock
generated
Normal file
|
|
@ -0,0 +1,328 @@
|
|||
{
|
||||
"nodes": {
|
||||
"HTTP": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1451647621,
|
||||
"narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=",
|
||||
"owner": "phadej",
|
||||
"repo": "HTTP",
|
||||
"rev": "9bc0996d412fef1787449d841277ef663ad9a915",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "phadej",
|
||||
"repo": "HTTP",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"cabal-32": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1603716527,
|
||||
"narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=",
|
||||
"owner": "haskell",
|
||||
"repo": "cabal",
|
||||
"rev": "48bf10787e27364730dd37a42b603cee8d6af7ee",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "haskell",
|
||||
"ref": "3.2",
|
||||
"repo": "cabal",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"cabal-34": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1640353650,
|
||||
"narHash": "sha256-N1t6M3/wqj90AEdRkeC8i923gQYUpzSr8b40qVOZ1Rk=",
|
||||
"owner": "haskell",
|
||||
"repo": "cabal",
|
||||
"rev": "942639c18c0cd8ec53e0a6f8d120091af35312cd",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "haskell",
|
||||
"ref": "3.4",
|
||||
"repo": "cabal",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"cabal-36": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1641652457,
|
||||
"narHash": "sha256-BlFPKP4C4HRUJeAbdembX1Rms1LD380q9s0qVDeoAak=",
|
||||
"owner": "haskell",
|
||||
"repo": "cabal",
|
||||
"rev": "f27667f8ec360c475027dcaee0138c937477b070",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "haskell",
|
||||
"ref": "3.6",
|
||||
"repo": "cabal",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"cardano-shell": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1608537748,
|
||||
"narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "cardano-shell",
|
||||
"rev": "9392c75087cb9a3d453998f4230930dea3a95725",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "input-output-hk",
|
||||
"repo": "cardano-shell",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"flake-utils": {
|
||||
"locked": {
|
||||
"lastModified": 1644229661,
|
||||
"narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"flake-utils_2": {
|
||||
"locked": {
|
||||
"lastModified": 1644229661,
|
||||
"narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"ghc-8.6.5-iohk": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1600920045,
|
||||
"narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "ghc",
|
||||
"rev": "95713a6ecce4551240da7c96b6176f980af75cae",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "input-output-hk",
|
||||
"ref": "release/8.6.5-iohk",
|
||||
"repo": "ghc",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"hackage": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1646097829,
|
||||
"narHash": "sha256-PcHDDV8NuUxZhPV/p++IkZC+SDZ1Db7m7K+9HN4/0S4=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "hackage.nix",
|
||||
"rev": "283f096976b48e54183905e7bdde7f213c6ee5cd",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "input-output-hk",
|
||||
"repo": "hackage.nix",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"haskellNix": {
|
||||
"inputs": {
|
||||
"HTTP": "HTTP",
|
||||
"cabal-32": "cabal-32",
|
||||
"cabal-34": "cabal-34",
|
||||
"cabal-36": "cabal-36",
|
||||
"cardano-shell": "cardano-shell",
|
||||
"flake-utils": "flake-utils_2",
|
||||
"ghc-8.6.5-iohk": "ghc-8.6.5-iohk",
|
||||
"hackage": "hackage",
|
||||
"hpc-coveralls": "hpc-coveralls",
|
||||
"nix-tools": "nix-tools",
|
||||
"nixpkgs": [
|
||||
"haskellNix",
|
||||
"nixpkgs-unstable"
|
||||
],
|
||||
"nixpkgs-2003": "nixpkgs-2003",
|
||||
"nixpkgs-2105": "nixpkgs-2105",
|
||||
"nixpkgs-2111": "nixpkgs-2111",
|
||||
"nixpkgs-unstable": "nixpkgs-unstable",
|
||||
"old-ghc-nix": "old-ghc-nix",
|
||||
"stackage": "stackage"
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1646097976,
|
||||
"narHash": "sha256-EiyrBqayw67dw8pr1XCVU9tIZ+/jzXCQycW1S9a+KFA=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "haskell.nix",
|
||||
"rev": "f0308ed1df3ce9f10f9da1a7c0c8591921d0b4e5",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "input-output-hk",
|
||||
"repo": "haskell.nix",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"hpc-coveralls": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1607498076,
|
||||
"narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=",
|
||||
"owner": "sevanspowell",
|
||||
"repo": "hpc-coveralls",
|
||||
"rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "sevanspowell",
|
||||
"repo": "hpc-coveralls",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nix-tools": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1644395812,
|
||||
"narHash": "sha256-BVFk/BEsTLq5MMZvdy3ZYHKfaS3dHrsKh4+tb5t5b58=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "nix-tools",
|
||||
"rev": "d847c63b99bbec78bf83be2a61dc9f09b8a9ccc1",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "input-output-hk",
|
||||
"repo": "nix-tools",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs-2003": {
|
||||
"locked": {
|
||||
"lastModified": 1620055814,
|
||||
"narHash": "sha256-8LEHoYSJiL901bTMVatq+rf8y7QtWuZhwwpKE2fyaRY=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "1db42b7fe3878f3f5f7a4f2dc210772fd080e205",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "NixOS",
|
||||
"ref": "nixpkgs-20.03-darwin",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs-2105": {
|
||||
"locked": {
|
||||
"lastModified": 1642244250,
|
||||
"narHash": "sha256-vWpUEqQdVP4srj+/YLJRTN9vjpTs4je0cdWKXPbDItc=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "NixOS",
|
||||
"ref": "nixpkgs-21.05-darwin",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs-2111": {
|
||||
"locked": {
|
||||
"lastModified": 1644510859,
|
||||
"narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "0d1d5d7e3679fec9d07f2eb804d9f9fdb98378d3",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "NixOS",
|
||||
"ref": "nixpkgs-21.11-darwin",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs-unstable": {
|
||||
"locked": {
|
||||
"lastModified": 1644486793,
|
||||
"narHash": "sha256-EeijR4guVHgVv+JpOX3cQO+1XdrkJfGmiJ9XVsVU530=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "1882c6b7368fd284ad01b0a5b5601ef136321292",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "NixOS",
|
||||
"ref": "nixpkgs-unstable",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"old-ghc-nix": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1631092763,
|
||||
"narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=",
|
||||
"owner": "angerman",
|
||||
"repo": "old-ghc-nix",
|
||||
"rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "angerman",
|
||||
"ref": "master",
|
||||
"repo": "old-ghc-nix",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"root": {
|
||||
"inputs": {
|
||||
"flake-utils": "flake-utils",
|
||||
"haskellNix": "haskellNix",
|
||||
"nixpkgs": [
|
||||
"haskellNix",
|
||||
"nixpkgs-unstable"
|
||||
]
|
||||
}
|
||||
},
|
||||
"stackage": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1646010978,
|
||||
"narHash": "sha256-NpioQiTXyYm+Gm111kcDEE/ghflmnTNwPhWff54GYA4=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "stackage.nix",
|
||||
"rev": "9cce3e0d420f6c38cdbbe1c5e5bbc07fd2adfc3a",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "input-output-hk",
|
||||
"repo": "stackage.nix",
|
||||
"type": "github"
|
||||
}
|
||||
}
|
||||
},
|
||||
"root": "root",
|
||||
"version": 7
|
||||
}
|
||||
41
server/flake.nix
Normal file
41
server/flake.nix
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
{
|
||||
description = "A very basic flake";
|
||||
inputs.haskellNix.url = "github:input-output-hk/haskell.nix";
|
||||
inputs.nixpkgs.follows = "haskellNix/nixpkgs-unstable";
|
||||
inputs.flake-utils.url = "github:numtide/flake-utils";
|
||||
outputs = { self, nixpkgs, flake-utils, haskellNix }:
|
||||
flake-utils.lib.eachSystem [ "x86_64-linux" "x86_64-darwin" ] (system:
|
||||
let
|
||||
overlays = [ haskellNix.overlay
|
||||
(final: prev: {
|
||||
# This overlay adds our project to pkgs
|
||||
helloProject =
|
||||
final.haskell-nix.project' {
|
||||
src = ./.;
|
||||
compiler-nix-name = "ghc8107";
|
||||
# This is used by `nix develop .` to open a shell for use with
|
||||
# `cabal`, `hlint` and `haskell-language-server`
|
||||
shell.tools = {
|
||||
cabal = {};
|
||||
hlint = {};
|
||||
haskell-language-server = {};
|
||||
};
|
||||
# Non-Haskell shell tools go here
|
||||
shell.buildInputs = with pkgs; [
|
||||
nixpkgs-fmt
|
||||
];
|
||||
# This adds `js-unknown-ghcjs-cabal` to the shell.
|
||||
shell.crossPlatform = p: [p.ghcjs];
|
||||
};
|
||||
})
|
||||
];
|
||||
pkgs = import nixpkgs { inherit system overlays; inherit (haskellNix) config; };
|
||||
flake = pkgs.helloProject.flake {
|
||||
# This adds support for `nix build .#js-unknown-ghcjs-cabal:hello:exe:hello`
|
||||
crossPlatforms = p: [p.ghcjs];
|
||||
};
|
||||
in flake // {
|
||||
# Built by `nix build .`
|
||||
defaultPackage = flake.packages."rcv-site-server:exe:server";
|
||||
});
|
||||
}
|
||||
64
server/rcv-site-server.cabal
Normal file
64
server/rcv-site-server.cabal
Normal file
|
|
@ -0,0 +1,64 @@
|
|||
cabal-version: 3.0
|
||||
name: rcv-site-server
|
||||
version: 0.1.0.0
|
||||
category: Web
|
||||
build-type: Simple
|
||||
|
||||
executable server
|
||||
main-is:
|
||||
Main.hs
|
||||
default-extensions:
|
||||
-- DataKinds,
|
||||
DeriveAnyClass,
|
||||
DeriveGeneric,
|
||||
DuplicateRecordFields,
|
||||
FlexibleContexts,
|
||||
-- FlexibleInstances,
|
||||
-- ImpredicativeTypes,
|
||||
-- MultiParamTypeClasses,
|
||||
-- OverloadedLabels,
|
||||
-- OverloadedLists,
|
||||
OverloadedStrings,
|
||||
-- PartialTypeSignatures,
|
||||
RankNTypes,
|
||||
RecordWildCards,
|
||||
-- RecursiveDo,
|
||||
ScopedTypeVariables,
|
||||
StandaloneDeriving,
|
||||
-- TemplateHaskell,
|
||||
-- TupleSections,
|
||||
-- TypeApplications,
|
||||
TypeFamilies,
|
||||
-- TypeOperators,
|
||||
TypeSynonymInstances,
|
||||
-- UndecidableInstances,
|
||||
hs-source-dirs:
|
||||
src,
|
||||
shared-src
|
||||
build-depends:
|
||||
aeson,
|
||||
base,
|
||||
beam-core ^>= 0.9.2.0,
|
||||
beam-migrate,
|
||||
beam-postgres ^>= 0.5.2.0,
|
||||
containers,
|
||||
http-types,
|
||||
lucid,
|
||||
miso,
|
||||
mtl,
|
||||
network-uri,
|
||||
postgresql-simple,
|
||||
servant,
|
||||
servant-lucid,
|
||||
servant-server,
|
||||
text,
|
||||
wai,
|
||||
wai-app-static,
|
||||
wai-extra,
|
||||
warp
|
||||
default-language:
|
||||
Haskell2010
|
||||
other-modules:
|
||||
API
|
||||
Database
|
||||
InstantRunoff
|
||||
1
server/shared-src
Symbolic link
1
server/shared-src
Symbolic link
|
|
@ -0,0 +1 @@
|
|||
../shared-src
|
||||
146
server/src/Database.hs
Normal file
146
server/src/Database.hs
Normal file
|
|
@ -0,0 +1,146 @@
|
|||
module Database where
|
||||
|
||||
import Data.Word
|
||||
import Data.Int
|
||||
import GHC.Generics (Generic)
|
||||
import qualified Data.List as L
|
||||
import qualified Data.List.NonEmpty as LN
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.Beam as B
|
||||
import qualified Database.Beam.Migrate as BM
|
||||
import qualified Database.Beam.Migrate.Simple as BMS
|
||||
import qualified API as A
|
||||
import qualified Database.Beam.Postgres as BP
|
||||
import qualified Database.Beam.Postgres.Migrate as BPM
|
||||
import qualified Database.PostgreSQL.Simple as PS
|
||||
import qualified Data.String as S
|
||||
import Database.Beam.Backend.SQL (SqlSerial, IsSql92DataTypeSyntax (domainType))
|
||||
import Database.Beam.Postgres as B ( connect )
|
||||
import qualified Database.Beam as BM
|
||||
import Database.Beam.Backend.SQL.BeamExtensions as BQSLE
|
||||
import qualified Database.Beam.Backend.SQL.BeamExtensions as BSQLE
|
||||
import qualified Database.Beam.Postgres.Conduit as BC
|
||||
|
||||
|
||||
|
||||
data PollT f = PollT {
|
||||
identity :: B.C f Int32,
|
||||
question :: B.C f T.Text
|
||||
} deriving (Generic, B.Beamable)
|
||||
|
||||
type Poll = PollT B.Identity
|
||||
|
||||
|
||||
-- deriving instance Show Poll
|
||||
-- deriving instance Eq Poll
|
||||
-- deriving instance Ord Poll
|
||||
|
||||
data OptionT f = OptionT {
|
||||
identity:: B.C f Int32,
|
||||
forPoll :: B.PrimaryKey PollT f,
|
||||
name :: B.C f T.Text
|
||||
} deriving (Generic, B.Beamable)
|
||||
|
||||
type Option = OptionT B.Identity
|
||||
|
||||
|
||||
newtype BallotT f = BallotT {
|
||||
identity:: B.C f Int32
|
||||
} deriving (Generic, B.Beamable)
|
||||
|
||||
type Ballot = BallotT B.Identity
|
||||
|
||||
-- deriving instance Show Ballot
|
||||
-- deriving instance Eq Ballot
|
||||
-- deriving instance Ord Ballot
|
||||
|
||||
data VoteT f = VoteT {
|
||||
ballot :: B.PrimaryKey BallotT f,
|
||||
order :: B.C f Int32,
|
||||
option :: B.PrimaryKey OptionT f
|
||||
} deriving (Generic, B.Beamable)
|
||||
|
||||
|
||||
type Vote = VoteT B.Identity
|
||||
|
||||
instance B.Table PollT where
|
||||
data PrimaryKey PollT f = PollId (B.Columnar f Int32) deriving (Generic, B.Beamable)
|
||||
primaryKey = PollId . (identity :: PollT f -> B.C f Int32)
|
||||
|
||||
instance B.Table OptionT where
|
||||
data PrimaryKey OptionT f = OptionId (B.Columnar f Int32) deriving (Generic, B.Beamable)
|
||||
primaryKey = OptionId . (identity :: OptionT f -> B.Columnar f Int32)
|
||||
|
||||
instance B.Table BallotT where
|
||||
data PrimaryKey BallotT f = BallotId (B.Columnar f Int32) deriving (Generic, B.Beamable)
|
||||
primaryKey = BallotId . (identity :: BallotT f -> B.Columnar f Int32)
|
||||
|
||||
instance B.Table VoteT where
|
||||
data PrimaryKey VoteT f = VoteId (B.C f Int32) (B.PrimaryKey OptionT f) (B.PrimaryKey BallotT f) deriving (Generic, B.Beamable)
|
||||
primaryKey = VoteId <$> order <*> option <*> ballot
|
||||
|
||||
type PollId = B.PrimaryKey PollT B.Identity
|
||||
|
||||
-- the actual database
|
||||
data PollDatabase f = PollDatabase {
|
||||
polls :: f (B.TableEntity PollT),
|
||||
options :: f (B.TableEntity OptionT),
|
||||
ballots :: f (B.TableEntity BallotT),
|
||||
votes :: f (B.TableEntity VoteT)
|
||||
} deriving (Generic, B.Database be)
|
||||
|
||||
|
||||
|
||||
-- getPoll :: B.MonadBeam BP.Postgres m => SqlSerial Int32 -> m (Maybe (OptionT B.Identity, PollT B.Identity))
|
||||
-- getPoll :: BM.MonadBeam BP.Postgres m => Int32 -> m (Maybe (Option, Poll))
|
||||
getPoll :: Int32 -> BM.SqlSelect BP.Postgres (Option, Poll)
|
||||
getPoll id = B.select $ do
|
||||
poll' <- B.all_ $ polls pollDb
|
||||
B.guard_ ((identity :: PollT f -> B.C f Int32) poll' B.==. B.val_ id)
|
||||
options' <- B.all_ $ options pollDb
|
||||
B.guard_ ((forPoll :: OptionT f -> B.PrimaryKey PollT f) options' B.==. (B.val_ . PollId $ id))
|
||||
pure (options', poll')
|
||||
|
||||
-- getPollResults :: BM.MonadBeam BP.Postgres m => Int32 -> m (Maybe (Option, Poll, [Vote]))
|
||||
getPollResults id = B.runSelectReturningList $ do
|
||||
pollResults <- getPoll id
|
||||
(flip fmap) pollResults $ \ (option', poll') -> B.select $ do
|
||||
votes' <- B.all_ $ votes pollDb
|
||||
B.guard_ (options pollDb)
|
||||
-- let = vote'
|
||||
-- B.guard_ (option `B.in_` )
|
||||
-- pure $ Just ()
|
||||
|
||||
|
||||
insertPoll :: MonadBeamInsertReturning BP.Postgres m => T.Text -> [T.Text] -> m (PollT BM.Identity, [OptionT BM.Identity])
|
||||
insertPoll question optionNames = do
|
||||
pollId <- BSQLE.runInsertReturningList . B.insert (polls pollDb) $ B.insertExpressions [poll']
|
||||
optionIds <- BSQLE.runInsertReturningList . B.insert (options pollDb) $ B.insertExpressions options'
|
||||
pure (head pollId, optionIds)
|
||||
where
|
||||
poll' :: PollT (B.QExpr BP.Postgres s)
|
||||
poll' = PollT B.default_ (B.val_ question)
|
||||
|
||||
options' :: [OptionT (B.QExpr BP.Postgres s)]
|
||||
options' = map (OptionT B.default_ (B.pk poll') . B.val_) optionNames
|
||||
|
||||
|
||||
-- postBallot :: MonadBeamInsertReturning BP.Postgres m => Int32 -> [Int32] -> m ()
|
||||
postBallot pollKey optionKeys = do
|
||||
ballot <- BSQLE.runInsertReturningList . B.insert (ballots pollDb) $ B.insertExpressions [BallotT B.default_]
|
||||
-- options' <- getPoll pollKey
|
||||
B.runInsert . B.insert (votes pollDb) $ B.insertValues $ votes' . head $ ballot
|
||||
pure ()
|
||||
where
|
||||
votes' :: BallotT B.Identity -> [VoteT B.Identity]
|
||||
votes' ballot = zipWith (VoteT (B.primaryKey ballot)) [0..] . map OptionId $ optionKeys
|
||||
|
||||
pollDb :: B.DatabaseSettings BP.Postgres PollDatabase
|
||||
pollDb = BM.unCheckDatabase checkedSettings
|
||||
|
||||
checkedSettings :: BM.CheckedDatabaseSettings BP.Postgres PollDatabase
|
||||
checkedSettings = BM.defaultMigratableDbSettings
|
||||
|
||||
connection = PS.connect PS.defaultConnectInfo
|
||||
|
||||
makeDB = BMS.createSchema BPM.migrationBackend checkedSettings
|
||||
|
|
@ -18,6 +18,7 @@ import qualified Data.Set as S
|
|||
import qualified Data.Text.IO as T
|
||||
import qualified Database as DB
|
||||
import Database.Beam.Sqlite (runBeamSqlite)
|
||||
import qualified Miso.Svg as DB
|
||||
|
||||
staticDir = "./static"
|
||||
|
||||
|
|
@ -61,6 +62,7 @@ staticDir = "./static"
|
|||
|
||||
-- main :: IO ()
|
||||
main = do
|
||||
-- DB.addTestPoll
|
||||
connection <- DB.connection
|
||||
runBeamSqlite connection DB.makeDB
|
||||
-- main = W.run 8080 app
|
||||
|
|
@ -4,15 +4,11 @@ module API where
|
|||
import GHC.Generics
|
||||
import Servant.API
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Aeson
|
||||
import Data.Word
|
||||
import qualified Data.List.NonEmpty as LN
|
||||
-- import qualified Database.Beam as B
|
||||
|
||||
|
||||
-- this is difficult, MisoString is more performant on front-end (and is a Text alias under GHC)
|
||||
-- but Text is so well supported that it's a large loss on back-end
|
||||
-- or we paramaterize all of our types on their text format
|
||||
import qualified Database.Beam as B
|
||||
|
||||
|
||||
-- type RCVAPI =
|
||||
|
|
@ -20,3 +16,9 @@ import qualified Data.List.NonEmpty as LN
|
|||
-- :<|> "poll" :> "create" :> ReqBody '[JSON] Poll :> Post '[JSON] Int
|
||||
-- :<|> "poll" :> Capture "pollId" Int :> "options" :> Get '[JSON] Poll -- not sure about the name for this endpoint
|
||||
-- :<|> "poll" :> Capture "pollId" Int :> "result" :> Get '[JSON] [Text]
|
||||
|
||||
|
||||
|
||||
-- deriving instance Show Vote
|
||||
-- deriving instance Eq Vote
|
||||
-- deriving instance Ord Vote
|
||||
Loading…
Add table
Add a link
Reference in a new issue