{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}

module Hyperion.ObjectId where

import           Control.Monad.Catch    (MonadCatch)
import           Control.Monad.IO.Class (MonadIO)
import           Control.Monad.Reader   (MonadReader)
import           Data.Aeson             (FromJSON, ToJSON)
import           Data.Binary            (Binary)
import           Data.BinaryHash        (hashBase64Safe)
import qualified Data.Text              as Text
import           Data.Typeable          (Typeable)
import           GHC.Generics           (Generic)
import qualified Hyperion.Database      as DB

-- | An identifier for an object, useful for building filenames and
-- database entries.
newtype ObjectId = ObjectId String
  deriving (ObjectId -> ObjectId -> Bool
(ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool) -> Eq ObjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectId -> ObjectId -> Bool
$c/= :: ObjectId -> ObjectId -> Bool
== :: ObjectId -> ObjectId -> Bool
$c== :: ObjectId -> ObjectId -> Bool
Eq, Eq ObjectId
Eq ObjectId
-> (ObjectId -> ObjectId -> Ordering)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> ObjectId)
-> (ObjectId -> ObjectId -> ObjectId)
-> Ord ObjectId
ObjectId -> ObjectId -> Bool
ObjectId -> ObjectId -> Ordering
ObjectId -> ObjectId -> ObjectId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ObjectId -> ObjectId -> ObjectId
$cmin :: ObjectId -> ObjectId -> ObjectId
max :: ObjectId -> ObjectId -> ObjectId
$cmax :: ObjectId -> ObjectId -> ObjectId
>= :: ObjectId -> ObjectId -> Bool
$c>= :: ObjectId -> ObjectId -> Bool
> :: ObjectId -> ObjectId -> Bool
$c> :: ObjectId -> ObjectId -> Bool
<= :: ObjectId -> ObjectId -> Bool
$c<= :: ObjectId -> ObjectId -> Bool
< :: ObjectId -> ObjectId -> Bool
$c< :: ObjectId -> ObjectId -> Bool
compare :: ObjectId -> ObjectId -> Ordering
$ccompare :: ObjectId -> ObjectId -> Ordering
$cp1Ord :: Eq ObjectId
Ord, (forall x. ObjectId -> Rep ObjectId x)
-> (forall x. Rep ObjectId x -> ObjectId) -> Generic ObjectId
forall x. Rep ObjectId x -> ObjectId
forall x. ObjectId -> Rep ObjectId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ObjectId x -> ObjectId
$cfrom :: forall x. ObjectId -> Rep ObjectId x
Generic, Get ObjectId
[ObjectId] -> Put
ObjectId -> Put
(ObjectId -> Put)
-> Get ObjectId -> ([ObjectId] -> Put) -> Binary ObjectId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ObjectId] -> Put
$cputList :: [ObjectId] -> Put
get :: Get ObjectId
$cget :: Get ObjectId
put :: ObjectId -> Put
$cput :: ObjectId -> Put
Binary, Value -> Parser [ObjectId]
Value -> Parser ObjectId
(Value -> Parser ObjectId)
-> (Value -> Parser [ObjectId]) -> FromJSON ObjectId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ObjectId]
$cparseJSONList :: Value -> Parser [ObjectId]
parseJSON :: Value -> Parser ObjectId
$cparseJSON :: Value -> Parser ObjectId
FromJSON, [ObjectId] -> Encoding
[ObjectId] -> Value
ObjectId -> Encoding
ObjectId -> Value
(ObjectId -> Value)
-> (ObjectId -> Encoding)
-> ([ObjectId] -> Value)
-> ([ObjectId] -> Encoding)
-> ToJSON ObjectId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ObjectId] -> Encoding
$ctoEncodingList :: [ObjectId] -> Encoding
toJSONList :: [ObjectId] -> Value
$ctoJSONList :: [ObjectId] -> Value
toEncoding :: ObjectId -> Encoding
$ctoEncoding :: ObjectId -> Encoding
toJSON :: ObjectId -> Value
$ctoJSON :: ObjectId -> Value
ToJSON)

-- | Convert an ObjectId to a String.
objectIdToString :: ObjectId -> String
objectIdToString :: ObjectId -> String
objectIdToString (ObjectId String
i) = String
"Object_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i

-- | Convert an ObjectId to Text.
objectIdToText :: ObjectId -> Text.Text
objectIdToText :: ObjectId -> Text
objectIdToText = String -> Text
Text.pack (String -> Text) -> (ObjectId -> String) -> ObjectId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectId -> String
objectIdToString

-- | The ObjectId of an object is the result of 'hashBase64Safe'. The
-- first time 'getObjectId' is called, it comptues the ObjectId and
-- stores it in the database before returning it. Subsequent calls
-- read the value from the database.
getObjectId
  :: ( Binary a
     , Typeable a
     , ToJSON a
     , DB.HasDB env
     , MonadReader env m
     , MonadIO m
     , MonadCatch m
     )
  => a -> m ObjectId
getObjectId :: a -> m ObjectId
getObjectId = KeyValMap a ObjectId -> (a -> m ObjectId) -> a -> m ObjectId
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasDB env, MonadCatch m, ToJSON a,
 ToJSON b, Typeable b, FromJSON b) =>
KeyValMap a b -> (a -> m b) -> a -> m b
DB.memoizeWithMap
  (Text -> KeyValMap a ObjectId
forall a b. Text -> KeyValMap a b
DB.KeyValMap Text
"objectIds")
  (ObjectId -> m ObjectId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ObjectId -> m ObjectId) -> (a -> ObjectId) -> a -> m ObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ObjectId
ObjectId (String -> ObjectId) -> (a -> String) -> a -> ObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. (Binary a, Typeable a) => a -> String
hashBase64Safe)