39 lines
1.1 KiB
Haskell
39 lines
1.1 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Data.UUID.Instances
|
|
() where
|
|
|
|
import ClassyPrelude.Yesod
|
|
import Data.UUID (UUID)
|
|
import qualified Data.UUID as UUID
|
|
|
|
import Database.Persist.Sql
|
|
|
|
import Text.Blaze (ToMarkup(..))
|
|
|
|
|
|
instance PathPiece UUID where
|
|
fromPathPiece = UUID.fromString . unpack
|
|
toPathPiece = pack . UUID.toString
|
|
|
|
instance PersistField UUID where
|
|
toPersistValue = PersistDbSpecific . UUID.toASCIIBytes
|
|
|
|
fromPersistValue (PersistText t) = maybe (Left "Failed to parse UUID") Right $ UUID.fromText t
|
|
fromPersistValue (PersistByteString bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs
|
|
fromPersistValue (PersistDbSpecific bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs
|
|
fromPersistValue x = Left $ "Expected UUID, received: " <> tshow x
|
|
|
|
instance PersistFieldSql UUID where
|
|
sqlType _ = SqlOther "uuid"
|
|
|
|
instance ToMarkup UUID where
|
|
toMarkup uuid = [shamlet|
|
|
$newline never
|
|
<span .uuid>
|
|
#{UUID.toText uuid}
|
|
|]
|
|
|
|
instance ToWidget site UUID where
|
|
toWidget = toWidget . toMarkup
|