diff options
Diffstat (limited to 'overlays/spm/server/Data/UUID/Instances.hs')
-rw-r--r-- | overlays/spm/server/Data/UUID/Instances.hs | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/overlays/spm/server/Data/UUID/Instances.hs b/overlays/spm/server/Data/UUID/Instances.hs new file mode 100644 index 00000000..b2268c96 --- /dev/null +++ b/overlays/spm/server/Data/UUID/Instances.hs | |||
@@ -0,0 +1,31 @@ | |||
1 | {-# OPTIONS_GHC -fno-warn-orphans #-} | ||
2 | {-# LANGUAGE OverloadedStrings #-} | ||
3 | |||
4 | module Data.UUID.Instances () where | ||
5 | |||
6 | import Prelude | ||
7 | import Database.Persist | ||
8 | import Database.Persist.Sql | ||
9 | import Data.UUID (UUID) | ||
10 | import qualified Data.UUID as UUID | ||
11 | |||
12 | import qualified Data.ByteString.Char8 as CBS | ||
13 | import qualified Data.Text as Text | ||
14 | |||
15 | import Web.PathPieces | ||
16 | |||
17 | |||
18 | instance PersistField UUID where | ||
19 | toPersistValue = PersistLiteralEscaped . CBS.pack . UUID.toString | ||
20 | fromPersistValue (PersistLiteralEscaped uuidB8) = | ||
21 | case UUID.fromString $ CBS.unpack uuidB8 of | ||
22 | Just uuid -> Right uuid | ||
23 | Nothing -> Left "Invalid UUID" | ||
24 | fromPersistValue v = Left $ "Expected PersistLiteral but got ‘" <> Text.pack (show v) <> "’" | ||
25 | |||
26 | instance PersistFieldSql UUID where | ||
27 | sqlType _ = SqlOther "uuid" | ||
28 | |||
29 | instance PathPiece UUID where | ||
30 | toPathPiece = Text.pack . UUID.toString | ||
31 | fromPathPiece = UUID.fromString . Text.unpack | ||