wip

Author: functora

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

@@ -20,7 +20,7 @@ module Functora.Money
     fundsMoneyAmount,
     fundsCurrencyCode,
     unJsonRational,
-    unJsonSignedMoney,
+    unJsonMoney,
     unJsonUnsignedMoneyBOS,
     unJsonUnsignedMoneyGOL,
     CurrencyCode (..),
@@ -121,7 +121,7 @@ instance (TestEquality (Sing :: k -> Type)) => Eq (SomeMoney k tags) where
 deriving stock instance Show (SomeMoney k tags)
 
 newMoney ::
-  forall sig tags.
+  forall tags sig.
   ( MoneyTags sig tags
   ) =>
   Ratio (MoneyRep sig) ->
@@ -232,10 +232,17 @@ deriving stock instance (MoneyTags sig tags) => Read (Funds tags)
 deriving stock instance (MoneyTags sig tags) => Data (Funds tags)
 
 unJsonRational :: A.Decoder Rational
-unJsonRational = toRational <$> A.scientific
-
-unJsonSignedMoney :: (MoneyTags 'Signed tags) => A.Decoder (Money tags)
-unJsonSignedMoney = Money <$> unJsonRational
+unJsonRational =
+  toRational <$> A.scientific
+
+unJsonMoney :: forall tags sig. (MoneyTags sig tags) => A.Decoder (Money tags)
+unJsonMoney = do
+  rat <- unJsonRational
+  case sing :: Sing sig of
+    SSigned -> pure $ newMoney rat
+    SUnsigned ->
+      either (fail . inspect) (pure . newMoney)
+        $ tryFrom @Rational @(Ratio Natural) rat
 
 unJsonUnsignedMoneyBOS ::
   forall tags.

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

@@ -246,7 +246,7 @@ tryFetchQuotesPerBase cur uri = tryMarket $ do
     createdAt <- A.at ["date"] A.day
     quotesMap <-
       A.at [fromString . from @Text @String $ unCurrencyCode cur]
-        $ A.mapStrict unJsonSignedMoney
+        $ A.mapStrict unJsonMoney
     pure
       QuotesPerBaseAt
         { quotesPerBaseQuotesMap = Map.mapKeys CurrencyCode quotesMap,

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

@@ -88,9 +88,9 @@ instance (MoneyTags sig tags) => PersistField (Money tags) where
       PersistRational x ->
         case sing :: Sing sig of
           SSigned ->
-            pure $ newMoney @sig @tags x
+            pure $ newMoney x
           SUnsigned ->
-            bimap (const failure) (newMoney @sig @tags) $
+            bimap (const failure) newMoney $
               tryFrom @Rational @(Ratio Natural) x
       _ ->
         Left failure

pub/functora/test/Functora/RatesSpec.hs

@@ -61,7 +61,7 @@ spec = do
       tryMarket
         $ getQuote
           ( Funds
-              (newMoney @'Signed 1)
+              (newMoney 1)
               (CurrencyCode "btc")
           )
           quoteCurrency