mirror of
https://github.com/typeable/bucks.git
synced 2024-08-17 02:50:36 +03:00
I make up things as I go along.
This commit is contained in:
commit
85f13d3dea
20
LICENSE
Normal file
20
LICENSE
Normal file
@ -0,0 +1,20 @@
|
||||
Copyright (c) 2022 Nick
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining
|
||||
a copy of this software and associated documentation files (the
|
||||
"Software"), to deal in the Software without restriction, including
|
||||
without limitation the rights to use, copy, modify, merge, publish,
|
||||
distribute, sublicense, and/or sell copies of the Software, and to
|
||||
permit persons to whom the Software is furnished to do so, subject to
|
||||
the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included
|
||||
in all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
|
||||
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
|
||||
CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
|
||||
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
|
||||
SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
32
bucks.cabal
Normal file
32
bucks.cabal
Normal file
@ -0,0 +1,32 @@
|
||||
cabal-version: 3.0
|
||||
name: bucks
|
||||
version: 0.1
|
||||
synopsis: Money handling library
|
||||
-- description:
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Nick
|
||||
maintainer: nick@typeable.io
|
||||
category: Data
|
||||
build-type: Simple
|
||||
|
||||
flag aeson
|
||||
description: Enable Aeson instances
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
common warnings
|
||||
ghc-options: -Wall
|
||||
|
||||
library
|
||||
import: warnings
|
||||
exposed-modules: Data.Money
|
||||
Data.Money.Currencies
|
||||
other-modules: Data.Money.Internal
|
||||
build-depends: base >=4.14 && < 5.0,
|
||||
groups >= 0.5
|
||||
if flag(aeson)
|
||||
other-modules: Data.Money.JSON
|
||||
build-depends: aeson >= 2.0 && < 3.0
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
8
src/Data/Money.hs
Normal file
8
src/Data/Money.hs
Normal file
@ -0,0 +1,8 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Data.Money (module Export) where
|
||||
|
||||
import Data.Money.Internal as Export
|
||||
|
||||
#ifdef flag_AESON
|
||||
import Data.Money.JSON as Export ()
|
||||
#endif
|
13
src/Data/Money/Currencies.hs
Normal file
13
src/Data/Money/Currencies.hs
Normal file
@ -0,0 +1,13 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
module Data.Money.Currencies where
|
||||
|
||||
import Data.Money.Internal
|
||||
|
||||
type USD = Currency "USD"
|
||||
type EUR = Currency "EUR"
|
||||
type JPY = Currency "JPY"
|
||||
type CAD = Currency "CAD"
|
||||
type GBP = Currency "GBP" -- Good Boy Points lmao xDDDDD
|
||||
type RUB = Currency "RUB"
|
||||
type CNY = Currency "CNY"
|
||||
type XBT = Currency "XBT"
|
51
src/Data/Money/Internal.hs
Normal file
51
src/Data/Money/Internal.hs
Normal file
@ -0,0 +1,51 @@
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
module Data.Money.Internal ( Money(..)
|
||||
, Currency
|
||||
, KnownCurrency(..)
|
||||
) where
|
||||
|
||||
import Data.Fixed (Centi)
|
||||
import Data.Group
|
||||
import Data.Proxy
|
||||
import GHC.Generics
|
||||
import GHC.TypeLits
|
||||
|
||||
newtype Money curr = Money { getAmount :: Centi }
|
||||
deriving (Eq, Ord, Generic)
|
||||
|
||||
data Currency (name :: Symbol)
|
||||
|
||||
class KnownCurrency c where
|
||||
currencyCode :: String
|
||||
|
||||
instance KnownSymbol c => KnownCurrency (Currency c) where
|
||||
currencyCode = symbolVal (Proxy @c)
|
||||
|
||||
instance Semigroup (Money curr) where
|
||||
Money a <> Money b = Money (a + b)
|
||||
|
||||
instance Monoid (Money curr) where
|
||||
mempty = Money 0
|
||||
|
||||
instance Group (Money curr) where
|
||||
invert (Money m) = Money (-m)
|
||||
Money m ~~ Money m' = Money (m - m')
|
||||
pow (Money m) n = Money (m * fromIntegral n)
|
||||
|
||||
instance Abelian (Money curr)
|
||||
|
||||
instance KnownCurrency c => Show (Money c) where
|
||||
show (Money x) = currencyCode @c <> " " <> show x
|
||||
|
||||
instance KnownCurrency c => Read (Money c) where
|
||||
readsPrec p str
|
||||
| expCurr == take l str
|
||||
, [(am, rest)] <- readsPrec p (drop l str) = [(Money am, rest)]
|
||||
| otherwise = []
|
||||
where expCurr = currencyCode @c <> " "
|
||||
l = length expCurr
|
25
src/Data/Money/JSON.hs
Normal file
25
src/Data/Money/JSON.hs
Normal file
@ -0,0 +1,25 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
module Data.Money.JSON () where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Data.Aeson
|
||||
import Data.Money.Internal
|
||||
import Data.Aeson.Types (typeMismatch)
|
||||
|
||||
instance KnownCurrency c => FromJSON (Money c) where
|
||||
parseJSON (Object v) = do
|
||||
curr <- v .: "currency"
|
||||
let expectedCurr = currencyCode @c
|
||||
when (curr /= expectedCurr) $
|
||||
fail ("Currency code doesn't match: expected " <> expectedCurr <> ", received " <> curr)
|
||||
amount <- v .: "amount"
|
||||
pure (Money amount)
|
||||
parseJSON v = typeMismatch ("Money " <> currencyCode @c) v
|
||||
|
||||
instance KnownCurrency c => ToJSON (Money c) where
|
||||
toJSON (Money amount) = object [ "currency" .= currencyCode @c
|
||||
, "amount" .= amount
|
||||
]
|
8
stack.yaml
Normal file
8
stack.yaml
Normal file
@ -0,0 +1,8 @@
|
||||
resolver: lts-20.2
|
||||
|
||||
packages:
|
||||
- .
|
||||
|
||||
flags:
|
||||
bucks:
|
||||
aeson: true
|
Loading…
Reference in New Issue
Block a user