I make up things as I go along.

LICENSE

@@ -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.

bucks.cabal

@@ -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

hie.yaml

@@ -0,0 +1,2 @@
+cradle:
+  stack:

src/Data/Money.hs

@@ -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

src/Data/Money/Currencies.hs

@@ -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"

src/Data/Money/Internal.hs

@@ -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

src/Data/Money/JSON.hs

@@ -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
+                                 ]

stack.yaml

@@ -0,0 +1,8 @@
+resolver: lts-20.2
+
+packages:
+- .
+
+flags:
+  bucks:
+    aeson: true