{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Convenience functions for working with 'Key' dependencies
module Graphula.Key
  ( onlyKey
  , keys
  , Keys
  ) where

import Database.Persist
import GHC.TypeLits (ErrorMessage (..), TypeError)
import Graphula (Only (..), only)

class EntityKeys a where
  -- | Type-class for turning a tuple of 'Entity' into a tuple of 'Key'
  --
  -- For example, given:
  --
  -- @
  -- instance 'HasDependencies' Course where
  --   type Dependencies Course = (SchoolId, TeacherId)
  -- @
  --
  -- You would have to do,
  --
  -- @
  -- course <- 'node' @Course (entityKey school, entityKey teacher) mempty
  -- @
  --
  -- This type-class allows you to do:
  --
  -- @
  -- course <- 'node' @Course ('keys' (school, teacher)) mempty
  -- @
  --
  -- The type class instances currently scale up 4-tuple 'Dependencies'.
  type Keys a

  keys :: a -> Keys a

instance
  TypeError
    ( 'Text "Cannot use naked ‘"
        ':<>: 'ShowType (Entity a)
        ':<>: 'Text "’ as argument to ‘keys’."
        ':$$: 'Text "Did you mean ‘Only ("
        ':<>: 'ShowType (Entity a)
        ':<>: 'Text ")’?"
    )
  => EntityKeys (Entity a)
  where
  type Keys (Entity a) = Key a
  keys :: Entity a -> Keys (Entity a)
keys = forall record. Entity record -> Key record
entityKey

-- | Equivalent to @'Only' . 'entityKey'@
onlyKey :: Entity a -> Only (Key a)
onlyKey :: forall a. Entity a -> Only (Key a)
onlyKey = forall a. EntityKeys a => a -> Keys a
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Only a
only

instance EntityKeys (Only (Entity a)) where
  type Keys (Only (Entity a)) = Only (Key a)
  keys :: Only (Entity a) -> Keys (Only (Entity a))
keys (Only Entity a
a) = forall a. a -> Only a
Only (forall record. Entity record -> Key record
entityKey Entity a
a)

instance EntityKeys (Entity a, Entity b) where
  type Keys (Entity a, Entity b) = (Key a, Key b)
  keys :: (Entity a, Entity b) -> Keys (Entity a, Entity b)
keys (Entity a
a, Entity b
b) = (forall record. Entity record -> Key record
entityKey Entity a
a, forall record. Entity record -> Key record
entityKey Entity b
b)

instance EntityKeys (Entity a, Entity b, Entity c) where
  type Keys (Entity a, Entity b, Entity c) = (Key a, Key b, Key c)
  keys :: (Entity a, Entity b, Entity c)
-> Keys (Entity a, Entity b, Entity c)
keys (Entity a
a, Entity b
b, Entity c
c) = (forall record. Entity record -> Key record
entityKey Entity a
a, forall record. Entity record -> Key record
entityKey Entity b
b, forall record. Entity record -> Key record
entityKey Entity c
c)

-- For some reason, this definition (but no others) triggers
--
--   ERROR: brittany pretty printer returned syntactically invalid result.
--
-- brittany-disable-next-binding

instance EntityKeys (Entity a, Entity b, Entity c, Entity d) where
  type
    Keys (Entity a, Entity b, Entity c, Entity d) =
      (Key a, Key b, Key c, Key d)
  keys :: (Entity a, Entity b, Entity c, Entity d)
-> Keys (Entity a, Entity b, Entity c, Entity d)
keys (Entity a
a, Entity b
b, Entity c
c, Entity d
d) = (forall record. Entity record -> Key record
entityKey Entity a
a, forall record. Entity record -> Key record
entityKey Entity b
b, forall record. Entity record -> Key record
entityKey Entity c
c, forall record. Entity record -> Key record
entityKey Entity d
d)