git.iko.soy/typeable/bucks
on master help sign in
I make up things as I go along.
commit85f13d3dea39e998947927c5e6362da1777f3794 authorNick <nick@typeable.io> dateMon 28 Nov 2022, 09:58 (4 years ago)
8 files changed+159
compare with master
unifiedsplit
LICENSE+20 bucks.cabal+32 hie.yaml+2 src/Data/Money.hs+8 src/Data/Money/Currencies.hs+13 src/Data/Money/Internal.hs+51 src/Data/Money/JSON.hs+25 stack.yaml+8
LICENSEnew file+20
@@ -0,0 +1,20 @@
1+Copyright (c) 2022 Nick
2+
3+Permission is hereby granted, free of charge, to any person obtaining
4+a copy of this software and associated documentation files (the
5+"Software"), to deal in the Software without restriction, including
6+without limitation the rights to use, copy, modify, merge, publish,
7+distribute, sublicense, and/or sell copies of the Software, and to
8+permit persons to whom the Software is furnished to do so, subject to
9+the following conditions:
10+
11+The above copyright notice and this permission notice shall be included
12+in all copies or substantial portions of the Software.
13+
14+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
17+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
18+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
19+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
20+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
bucks.cabalnew file+32
@@ -0,0 +1,32 @@
1+cabal-version: 3.0
2+name: bucks
3+version: 0.1
4+synopsis: Money handling library
5+-- description:
6+license: MIT
7+license-file: LICENSE
8+author: Nick
9+maintainer: nick@typeable.io
10+category: Data
11+build-type: Simple
12+
13+flag aeson
14+ description: Enable Aeson instances
15+ default: False
16+ manual: True
17+
18+common warnings
19+ ghc-options: -Wall
20+
21+library
22+ import: warnings
23+ exposed-modules: Data.Money
24+ Data.Money.Currencies
25+ other-modules: Data.Money.Internal
26+ build-depends: base >=4.14 && < 5.0,
27+ groups >= 0.5
28+ if flag(aeson)
29+ other-modules: Data.Money.JSON
30+ build-depends: aeson >= 2.0 && < 3.0
31+ hs-source-dirs: src
32+ default-language: Haskell2010
hie.yamlnew file+2
@@ -0,0 +1,2 @@
1+cradle:
2+ stack:
src/Data/Money.hsnew file+8
@@ -0,0 +1,8 @@
1+{-# LANGUAGE CPP #-}
2+module Data.Money (module Export) where
3+
4+import Data.Money.Internal as Export
5+
6+#ifdef flag_AESON
7+import Data.Money.JSON as Export ()
8+#endif
src/Data/Money/Currencies.hsnew file+13
@@ -0,0 +1,13 @@
1+{-# LANGUAGE DataKinds #-}
2+module Data.Money.Currencies where
3+
4+import Data.Money.Internal
5+
6+type USD = Currency "USD"
7+type EUR = Currency "EUR"
8+type JPY = Currency "JPY"
9+type CAD = Currency "CAD"
10+type GBP = Currency "GBP" -- Good Boy Points lmao xDDDDD
11+type RUB = Currency "RUB"
12+type CNY = Currency "CNY"
13+type XBT = Currency "XBT"
src/Data/Money/Internal.hsnew file+51
@@ -0,0 +1,51 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE KindSignatures #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
6+{-# LANGUAGE TypeApplications #-}
7+module Data.Money.Internal ( Money(..)
8+ , Currency
9+ , KnownCurrency(..)
10+ ) where
11+
12+import Data.Fixed (Centi)
13+import Data.Group
14+import Data.Proxy
15+import GHC.Generics
16+import GHC.TypeLits
17+
18+newtype Money curr = Money { getAmount :: Centi }
19+ deriving (Eq, Ord, Generic)
20+
21+data Currency (name :: Symbol)
22+
23+class KnownCurrency c where
24+ currencyCode :: String
25+
26+instance KnownSymbol c => KnownCurrency (Currency c) where
27+ currencyCode = symbolVal (Proxy @c)
28+
29+instance Semigroup (Money curr) where
30+ Money a <> Money b = Money (a + b)
31+
32+instance Monoid (Money curr) where
33+ mempty = Money 0
34+
35+instance Group (Money curr) where
36+ invert (Money m) = Money (-m)
37+ Money m ~~ Money m' = Money (m - m')
38+ pow (Money m) n = Money (m * fromIntegral n)
39+
40+instance Abelian (Money curr)
41+
42+instance KnownCurrency c => Show (Money c) where
43+ show (Money x) = currencyCode @c <> " " <> show x
44+
45+instance KnownCurrency c => Read (Money c) where
46+ readsPrec p str
47+ | expCurr == take l str
48+ , [(am, rest)] <- readsPrec p (drop l str) = [(Money am, rest)]
49+ | otherwise = []
50+ where expCurr = currencyCode @c <> " "
51+ l = length expCurr
src/Data/Money/JSON.hsnew file+25
@@ -0,0 +1,25 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+{-# LANGUAGE TypeApplications #-}
4+{-# OPTIONS_GHC -Wno-orphans #-}
5+module Data.Money.JSON () where
6+
7+import Control.Monad (when)
8+import Data.Aeson
9+import Data.Money.Internal
10+import Data.Aeson.Types (typeMismatch)
11+
12+instance KnownCurrency c => FromJSON (Money c) where
13+ parseJSON (Object v) = do
14+ curr <- v .: "currency"
15+ let expectedCurr = currencyCode @c
16+ when (curr /= expectedCurr) $
17+ fail ("Currency code doesn't match: expected " <> expectedCurr <> ", received " <> curr)
18+ amount <- v .: "amount"
19+ pure (Money amount)
20+ parseJSON v = typeMismatch ("Money " <> currencyCode @c) v
21+
22+instance KnownCurrency c => ToJSON (Money c) where
23+ toJSON (Money amount) = object [ "currency" .= currencyCode @c
24+ , "amount" .= amount
25+ ]
stack.yamlnew file+8
@@ -0,0 +1,8 @@
1+resolver: lts-20.2
2+
3+packages:
4+- .
5+
6+flags:
7+ bucks:
8+ aeson: true