aboutsummaryrefslogtreecommitdiff
path: root/lib/PersistOrphans.hs
blob: 1f521ccbeef9a41131185a815debd80fc7a16641 (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
32
33
34
35
36
-- | Instances for the Data.UUID UUID type to be mapped to postgresql's
-- custom builtin uuid type.
--
-- Unfortunately, this breaks compatability with other SQL databases
-- (though uuids aren't really supported by most anyways)
module PersistOrphans () where


import           Data.Either.Combinators (maybeToRight)
import qualified Data.Text               as T
import           Data.UUID               (UUID)
import           Data.UUID               as UUID
import           Data.UUID.V4
import           Database.Persist        (PersistField (..),
                                          PersistValue (PersistLiteralEscaped),
                                          SqlType (SqlOther))
import           Database.Persist.Sql    (PersistFieldSql (..), SqlBackend,
                                          migrate, runMigration)
import           Web.PathPieces          (PathPiece (..))


instance PersistField UUID where
  toPersistValue = PersistLiteralEscaped . UUID.toASCIIBytes
  fromPersistValue (PersistLiteralEscaped buf) =
    maybeToRight "not a uuid (cannot decode)" $ UUID.fromASCIIBytes buf
  fromPersistValue v = Left $ "not a uuid (wrong type in database): " <> T.pack (show v)
  -- postgres is type-safe, so this should /hopefully/ never happen

instance PersistFieldSql UUID where
  sqlType = const $ SqlOther "uuid"

instance PathPiece UUID where
  fromPathPiece = UUID.fromText
  toPathPiece = UUID.toText