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