diff options
Diffstat (limited to 'overlays/spm/server/Data/CaseInsensitive')
| -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" | ||
