fix some persist instances

Author: functora

prv

@@ -202,7 +202,15 @@ import Data.Generics.Product as X
 import Data.Generics.Sum as X
 import Data.Generics.Uniplate.Data as X ()
 import qualified Data.HMAC as HMAC
-import Data.List.Extra as X (enumerate, notNull, nubOrd, nubOrdBy, nubOrdOn)
+import Data.List.Extra as X
+  ( enumerate,
+    escapeHTML,
+    notNull,
+    nubOrd,
+    nubOrdBy,
+    nubOrdOn,
+    unescapeHTML,
+  )
 import qualified Data.Map.Merge.Strict as Map
 import Data.Maybe as X (listToMaybe)
 import Data.MonoTraversable as X (omap)

pub/functora/src/prelude/Functora/Prelude.hs

@@ -8,9 +8,13 @@ module Functora.Sql
 where
 
 import Control.Monad.Logger as X
-  ( defaultOutput,
+  ( LoggingT (..),
+    MonadLoggerIO,
+    NoLoggingT (..),
+    defaultOutput,
     runLoggingT,
     runNoLoggingT,
+    runStdoutLoggingT,
   )
 import Data.Pool as X (Pool, destroyAllResources)
 import qualified Database.Esqueleto.Internal.Internal as Internal
@@ -37,13 +41,15 @@ import Database.Esqueleto.Legacy as X
     Unique,
     Value,
     asc,
+    delete,
     deleteKey,
     desc,
     distinct,
     distinctOn,
     don,
     from,
     getBy,
+    groupBy,
     in_,
     insertBy,
     insertUniqueEntity,

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

@@ -19,14 +19,12 @@ deriving stock instance (Data a, Data (Key a)) => Data (Entity a)
 
 instance PersistField (Ratio Natural) where
   toPersistValue = PersistRational . from @(Ratio Natural) @Rational
-  fromPersistValue = \case
-    PersistRational x ->
-      first (const $ failure x) $ tryFrom @Rational @(Ratio Natural) x
-    x ->
-      Left $ failure x
+  fromPersistValue raw = do
+    rat <- fromPersistValue raw
+    first (const failure) $ tryFrom @Rational @(Ratio Natural) rat
     where
-      failure x =
-        "Ratio Natural PersistValue is invalid " <> inspect @Text x
+      failure =
+        "Ratio Natural PersistValue is invalid " <> inspect @Text raw
 
 deriving via Rational instance PersistFieldSql (Ratio Natural)
 
@@ -78,3 +76,13 @@ instance (PersistField rep) => PersistField (Tagged tags rep) where
 
 instance (PersistFieldSql rep) => PersistFieldSql (Tagged tags rep) where
   sqlType = const . sqlType $ Proxy @rep
+
+instance (PersistField rep) => PersistField (NonEmpty rep) where
+  toPersistValue =
+    toPersistValue . toList
+  fromPersistValue raw = do
+    lst <- fromPersistValue raw
+    maybe (Left "Unexpected empty persist value") Right $ nonEmpty lst
+
+instance (PersistFieldSql rep) => PersistFieldSql (NonEmpty rep) where
+  sqlType = const . sqlType $ Proxy @[rep]