{-# LANGUAGE UndecidableInstances #-}

module Ondim.Internal.Class
  ( OndimNode (..),
    Expansible (..),
    ondimCast,
    Attribute,
  ) where

import {-# SOURCE #-} Ondim.Internal.Basic (Ondim)
import Data.Typeable ((:~:)(..), eqT)

-- * Attributes

-- | Alias for attributes
type Attribute = (Text, Text)

-- ** Class

-- * 'OndimNode' class

class Expansible (t :: Type) where
  -- | Expand only the substructures of a node.
  expandSubs :: t -> Ondim s t

class (Typeable t, Expansible t) => OndimNode t where
  -- | Returns the name of the node as defined by the 'OndimNode' instance.
  identify :: t -> Maybe Text
  identify t
_ = Maybe Text
forall a. Maybe a
Nothing

  -- | Returns a list of attributes of the node as defined by the 'OndimNode' instance.
  attributes :: t -> Ondim s [Attribute]
  attributes t
_ = [Attribute] -> Ondim s [Attribute]
forall a. a -> Ondim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

  -- | Returns the children of the node as defined by the 'OndimNode' instance.
  children :: t -> [t]
  children t
_ = []

  castFrom :: (OndimNode a) => Maybe (a -> [t])
  castFrom = Maybe (a -> [t])
forall a. Maybe a
Nothing

  -- | Converts the node to a 'LByteString' as defined by the 'OndimNode' instance.
  renderNode :: Maybe (t -> LByteString)
  renderNode = Maybe (t -> LByteString)
forall a. Maybe a
Nothing

  nodeAsText :: Maybe (t -> Text)
  nodeAsText = Maybe (t -> Text)
forall a. Maybe a
Nothing

instance {-# OVERLAPPABLE #-} (OndimNode a, Expansible (t a), Foldable t, Typeable t) => OndimNode (t a) where
  renderNode :: Maybe (t a -> LByteString)
renderNode = (a -> LByteString) -> t a -> LByteString
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' ((a -> LByteString) -> t a -> LByteString)
-> Maybe (a -> LByteString) -> Maybe (t a -> LByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a -> LByteString)
forall t. OndimNode t => Maybe (t -> LByteString)
renderNode
  nodeAsText :: Maybe (t a -> Text)
nodeAsText = (a -> Text) -> t a -> Text
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' ((a -> Text) -> t a -> Text)
-> Maybe (a -> Text) -> Maybe (t a -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a -> Text)
forall t. OndimNode t => Maybe (t -> Text)
nodeAsText

-- Some data instances (won't lift)

instance (Expansible Text) where
  expandSubs :: forall s. Text -> Ondim s Text
expandSubs = Text -> Ondim s Text
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance OndimNode Text where
  nodeAsText :: Maybe (Text -> Text)
nodeAsText = (Text -> Text) -> Maybe (Text -> Text)
forall a. a -> Maybe a
Just Text -> Text
forall a. a -> a
id

instance (Expansible LByteString) where
  expandSubs :: forall s. LByteString -> Ondim s LByteString
expandSubs = LByteString -> Ondim s LByteString
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance OndimNode LByteString

instance (Expansible Attribute) where
  expandSubs :: forall s. Attribute -> Ondim s Attribute
expandSubs = Attribute -> Ondim s Attribute
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance OndimNode Attribute

ondimCast :: forall a b. (OndimNode a, OndimNode b) => Maybe (a -> [b])
ondimCast :: forall a b. (OndimNode a, OndimNode b) => Maybe (a -> [b])
ondimCast = Maybe (a -> [b])
forall a. OndimNode a => Maybe (a -> [b])
forall t a. (OndimNode t, OndimNode a) => Maybe (a -> [t])
castFrom Maybe (a -> [b]) -> Maybe (a -> [b]) -> Maybe (a -> [b])
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @a @[b] of
  Just a :~: [b]
Refl -> (a -> [b]) -> Maybe (a -> [b])
forall a. a -> Maybe a
Just a -> a
a -> [b]
forall a. a -> a
id
  Maybe (a :~: [b])
Nothing -> Maybe (a -> [b])
forall a. Maybe a
Nothing