diff options
Diffstat (limited to 'overlays/spm/server/Data/CaseInsensitive/Instances.hs')
-rw-r--r-- | overlays/spm/server/Data/CaseInsensitive/Instances.hs | 30 |
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 | |||
4 | module Data.CaseInsensitive.Instances () where | ||
5 | |||
6 | import Prelude | ||
7 | import Database.Persist | ||
8 | import Database.Persist.Sql | ||
9 | |||
10 | import Data.CaseInsensitive (CI) | ||
11 | import qualified Data.CaseInsensitive as CI | ||
12 | |||
13 | import Data.Text (Text) | ||
14 | import qualified Data.Text as Text | ||
15 | import qualified Data.Text.Encoding as Text | ||
16 | |||
17 | import Control.Exception | ||
18 | |||
19 | |||
20 | instance 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 | |||
29 | instance PersistFieldSql (CI Text) where | ||
30 | sqlType _ = SqlOther "citext" | ||