git.iko.soy/typeable/bucks
on 5c2439e help sign in
9e378b6
swap
0 ahead, 2 behind
bucks.cabal−16
since splitsnapshots
unifiedsplit
@@ -54,19 +54,3 @@ library
54 cpp-options: -DUSE_REL8
54 cpp-options: -DUSE_REL8
55 hs-source-dirs: src
55 hs-source-dirs: src
56 default-language: Haskell2010
56 default-language: Haskell2010
57−
58−test-suite rel8-test
59− import: warnings
60− type: exitcode-stdio-1.0
61− hs-source-dirs: test
62− main-is: Rel8Spec.hs
63− build-depends: base >= 4.14 && < 5.0,
64− bucks,
65− hasql,
66− hspec,
67− rel8
68− default-language: Haskell2010
69− if flag(rel8)
70− buildable: True
71− else
72− buildable: False
src/Data/Money/Rel8.hs+1−3
@@ -7,13 +7,11 @@ import Data.Money.Internal
7import Data.Scientific
7import Data.Scientific
8import Rel8
8import Rel8
9
9
10−import Debug.Trace
11−
12instance DBType (Money curr) where
10instance DBType (Money curr) where
13 typeInformation =
11 typeInformation =
14 let sci = typeInformation @Scientific
12 let sci = typeInformation @Scientific
15 in TypeInformation { encode = encode sci . realToFrac . getAmount
13 in TypeInformation { encode = encode sci . realToFrac . getAmount
16 , decode = fmap (Money . realToFrac) (decode sci)
14 , decode = fmap (Money . realToFrac) (decode sci)
17− , typeName = "decimal"
15+ , typeName = "money"
18 }
16 }
19
17
test/Rel8Spec.hsdeleted−87
@@ -1,87 +0,0 @@
1−{-# LANGUAGE DeriveAnyClass #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE DuplicateRecordFields #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE ImportQualifiedPost #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# OPTIONS_GHC -Wno-orphans #-}
8−module Main where
9−
10−import Control.Exception
11−import Data.Money
12−import GHC.Generics
13−import Hasql.Connection (Connection, ConnectionError)
14−import Hasql.Connection qualified as Hasql
15−import Hasql.Session qualified as Hasql
16−import Rel8
17−import Test.Hspec
18−
19−instance Exception ConnectionError
20−
21−data Exc = Exc String
22− deriving (Show)
23−
24−instance Exception Exc
25−
26−data Bucks f = Bucks { amount :: f (Money USD)
27− } deriving (Generic, Rel8able)
28−
29−bucksSchema :: TableSchema (Bucks Name)
30−bucksSchema = TableSchema { schema = Nothing
31− , name = "bucks"
32− , columns = Bucks { amount = "amount" }
33− }
34−
35−dbsets :: Hasql.Settings
36−dbsets = Hasql.settings "10.233.1.2" 5432 "bucks" "password" "bucks"
37−
38−throwLeft :: (Exception e, Applicative f) => Either e a -> f a
39−throwLeft (Left e) = throw e
40−throwLeft (Right a) = pure a
41−
42−onLeft :: Applicative f => Either a b -> (a -> f b) -> f b
43−onLeft (Left a) f = f a
44−onLeft (Right b) _ = pure b
45−
46−createConnection :: IO Connection
47−createConnection = throwLeft =<< Hasql.acquire dbsets
48−
49−createTable :: Connection -> IO ()
50−createTable conn = throwLeft =<< Hasql.run sql conn
51− where sql = Hasql.sql "CREATE TABLE bucks (amount decimal not null);"
52−
53−dropTable :: Connection -> IO ()
54−dropTable conn = throwLeft =<< Hasql.run sql conn
55− where sql = Hasql.sql "DROP TABLE IF EXISTS bucks;"
56−
57−truncateTable :: Connection -> IO ()
58−truncateTable conn = throwLeft =<< Hasql.run sql conn
59− where sql = Hasql.sql "TRUNCATE bucks;"
60−
61−insertMoney :: Connection -> Money USD -> IO ()
62−insertMoney conn m = throwLeft =<< Hasql.run (Hasql.statement () (insert ins)) conn
63− where ins = Insert { into = bucksSchema
64− , rows = values [ Bucks (lit m) ]
65− , onConflict = Abort
66− , returning = pure ()
67− }
68−
69−fetchMoney :: Connection -> IO (Money USD)
70−fetchMoney conn = f =<< throwLeft =<< Hasql.run (Hasql.statement () st) conn
71− where st = select $ do b <- each bucksSchema
72− return (amount b)
73− f [] = throw (Exc "Zero entries returned")
74− f [x] = pure x
75− f _ = throw (Exc "Multiple entries returned")
76−
77−main :: IO ()
78−main = do conn <- createConnection
79− dropTable conn
80− createTable conn
81− hspec $ before_ (truncateTable conn) $ do
82−
83− describe "Database tests" $ do
84− it "insert == select" $ do
85− let m = Money 12.23
86− insertMoney conn m
87− fetchMoney conn `shouldReturn` m