-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.UUID.Instances
  () where

import ClassyPrelude.Yesod hiding (Proxy(..))
import Data.UUID (UUID)
import qualified Data.UUID as UUID

import Database.Persist.Sql
import Utils.Persist
import Data.Proxy

import Text.Blaze (ToMarkup(..))

import Servant.Docs (ToSample(..), samples)
import Crypto.Random
  

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

instance PersistField UUID where
  toPersistValue = PersistLiteralEscaped . 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 (PersistLiteralEscaped bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs
  fromPersistValue  x                         = Left $ fromPersistValueErrorSql (Proxy @UUID) 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

sampleNotRandom :: MonadPseudoRandom ChaChaDRG a -> a
sampleNotRandom = fst . withDRG (drgNewSeed $ seedFromInteger 0)

instance ToSample UUID where
  toSamples _ = samples $ sampleNotRandom getRandoms
    where getRandoms = fmap (maybe id (:) . UUID.fromByteString . fromStrict) (getRandomBytes 16) <*> getRandoms