wip

Author: functora

pub/functora/functora.cabal

@@ -197,7 +197,6 @@ common pkg-rates
     , containers
     , modern-uri
     , money
-    , tags
     , web
 
 common pkg-tags

pub/functora/src/money/Functora/Money.hs

@@ -5,11 +5,11 @@ module Functora.Money
     MoneyRep,
     MoneyTags,
     NewMoneyTags,
-    Money (..),
+    Money,
     unMoney,
     parseMoney,
     SomeMoney (..),
-    newSignedMoney,
+    newMoney,
     newUnsignedMoneyBOS,
     newUnsignedMoneyGOL,
     newFeeRate,
@@ -36,7 +36,7 @@ import qualified Data.Text as T
 import Functora.MoneyFgpt as X ()
 import Functora.MoneySing as X
 import Functora.Prelude
-import Functora.Tags
+import Functora.Tags as X
 import qualified Language.Haskell.TH.Syntax as TH
 
 type family MoneyRep sig where
@@ -120,13 +120,13 @@ instance (TestEquality (Sing :: k -> Type)) => Eq (SomeMoney k tags) where
 
 deriving stock instance Show (SomeMoney k tags)
 
-newSignedMoney ::
-  forall prev next.
-  ( NewMoneyTags 'Signed next (prev |+| 'Signed)
+newMoney ::
+  forall sig tags.
+  ( MoneyTags sig tags
   ) =>
-  Rational ->
-  Money next
-newSignedMoney = Money
+  Ratio (MoneyRep sig) ->
+  Money tags
+newMoney = Money
 
 newUnsignedMoneyBOS ::
   forall tags buy sell.

pub/functora/src/rates/Functora/Rates.hs

@@ -40,7 +40,6 @@ import qualified Data.Aeson.Combinators.Decode as A
 import qualified Data.Map as Map
 import Functora.Money
 import Functora.Prelude
-import Functora.Tags
 import Functora.Web
 import qualified Text.URI as URI
 import qualified Text.URI.Lens as URILens

pub/functora/src/sql/Functora/SqlOrphan.hs

@@ -9,7 +9,6 @@ import qualified Data.UUID as UUID
 import Database.Esqueleto.Legacy hiding (from)
 import Functora.Money
 import Functora.Prelude hiding (Key)
-import Functora.Tags
 import qualified Text.URI as URI
 
 deriving stock instance Data PersistValue
@@ -79,18 +78,20 @@ deriving via
     (MoneyTags sig tags) => PersistFieldSql (Money tags)
 
 instance (MoneyTags sig tags) => PersistField (Money tags) where
-  toPersistValue (Money rep) =
-    case sing :: Sing sig of
-      SSigned -> PersistRational rep
-      SUnsigned -> PersistRational $ from @(Ratio Natural) @Rational rep
+  toPersistValue money =
+    let rep = unMoney money
+     in case sing :: Sing sig of
+          SSigned -> PersistRational rep
+          SUnsigned -> PersistRational $ from @(Ratio Natural) @Rational rep
   fromPersistValue raw =
     case raw of
       PersistRational x ->
         case sing :: Sing sig of
           SSigned ->
-            pure $ Money x
+            pure $ newMoney @sig @tags x
           SUnsigned ->
-            bimap (const failure) Money $ tryFrom @Rational @(Ratio Natural) x
+            bimap (const failure) (newMoney @sig @tags) $
+              tryFrom @Rational @(Ratio Natural) x
       _ ->
         Left failure
     where

pub/functora/test/Functora/RatesSpec.hs

@@ -58,5 +58,11 @@ spec = do
   it "getQuote" . withNewMarket $ do
     let quoteCurrency = CurrencyCode "usd"
     res <-
-      tryMarket $ getQuote (Funds (Money 1) $ CurrencyCode "btc") quoteCurrency
+      tryMarket
+        $ getQuote
+          ( Funds
+              (newMoney @'Signed 1)
+              (CurrencyCode "btc")
+          )
+          quoteCurrency
     lift $ res `shouldSatisfy` isRight