summaryrefslogtreecommitdiff
path: root/hosts/surtr/email/spm/server/Data/UUID/Instances.hs
blob: b2268c96003a9cf79dac22d67bdc606474a28c6d (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
31
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.UUID.Instances () where

import Prelude
import Database.Persist
import Database.Persist.Sql
import Data.UUID (UUID)
import qualified Data.UUID as UUID

import qualified Data.ByteString.Char8 as CBS
import qualified Data.Text as Text

import Web.PathPieces
  

instance PersistField UUID where
  toPersistValue = PersistLiteralEscaped . CBS.pack . UUID.toString
  fromPersistValue (PersistLiteralEscaped uuidB8) =
    case UUID.fromString $ CBS.unpack uuidB8 of
      Just uuid -> Right uuid
      Nothing   -> Left "Invalid UUID"
  fromPersistValue v = Left $ "Expected PersistLiteral but got ‘" <> Text.pack (show v) <> "’"

instance PersistFieldSql UUID where
  sqlType _ = SqlOther "uuid"

instance PathPiece UUID where
  toPathPiece = Text.pack . UUID.toString
  fromPathPiece = UUID.fromString . Text.unpack