summaryrefslogtreecommitdiff
path: root/overlays/spm/server/Data/CaseInsensitive/Instances.hs
diff options
context:
space:
mode:
Diffstat (limited to 'overlays/spm/server/Data/CaseInsensitive/Instances.hs')
-rw-r--r--overlays/spm/server/Data/CaseInsensitive/Instances.hs30
1 files changed, 30 insertions, 0 deletions
diff --git a/overlays/spm/server/Data/CaseInsensitive/Instances.hs b/overlays/spm/server/Data/CaseInsensitive/Instances.hs
new file mode 100644
index 00000000..1f3f7a11
--- /dev/null
+++ b/overlays/spm/server/Data/CaseInsensitive/Instances.hs
@@ -0,0 +1,30 @@
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4module Data.CaseInsensitive.Instances () where
5
6import Prelude
7import Database.Persist
8import Database.Persist.Sql
9
10import Data.CaseInsensitive (CI)
11import qualified Data.CaseInsensitive as CI
12
13import Data.Text (Text)
14import qualified Data.Text as Text
15import qualified Data.Text.Encoding as Text
16
17import Control.Exception
18
19
20instance PersistField (CI Text) where
21 toPersistValue = PersistLiteralEscaped . Text.encodeUtf8 . CI.original
22 fromPersistValue = \case
23 PersistText t -> Right $ CI.mk t
24 PersistLiteralEscaped bs -> case Text.decodeUtf8' bs of
25 Right t -> Right $ CI.mk t
26 Left err -> Left $ "Could not decode PersistLiteral as UTF-8: " <> Text.pack (displayException err)
27 o -> Left $ "Expected PersistText or PersistLiteral but got ‘" <> Text.pack (show o) <> "’"
28
29instance PersistFieldSql (CI Text) where
30 sqlType _ = SqlOther "citext"