summaryrefslogtreecommitdiff
path: root/hosts/surtr/email/spm/server/Data/CaseInsensitive/Instances.hs
blob: 1f3f7a117183b9114e7bcaf2b934dfc6b9e8146c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.CaseInsensitive.Instances () where

import Prelude
import Database.Persist
import Database.Persist.Sql

import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI

import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import Control.Exception


instance PersistField (CI Text) where
  toPersistValue = PersistLiteralEscaped . Text.encodeUtf8 . CI.original
  fromPersistValue = \case
    PersistText t -> Right $ CI.mk t
    PersistLiteralEscaped bs -> case Text.decodeUtf8' bs of
      Right t   -> Right $ CI.mk t
      Left  err -> Left $ "Could not decode PersistLiteral as UTF-8: " <> Text.pack (displayException err)
    o -> Left $ "Expected PersistText or PersistLiteral but got ‘" <> Text.pack (show o) <> "’"

instance PersistFieldSql (CI Text) where
  sqlType _ = SqlOther "citext"