wip

Author: functora

prv

@@ -13,6 +13,7 @@ module Functora.Cfg
 
     -- * TOML
     -- $toml
+    unToml,
     decodeToml,
     encodeToml,
 
@@ -131,6 +132,22 @@ encodeJson =
 -- $toml
 -- TOML
 
+unToml ::
+  ( Generic a,
+    Typeable a,
+    Toml.GenericCodec (Rep a),
+    MonadThrow m
+  ) =>
+  Text ->
+  m a
+unToml =
+  either
+    ( throwString
+        . prettyTomlDecodeErrors
+    )
+    pure
+    . decodeToml
+
 decodeToml ::
   ( Generic a,
     Typeable a,

pub/functora/src/cfg/Functora/Cfg.hs

@@ -3,6 +3,7 @@ module Functora.Sql
     upsertBy,
     selectOneRequired,
     runMigrationPool,
+    PersistNat (..),
     (^:),
   )
 where
@@ -117,24 +118,37 @@ import Database.Persist.TH as X
     sqlSettings,
   )
 import Functora.Prelude
-  ( HasCallStack,
+  ( Data,
+    Eq,
+    Generic,
+    HasCallStack,
+    Int64,
     Maybe (..),
     MonadIO,
     MonadThrow,
     MonadUnliftIO,
+    Natural,
     NonEmpty,
+    Ord,
+    Read,
     ReaderT,
+    Show,
     Text,
     Type,
     Typeable,
+    bimap,
+    either,
     flip,
+    impureThrow,
+    inspect,
     inspectType,
     liftIO,
     maybeM,
     pure,
     runReaderT,
     throwString,
     toList,
+    tryFrom,
     ($),
     (.),
     (<>),
@@ -213,6 +227,29 @@ runMigrationPool r pconn =
           runReaderT `flip` conn $ act
     whenSqlite _ _ = pure ()
 
+newtype PersistNat = PersistNat
+  { unPersistNat :: Natural
+  }
+  deriving stock
+    ( Eq,
+      Ord,
+      Show,
+      Read,
+      Data,
+      Generic
+    )
+
+instance PersistField PersistNat where
+  toPersistValue =
+    either impureThrow toPersistValue
+      . tryFrom @Natural @Int64
+      . unPersistNat
+  fromPersistValue raw = do
+    int <- fromPersistValue raw
+    bimap inspect PersistNat $ tryFrom @Int64 @Natural int
+
+deriving via Int64 instance PersistFieldSql PersistNat
+
 -- | Project a field of an entity.
 -- Alias exists to remove interference with Lens.
 (^:) ::

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -7,6 +8,7 @@ import qualified Data.Data as Data
 import Data.UUID (UUID)
 import qualified Data.UUID as UUID
 import Database.Esqueleto.Legacy hiding (from)
+import Database.Persist.TH
 import Functora.Money
 import Functora.Prelude hiding (Key)
 import qualified Text.URI as URI
@@ -86,3 +88,17 @@ instance (PersistField rep) => PersistField (NonEmpty rep) where
 
 instance (PersistFieldSql rep) => PersistFieldSql (NonEmpty rep) where
   sqlType = const . sqlType $ Proxy @[rep]
+
+derivePersistField "BuyOrSell"
+
+deriving newtype instance PersistField MoneyAmount
+
+deriving newtype instance PersistFieldSql MoneyAmount
+
+deriving newtype instance PersistField QuotePerBase
+
+deriving newtype instance PersistFieldSql QuotePerBase
+
+deriving newtype instance PersistField CurrencyCode
+
+deriving newtype instance PersistFieldSql CurrencyCode