module Patrol.Type.EventId where import qualified Control.Monad as Monad import qualified Control.Monad.Catch as Catch import qualified Control.Monad.IO.Class as IO import qualified Data.Aeson as Aeson import qualified Data.Text as Text import qualified Data.Text.Read as Text import qualified Data.Typeable as Typeable import qualified Data.UUID as Uuid import qualified Data.UUID.V4 as Uuid import qualified Patrol.Exception.Problem as Problem import qualified Text.Printf as Printf newtype EventId = EventId Uuid.UUID deriving (EventId -> EventId -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: EventId -> EventId -> Bool $c/= :: EventId -> EventId -> Bool == :: EventId -> EventId -> Bool $c== :: EventId -> EventId -> Bool Eq, Int -> EventId -> ShowS [EventId] -> ShowS EventId -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [EventId] -> ShowS $cshowList :: [EventId] -> ShowS show :: EventId -> String $cshow :: EventId -> String showsPrec :: Int -> EventId -> ShowS $cshowsPrec :: Int -> EventId -> ShowS Show) instance Aeson.FromJSON EventId where parseJSON :: Value -> Parser EventId parseJSON = let name :: String name = forall a. Show a => a -> String show forall a b. (a -> b) -> a -> b $ forall {k} (proxy :: k -> *) (a :: k). Typeable a => proxy a -> TypeRep Typeable.typeRep (forall {k} (t :: k). Proxy t Typeable.Proxy :: Typeable.Proxy EventId) in forall a. String -> (Text -> Parser a) -> Value -> Parser a Aeson.withText String name forall a b. (a -> b) -> a -> b $ forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall (m :: * -> *) a. MonadFail m => String -> m a fail forall a b. (a -> b) -> a -> b $ String "invalid " forall a. Semigroup a => a -> a -> a <> String name) forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). MonadThrow m => Text -> m EventId fromText instance Aeson.ToJSON EventId where toJSON :: EventId -> Value toJSON = forall a. ToJSON a => a -> Value Aeson.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c . EventId -> Text intoText empty :: EventId empty :: EventId empty = UUID -> EventId fromUuid UUID Uuid.nil fromUuid :: Uuid.UUID -> EventId fromUuid :: UUID -> EventId fromUuid = UUID -> EventId EventId intoUuid :: EventId -> Uuid.UUID intoUuid :: EventId -> UUID intoUuid (EventId UUID uuid) = UUID uuid random :: IO.MonadIO io => io EventId random :: forall (io :: * -> *). MonadIO io => io EventId random = forall (m :: * -> *) a. MonadIO m => IO a -> m a IO.liftIO forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap UUID -> EventId fromUuid IO UUID Uuid.nextRandom intoText :: EventId -> Text.Text intoText :: EventId -> Text intoText EventId eventId = let (Word64 lo, Word64 hi) = UUID -> (Word64, Word64) Uuid.toWords64 forall a b. (a -> b) -> a -> b $ EventId -> UUID intoUuid EventId eventId in String -> Text Text.pack forall a b. (a -> b) -> a -> b $ forall r. PrintfType r => String -> r Printf.printf String "%016x%016x" Word64 lo Word64 hi fromText :: Catch.MonadThrow m => Text.Text -> m EventId fromText :: forall (m :: * -> *). MonadThrow m => Text -> m EventId fromText Text t1 = do let parse :: (Catch.MonadThrow n, Integral a) => Int -> Text.Text -> n (a, Text.Text) parse :: forall (n :: * -> *) a. (MonadThrow n, Integral a) => Int -> Text -> n (a, Text) parse Int size Text text = do let (Text before, Text after) = Int -> Text -> (Text, Text) Text.splitAt Int size Text text case Text -> Int -> Ordering Text.compareLength Text before Int size of Ordering GT -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a Catch.throwM forall a b. (a -> b) -> a -> b $ String -> Problem Problem.Problem String "impossible" Ordering LT -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a Catch.throwM forall a b. (a -> b) -> a -> b $ String -> Problem Problem.Problem String "not enough input" Ordering EQ -> case forall a. Integral a => Reader a Text.hexadecimal Text before of Left String _ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a Catch.throwM forall a b. (a -> b) -> a -> b $ String -> Problem Problem.Problem String "invalid hexadecimal" Right (a integral, Text leftover) -> if Text -> Bool Text.null Text leftover then forall (f :: * -> *) a. Applicative f => a -> f a pure (a integral, Text after) else forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a Catch.throwM forall a b. (a -> b) -> a -> b $ String -> Problem Problem.Problem String "invalid hexadecimal" (Word64 lo, Text t2) <- forall (n :: * -> *) a. (MonadThrow n, Integral a) => Int -> Text -> n (a, Text) parse Int 16 Text t1 (Word64 hi, Text t3) <- forall (n :: * -> *) a. (MonadThrow n, Integral a) => Int -> Text -> n (a, Text) parse Int 16 Text t2 forall (f :: * -> *). Applicative f => Bool -> f () -> f () Monad.unless (Text -> Bool Text.null Text t3) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a Catch.throwM forall a b. (a -> b) -> a -> b $ String -> Problem Problem.Problem String "too much input" forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . UUID -> EventId fromUuid forall a b. (a -> b) -> a -> b $ Word64 -> Word64 -> UUID Uuid.fromWords64 Word64 lo Word64 hi