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

-- | This module contains orphan 'UUID' instances and a few convenience
-- functions around UUIDs. It would be great if this were its own entirely
-- separate package.
module Eventium.UUID
  ( UUID,
    uuidFromText,
    uuidToText,
    nil,
    uuidNextRandom,
    uuidFromInteger,
  )
where

import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import Data.UUID
import qualified Data.UUID.V4 as UUID4
import Text.Printf (printf)
import Web.PathPieces

#if MIN_VERSION_aeson(1,1,0)

#else
import Data.Aeson (ToJSON (..), FromJSON (..))

instance ToJSON UUID where
  toJSON uuid = toJSON (toText uuid)

instance FromJSON UUID where
  parseJSON text = do
    uuid <- parseJSON text
    maybe (fail $ "Error parsing UUID " ++ show uuid) pure (fromText uuid)
#endif

uuidFromText :: Text -> Maybe UUID
uuidFromText :: Text -> Maybe UUID
uuidFromText = Text -> Maybe UUID
fromText

uuidToText :: UUID -> Text
uuidToText :: UUID -> Text
uuidToText = UUID -> Text
toText

uuidNextRandom :: IO UUID
uuidNextRandom :: IO UUID
uuidNextRandom = IO UUID
UUID4.nextRandom

instance PathPiece UUID where
  fromPathPiece :: Text -> Maybe UUID
fromPathPiece = Text -> Maybe UUID
uuidFromText
  toPathPiece :: UUID -> Text
toPathPiece = UUID -> Text
uuidToText

-- | Constructs a valid 'UUID' from an 'Integer' by padding with zeros. Useful
-- for testing.
--
-- >>> uuidFromInteger 1
-- 00000000-0000-0000-0000-000000000001
uuidFromInteger :: Integer -> UUID
uuidFromInteger :: Integer -> UUID
uuidFromInteger Integer
i =
  let rawString :: [Char]
rawString = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
32 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Integer -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%032x" Integer
i
      ([Char]
p1, [Char]
rest1) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
8 [Char]
rawString
      ([Char]
p2, [Char]
rest2) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
4 [Char]
rest1
      ([Char]
p3, [Char]
rest3) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
4 [Char]
rest2
      ([Char]
p4, [Char]
p5) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
4 [Char]
rest3
      withHyphens :: [Char]
withHyphens = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"-" [[Char]
p1, [Char]
p2, [Char]
p3, [Char]
p4, [Char]
p5]
      mUuid :: Maybe UUID
mUuid = Text -> Maybe UUID
uuidFromText (Text -> Maybe UUID) -> ([Char] -> Text) -> [Char] -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> Maybe UUID) -> [Char] -> Maybe UUID
forall a b. (a -> b) -> a -> b
$ [Char]
withHyphens
   in UUID -> Maybe UUID -> UUID
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> UUID
forall a. HasCallStack => [Char] -> a
error ([Char] -> UUID) -> [Char] -> UUID
forall a b. (a -> b) -> a -> b
$ [Char]
"Failure in uuidFrominteger for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i) Maybe UUID
mUuid