Compare commits
2 Commits
2caa00c06a
...
5a36ec328f
Author | SHA1 | Date | |
---|---|---|---|
5a36ec328f | |||
19a1aa26e4 |
@ -83,3 +83,4 @@ getScoreByAge conn = do
|
|||||||
- [ ] `FromRow`
|
- [ ] `FromRow`
|
||||||
- [ ] Custom `FromField` impls
|
- [ ] Custom `FromField` impls
|
||||||
- [ ] Improve type errors when trying to `instance` a type that isn't a record (e.g. sum type)
|
- [ ] Improve type errors when trying to `instance` a type that isn't a record (e.g. sum type)
|
||||||
|
- [ ] Improve documentation for `fromRow` module
|
||||||
|
37
flake.nix
37
flake.nix
@ -3,33 +3,24 @@
|
|||||||
|
|
||||||
outputs = { self, nixpkgs }:
|
outputs = { self, nixpkgs }:
|
||||||
let
|
let
|
||||||
pkgs = nixpkgs.legacyPackages.x86_64-linux;
|
system = "x86_64-linux";
|
||||||
in {
|
pkgs = nixpkgs.legacyPackages.${system};
|
||||||
apps.x86_64-linux.cabal = {
|
opium = pkgs.haskellPackages.developPackage {
|
||||||
type = "app";
|
root = ./.;
|
||||||
program = "${nixpkgs.legacyPackages.x86_64-linux.cabal-install}/bin/cabal";
|
modifier = drv:
|
||||||
};
|
pkgs.haskell.lib.addBuildTools drv [
|
||||||
devShells.x86_64-linux.default = pkgs.mkShell {
|
|
||||||
packages = [
|
|
||||||
pkgs.cabal-install
|
pkgs.cabal-install
|
||||||
pkgs.haskellPackages.implicit-hie
|
pkgs.haskellPackages.implicit-hie
|
||||||
(pkgs.ghc.withPackages (hp: with hp; [
|
|
||||||
attoparsec
|
|
||||||
containers
|
|
||||||
bytestring
|
|
||||||
hspec
|
|
||||||
postgresql-libpq
|
|
||||||
text
|
|
||||||
time
|
|
||||||
transformers
|
|
||||||
vector
|
|
||||||
]))
|
|
||||||
|
|
||||||
pkgs.haskell-language-server
|
pkgs.haskell-language-server
|
||||||
];
|
];
|
||||||
shellHook = ''
|
|
||||||
PS1="<opium> ''${PS1}"
|
|
||||||
'';
|
|
||||||
};
|
};
|
||||||
|
in {
|
||||||
|
packages.${system}.opium = pkgs.haskell.lib.overrideCabal opium {
|
||||||
|
# Currently the tests require a running Postgres instance.
|
||||||
|
# This is not automated yet, so don't export the tests.
|
||||||
|
doCheck = false;
|
||||||
|
};
|
||||||
|
|
||||||
|
devShells.${system}.default = opium.env;
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
@ -89,7 +89,7 @@ type family NumberOfMembers f where
|
|||||||
NumberOfMembers (M1 D _ f) = NumberOfMembers f
|
NumberOfMembers (M1 D _ f) = NumberOfMembers f
|
||||||
-- The constructor has as many members as the type that it contains.
|
-- The constructor has as many members as the type that it contains.
|
||||||
NumberOfMembers (M1 C _ f) = NumberOfMembers f
|
NumberOfMembers (M1 C _ f) = NumberOfMembers f
|
||||||
-- A product type has as many types as its subtypes have together.
|
-- A product type has as many members as its subtypes have together.
|
||||||
NumberOfMembers (f :*: g) = NumberOfMembers f + NumberOfMembers g
|
NumberOfMembers (f :*: g) = NumberOfMembers f + NumberOfMembers g
|
||||||
-- A selector has/is exactly one member.
|
-- A selector has/is exactly one member.
|
||||||
NumberOfMembers (M1 S _ f) = 1
|
NumberOfMembers (M1 S _ f) = 1
|
||||||
@ -99,19 +99,23 @@ data FromRowCtx = FromRowCtx
|
|||||||
Result -- ^ Obtained from 'LibPQ.execParams'.
|
Result -- ^ Obtained from 'LibPQ.execParams'.
|
||||||
ColumnTable -- ^ 'Vector' of expected columns indices and OIDs.
|
ColumnTable -- ^ 'Vector' of expected columns indices and OIDs.
|
||||||
|
|
||||||
|
-- Specialized proxy type to be used instead of `Proxy (n, f)`
|
||||||
data FRProxy (n :: Nat) (f :: Type -> Type) = FRProxy
|
data FRProxy (n :: Nat) (f :: Type -> Type) = FRProxy
|
||||||
|
|
||||||
class FromRow' (n :: Nat) (f :: Type -> Type) where
|
class FromRow' (n :: Nat) (f :: Type -> Type) where
|
||||||
fromRow' :: FRProxy n f -> FromRowCtx -> Row -> ExceptT Error IO (f p)
|
fromRow' :: FRProxy n f -> FromRowCtx -> Row -> ExceptT Error IO (f p)
|
||||||
|
|
||||||
instance FromRow' n f => FromRow' n (M1 D c f) where
|
instance FromRow' n f => FromRow' n (M1 D c f) where
|
||||||
fromRow' FRProxy ctx row = M1 <$> fromRow' @n FRProxy ctx row
|
fromRow' FRProxy ctx row =
|
||||||
|
M1 <$> fromRow' @n FRProxy ctx row
|
||||||
|
|
||||||
instance FromRow' n f => FromRow' n (M1 C c f) where
|
instance FromRow' n f => FromRow' n (M1 C c f) where
|
||||||
fromRow' FRProxy ctx row = M1 <$> fromRow' @n FRProxy ctx row
|
fromRow' FRProxy ctx row =
|
||||||
|
M1 <$> fromRow' @n FRProxy ctx row
|
||||||
|
|
||||||
instance (FromRow' n f, FromRow' (n + NumberOfMembers f) g) => FromRow' n (f :*: g) where
|
instance (FromRow' n f, FromRow' (n + NumberOfMembers f) g) => FromRow' n (f :*: g) where
|
||||||
fromRow' FRProxy ctx row = (:*:) <$> fromRow' @n FRProxy ctx row <*> fromRow' @(n + NumberOfMembers f) FRProxy ctx row
|
fromRow' FRProxy ctx row =
|
||||||
|
(:*:) <$> fromRow' @n FRProxy ctx row <*> fromRow' @(n + NumberOfMembers f) FRProxy ctx row
|
||||||
|
|
||||||
instance {-# OVERLAPPABLE #-} (KnownNat n, KnownSymbol nameSym, FromField t) => FromRow' n (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
|
instance {-# OVERLAPPABLE #-} (KnownNat n, KnownSymbol nameSym, FromField t) => FromRow' n (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
|
||||||
fromRow' FRProxy = decodeField memberIndex nameText $ \row ->
|
fromRow' FRProxy = decodeField memberIndex nameText $ \row ->
|
||||||
@ -158,4 +162,3 @@ decodeField memberIndex nameText g (FromRowCtx result columnTable) row = do
|
|||||||
first
|
first
|
||||||
(ErrorInvalidField (ErrorPosition row nameText) oid field)
|
(ErrorInvalidField (ErrorPosition row nameText) oid field)
|
||||||
(Just <$> fromField field)
|
(Just <$> fromField field)
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user