{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Haspara.Internal.Id where

import qualified Data.Aeson          as Aeson
import qualified Data.HashMap.Strict as HM
import           Data.Hashable       (Hashable)


-- | Type encoding for entity identifiers.
--
-- This encoding allows us to provide a phantom type for distinguishing between
-- identifiers of varying types and an underlying identifier type.
--
-- For example:
--
-- >>> data A = A
-- >>> data B = B
-- >>> data C = C
-- >>> type IdA = Id A Int
-- >>> type IdB = Id B Int
-- >>> type IdC = Id C String
-- >>> let idA = Id 1 :: IdA
-- >>> let idB = Id 1 :: IdB
-- >>> let idC = Id "C1" :: IdC
-- >>> idA
-- 1
-- >>> idB
-- 1
-- >>> idC
-- "C1"
-- >>> idA == idA
-- True
-- >>> -- idA == idB  -- Compile error as: Couldn't match type ‘B’ with ‘A’
--
-- Hashes, on the otherhand, can be compared:
--
-- >>> import Data.Hashable
-- >>> hash idA == hash idB
-- True
newtype Id a b = Id { Id a b -> b
unId :: b }
  deriving(Id a b -> Id a b -> Bool
(Id a b -> Id a b -> Bool)
-> (Id a b -> Id a b -> Bool) -> Eq (Id a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. Eq b => Id a b -> Id a b -> Bool
/= :: Id a b -> Id a b -> Bool
$c/= :: forall a b. Eq b => Id a b -> Id a b -> Bool
== :: Id a b -> Id a b -> Bool
$c== :: forall a b. Eq b => Id a b -> Id a b -> Bool
Eq, Eq (Id a b)
Eq (Id a b)
-> (Id a b -> Id a b -> Ordering)
-> (Id a b -> Id a b -> Bool)
-> (Id a b -> Id a b -> Bool)
-> (Id a b -> Id a b -> Bool)
-> (Id a b -> Id a b -> Bool)
-> (Id a b -> Id a b -> Id a b)
-> (Id a b -> Id a b -> Id a b)
-> Ord (Id a b)
Id a b -> Id a b -> Bool
Id a b -> Id a b -> Ordering
Id a b -> Id a b -> Id a b
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
forall a b. Ord b => Eq (Id a b)
forall a b. Ord b => Id a b -> Id a b -> Bool
forall a b. Ord b => Id a b -> Id a b -> Ordering
forall a b. Ord b => Id a b -> Id a b -> Id a b
min :: Id a b -> Id a b -> Id a b
$cmin :: forall a b. Ord b => Id a b -> Id a b -> Id a b
max :: Id a b -> Id a b -> Id a b
$cmax :: forall a b. Ord b => Id a b -> Id a b -> Id a b
>= :: Id a b -> Id a b -> Bool
$c>= :: forall a b. Ord b => Id a b -> Id a b -> Bool
> :: Id a b -> Id a b -> Bool
$c> :: forall a b. Ord b => Id a b -> Id a b -> Bool
<= :: Id a b -> Id a b -> Bool
$c<= :: forall a b. Ord b => Id a b -> Id a b -> Bool
< :: Id a b -> Id a b -> Bool
$c< :: forall a b. Ord b => Id a b -> Id a b -> Bool
compare :: Id a b -> Id a b -> Ordering
$ccompare :: forall a b. Ord b => Id a b -> Id a b -> Ordering
$cp1Ord :: forall a b. Ord b => Eq (Id a b)
Ord, Int -> Id a b -> Int
Id a b -> Int
(Int -> Id a b -> Int) -> (Id a b -> Int) -> Hashable (Id a b)
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a b. Hashable b => Int -> Id a b -> Int
forall a b. Hashable b => Id a b -> Int
hash :: Id a b -> Int
$chash :: forall a b. Hashable b => Id a b -> Int
hashWithSalt :: Int -> Id a b -> Int
$chashWithSalt :: forall a b. Hashable b => Int -> Id a b -> Int
Hashable)


instance (Show b) => Show (Id a b) where
  show :: Id a b -> String
show (Id b
x) = b -> String
forall a. Show a => a -> String
show b
x


instance (Aeson.FromJSON b) => Aeson.FromJSON (Id a b) where
  parseJSON :: Value -> Parser (Id a b)
parseJSON = (b -> Id a b) -> Parser b -> Parser (Id a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Id a b
forall a b. b -> Id a b
Id (Parser b -> Parser (Id a b))
-> (Value -> Parser b) -> Value -> Parser (Id a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser b
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON


instance (Aeson.ToJSON b) => Aeson.ToJSON (Id a b) where
  toJSON :: Id a b -> Value
toJSON (Id b
x) = b -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON b
x


-- | Type encoding for a lookup table from entity 'Id's to corresponding entities.
--
-- >>> data A = A Int String deriving Show
-- >>> type IdA = Id A Int
-- >>> let a1 = A 1 "a1"
-- >>> let a2 = A 2 "a2"
-- >>> let a3 = A 3 "a3"
-- >>> let table = HM.fromList [(Id 1, a1), (Id 2, a2), (Id 3, a3)] :: IdLookup A Int
-- >>> HM.lookup (Id 1) table
-- Just (A 1 "a1")
type IdLookup a b = HM.HashMap (Id a b) a