{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeAbstractions #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ondim.Internal.Core
  ( expandNode,
    expandSubs,
    getExpansion,
    getTemplate,
    getNamespace,
    getText,
    -- Exceptions
    withoutNBErrors,
    withNBErrors,
    catchException,
    throwException,
    throwTemplateError,
    catchFailure,
    throwExpFailure,
  ) where

import Control.Monad.Except (MonadError (..))
import Data.Bitraversable (bimapM)
import Data.HashMap.Strict qualified as HMap
import Data.Typeable (eqT, (:~:) (..))
import Ondim.Internal.Basic
import Ondim.Internal.Class
import Ondim.State
import Type.Reflection (SomeTypeRep, someTypeRep)
import Prelude hiding (All)

-- Get stuff from state

fromTemplate ::
  forall b a s.
  (OndimNode a, OndimNode b) =>
  DefinitionSite ->
  b ->
  Either OndimFailure (Ondim s [a])
fromTemplate :: forall b a s.
(OndimNode a, OndimNode b) =>
DefinitionSite -> b -> Either OndimFailure (Ondim s [a])
fromTemplate DefinitionSite
site b
value
  | Just a :~: b
Refl <- 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 = Ondim s [a] -> Either OndimFailure (Ondim s [a])
forall a b. b -> Either a b
Right (b -> [a]
OneItem [a] -> [a]
forall x. One x => OneItem x -> x
one (b -> [a]) -> Ondim s b -> Ondim s [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ondim s b
lifted)
  | Just b -> [a]
cast <- Maybe (b -> [a])
forall a b. (OndimNode a, OndimNode b) => Maybe (a -> [b])
ondimCast = Ondim s [a] -> Either OndimFailure (Ondim s [a])
forall a b. b -> Either a b
Right (Ondim s [a] -> Either OndimFailure (Ondim s [a]))
-> Ondim s [a] -> Either OndimFailure (Ondim s [a])
forall a b. (a -> b) -> a -> b
$ b -> [a]
cast (b -> [a]) -> Ondim s b -> Ondim s [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ondim s b
lifted
  | Bool
otherwise = OndimFailure -> Either OndimFailure (Ondim s [a])
forall a b. a -> Either a b
Left (OndimFailure -> Either OndimFailure (Ondim s [a]))
-> OndimFailure -> Either OndimFailure (Ondim s [a])
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> OndimFailure
TemplateWrongType (Proxy b -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b))
  where
    lifted :: Ondim s b
lifted = DefinitionSite -> Ondim s b -> Ondim s b
forall s a. DefinitionSite -> Ondim s a -> Ondim s a
withSite DefinitionSite
site (b -> Ondim s b
forall s. b -> Ondim s b
forall t s. Expansible t => t -> Ondim s t
expandSubs b
value)

templateToExpansion ::
  forall s t.
  (OndimNode t) =>
  Ondim s [t] ->
  Expansion s t
templateToExpansion :: forall s t. OndimNode t => Ondim s [t] -> Expansion s t
templateToExpansion Ondim s [t]
tpl t
inner = do
  callSite <- Ondim s DefinitionSite
forall s. Ondim s DefinitionSite
getCurrentSite
  attrs <- attributes inner
  tpl `binding` do
    "caller" #. do
      "children" #: TemplateData callSite (children inner)
      unless (null attrs) $
        "attrs"
          #. forM_ attrs (uncurry (#@))

fromSomeExpansion ::
  forall a s.
  (OndimNode a) =>
  DefinitionSite ->
  NamespaceItem s ->
  Either OndimFailure (Expansion s a, DefinitionSite)
fromSomeExpansion :: forall a s.
OndimNode a =>
DefinitionSite
-> NamespaceItem s
-> Either OndimFailure (Expansion s a, DefinitionSite)
fromSomeExpansion DefinitionSite
callSite NamespaceItem s
someExp =
  case NamespaceItem s
someExp' of
    (PolyExpansion DefinitionSite
site PolyExpansion s
e) -> (Expansion s a, DefinitionSite)
-> Either OndimFailure (Expansion s a, DefinitionSite)
forall a b. b -> Either a b
Right (Expansion s a
PolyExpansion s
e, DefinitionSite
site)
    (TypedExpansion @t DefinitionSite
site Expansion s a
v)
      | Just a :~: a
Refl <- 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 @t -> (Expansion s a, DefinitionSite)
-> Either OndimFailure (Expansion s a, DefinitionSite)
forall a b. b -> Either a b
Right (Expansion s a
Expansion s a
v, DefinitionSite
site)
      | Bool
otherwise -> OndimFailure -> Either OndimFailure (Expansion s a, DefinitionSite)
forall a b. a -> Either a b
Left (OndimFailure
 -> Either OndimFailure (Expansion s a, DefinitionSite))
-> OndimFailure
-> Either OndimFailure (Expansion s a, DefinitionSite)
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> OndimFailure
ExpansionWrongType (Proxy a -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t))
    (TemplateData DefinitionSite
site a
v) -> do
      thing <- DefinitionSite -> a -> Either OndimFailure (Ondim s [a])
forall b a s.
(OndimNode a, OndimNode b) =>
DefinitionSite -> b -> Either OndimFailure (Ondim s [a])
fromTemplate DefinitionSite
site a
v
      return (templateToExpansion thing, site)
    NamespaceData {} -> OndimFailure -> Either OndimFailure (Expansion s a, DefinitionSite)
forall a b. a -> Either a b
Left (OndimFailure
 -> Either OndimFailure (Expansion s a, DefinitionSite))
-> OndimFailure
-> Either OndimFailure (Expansion s a, DefinitionSite)
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> OndimFailure
ExpansionWrongType (Proxy Namespace -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Namespace))
  where
    -- The empty string "" acts as a default expansion for the namespace.
    -- When calling from a file, the file extension also acts as a default.
    someExp' :: NamespaceItem s
someExp' = case NamespaceItem s
someExp of
      (NamespaceData ns :: Namespace s
ns@(Namespace HashMap Text (NamespaceItem s)
n))
        | Just NamespaceItem s
v <- Text -> HashMap Text (NamespaceItem s) -> Maybe (NamespaceItem s)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMap.lookup Text
"" HashMap Text (NamespaceItem s)
n -> NamespaceItem s
v
        | FileDefinition String
_ Text
ext <- DefinitionSite
callSite,
          Just NamespaceItem s
v <- Text -> Namespace s -> Maybe (NamespaceItem s)
forall m. Text -> Namespace m -> Maybe (NamespaceItem m)
lookup Text
ext Namespace s
ns ->
            NamespaceItem s
v
      NamespaceItem s
_nonNamespace -> NamespaceItem s
someExp

getText :: Text -> Ondim s (Either OndimFailure Text)
getText :: forall s. Text -> Ondim s (Either OndimFailure Text)
getText Text
name = do
  mbValue <- Text -> Namespace s -> Maybe (NamespaceItem s)
forall m. Text -> Namespace m -> Maybe (NamespaceItem m)
lookup Text
name (Namespace s -> Maybe (NamespaceItem s))
-> (OndimState s -> Namespace s)
-> OndimState s
-> Maybe (NamespaceItem s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OndimState s -> Namespace s
forall s. OndimState s -> Namespace s
expansions (OndimState s -> Maybe (NamespaceItem s))
-> Ondim s (OndimState s) -> Ondim s (Maybe (NamespaceItem s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ondim s (OndimState s)
forall s. Ondim s (OndimState s)
getOndimS
  case mbValue of
    Just (TemplateData @t DefinitionSite
site a
thing)
      | Just Text :~: a
Refl <- forall a b. (Typeable a, OndimNode b) => Maybe (a :~: b)
eqT' @Text @t -> Either OndimFailure Text -> Ondim s (Either OndimFailure Text)
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either OndimFailure Text -> Ondim s (Either OndimFailure Text))
-> Either OndimFailure Text -> Ondim s (Either OndimFailure Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either OndimFailure Text
forall a b. b -> Either a b
Right a
Text
thing
      | Just a -> Text
cast <- Maybe (a -> Text)
forall t. OndimNode t => Maybe (t -> Text)
nodeAsText -> Text -> Either OndimFailure Text
forall a b. b -> Either a b
Right (Text -> Either OndimFailure Text)
-> (a -> Text) -> a -> Either OndimFailure Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
cast (a -> Either OndimFailure Text)
-> Ondim s a -> Ondim s (Either OndimFailure Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefinitionSite -> Ondim s a -> Ondim s a
forall s a. DefinitionSite -> Ondim s a -> Ondim s a
withSite DefinitionSite
site (a -> Ondim s a
forall s. a -> Ondim s a
forall t s. Expansible t => t -> Ondim s t
expandSubs a
thing)
      | Bool
otherwise -> Either OndimFailure Text -> Ondim s (Either OndimFailure Text)
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either OndimFailure Text -> Ondim s (Either OndimFailure Text))
-> Either OndimFailure Text -> Ondim s (Either OndimFailure Text)
forall a b. (a -> b) -> a -> b
$ OndimFailure -> Either OndimFailure Text
forall a b. a -> Either a b
Left (OndimFailure -> Either OndimFailure Text)
-> OndimFailure -> Either OndimFailure Text
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> OndimFailure
TemplateWrongType (forall a. OndimNode a => SomeTypeRep
typeRep' @t)
    -- bimapM return id $ fromTemplate site thing
    Just NamespaceItem s
_ -> Either OndimFailure Text -> Ondim s (Either OndimFailure Text)
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either OndimFailure Text -> Ondim s (Either OndimFailure Text))
-> Either OndimFailure Text -> Ondim s (Either OndimFailure Text)
forall a b. (a -> b) -> a -> b
$ OndimFailure -> Either OndimFailure Text
forall a b. a -> Either a b
Left (Text -> OndimFailure
FailureOther Text
"Identifier not bound to a template.")
    Maybe (NamespaceItem s)
Nothing -> Either OndimFailure Text -> Ondim s (Either OndimFailure Text)
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either OndimFailure Text -> Ondim s (Either OndimFailure Text))
-> Either OndimFailure Text -> Ondim s (Either OndimFailure Text)
forall a b. (a -> b) -> a -> b
$ OndimFailure -> Either OndimFailure Text
forall a b. a -> Either a b
Left OndimFailure
NotBound
  where
    -- Small hacks (this is due to hs-boot superclass witness issues)
    eqT' :: forall a b. (Typeable a, OndimNode b) => Maybe (a :~: b)
    eqT' :: forall a b. (Typeable a, OndimNode b) => Maybe (a :~: b)
eqT' = 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
    typeRep' :: forall a. (OndimNode a) => SomeTypeRep
    typeRep' :: forall a. OndimNode a => SomeTypeRep
typeRep' = Proxy a -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

getTemplate :: (OndimNode a) => Text -> Ondim s (Either OndimFailure [a])
getTemplate :: forall a s.
OndimNode a =>
Text -> Ondim s (Either OndimFailure [a])
getTemplate Text
name = do
  mbValue <- Text -> Namespace s -> Maybe (NamespaceItem s)
forall m. Text -> Namespace m -> Maybe (NamespaceItem m)
lookup Text
name (Namespace s -> Maybe (NamespaceItem s))
-> (OndimState s -> Namespace s)
-> OndimState s
-> Maybe (NamespaceItem s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OndimState s -> Namespace s
forall s. OndimState s -> Namespace s
expansions (OndimState s -> Maybe (NamespaceItem s))
-> Ondim s (OndimState s) -> Ondim s (Maybe (NamespaceItem s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ondim s (OndimState s)
forall s. Ondim s (OndimState s)
getOndimS
  case mbValue of
    Just (TemplateData DefinitionSite
site a
thing) ->
      (OndimFailure -> Ondim s OndimFailure)
-> (Ondim s [a] -> Ondim s [a])
-> Either OndimFailure (Ondim s [a])
-> Ondim s (Either OndimFailure [a])
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bimapM OndimFailure -> Ondim s OndimFailure
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return Ondim s [a] -> Ondim s [a]
forall a. a -> a
id (Either OndimFailure (Ondim s [a])
 -> Ondim s (Either OndimFailure [a]))
-> Either OndimFailure (Ondim s [a])
-> Ondim s (Either OndimFailure [a])
forall a b. (a -> b) -> a -> b
$ DefinitionSite -> a -> Either OndimFailure (Ondim s [a])
forall b a s.
(OndimNode a, OndimNode b) =>
DefinitionSite -> b -> Either OndimFailure (Ondim s [a])
fromTemplate DefinitionSite
site a
thing
    Just NamespaceItem s
_ -> Either OndimFailure [a] -> Ondim s (Either OndimFailure [a])
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either OndimFailure [a] -> Ondim s (Either OndimFailure [a]))
-> Either OndimFailure [a] -> Ondim s (Either OndimFailure [a])
forall a b. (a -> b) -> a -> b
$ OndimFailure -> Either OndimFailure [a]
forall a b. a -> Either a b
Left (Text -> OndimFailure
FailureOther Text
"Identifier not bound to a template.")
    Maybe (NamespaceItem s)
Nothing -> Either OndimFailure [a] -> Ondim s (Either OndimFailure [a])
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either OndimFailure [a] -> Ondim s (Either OndimFailure [a]))
-> Either OndimFailure [a] -> Ondim s (Either OndimFailure [a])
forall a b. (a -> b) -> a -> b
$ OndimFailure -> Either OndimFailure [a]
forall a b. a -> Either a b
Left OndimFailure
NotBound

getNamespace :: Text -> Ondim s (Either OndimFailure (Namespace s))
getNamespace :: forall s. Text -> Ondim s (Either OndimFailure (Namespace s))
getNamespace Text
name = do
  mbValue <- Text -> Namespace s -> Maybe (NamespaceItem s)
forall m. Text -> Namespace m -> Maybe (NamespaceItem m)
lookup Text
name (Namespace s -> Maybe (NamespaceItem s))
-> (OndimState s -> Namespace s)
-> OndimState s
-> Maybe (NamespaceItem s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OndimState s -> Namespace s
forall s. OndimState s -> Namespace s
expansions (OndimState s -> Maybe (NamespaceItem s))
-> Ondim s (OndimState s) -> Ondim s (Maybe (NamespaceItem s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ondim s (OndimState s)
forall s. Ondim s (OndimState s)
getOndimS
  case mbValue of
    Just (NamespaceData Namespace s
n) -> Either OndimFailure (Namespace s)
-> Ondim s (Either OndimFailure (Namespace s))
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either OndimFailure (Namespace s)
 -> Ondim s (Either OndimFailure (Namespace s)))
-> Either OndimFailure (Namespace s)
-> Ondim s (Either OndimFailure (Namespace s))
forall a b. (a -> b) -> a -> b
$ Namespace s -> Either OndimFailure (Namespace s)
forall a b. b -> Either a b
Right Namespace s
n
    Just NamespaceItem s
_ -> Either OndimFailure (Namespace s)
-> Ondim s (Either OndimFailure (Namespace s))
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either OndimFailure (Namespace s)
 -> Ondim s (Either OndimFailure (Namespace s)))
-> Either OndimFailure (Namespace s)
-> Ondim s (Either OndimFailure (Namespace s))
forall a b. (a -> b) -> a -> b
$ OndimFailure -> Either OndimFailure (Namespace s)
forall a b. a -> Either a b
Left (Text -> OndimFailure
FailureOther Text
"Identifier not bound to a namespace.")
    Maybe (NamespaceItem s)
Nothing -> Either OndimFailure (Namespace s)
-> Ondim s (Either OndimFailure (Namespace s))
forall a. a -> Ondim s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either OndimFailure (Namespace s)
 -> Ondim s (Either OndimFailure (Namespace s)))
-> Either OndimFailure (Namespace s)
-> Ondim s (Either OndimFailure (Namespace s))
forall a b. (a -> b) -> a -> b
$ OndimFailure -> Either OndimFailure (Namespace s)
forall a b. a -> Either a b
Left OndimFailure
NotBound

getExpansion :: (OndimNode t) => Text -> Ondim s (Either OndimFailure (Expansion s t))
getExpansion :: forall t s.
OndimNode t =>
Text -> Ondim s (Either OndimFailure (Expansion s t))
getExpansion Text
name = do
  mbValue <- Text -> Namespace s -> Maybe (NamespaceItem s)
forall m. Text -> Namespace m -> Maybe (NamespaceItem m)
lookup Text
name (Namespace s -> Maybe (NamespaceItem s))
-> (OndimState s -> Namespace s)
-> OndimState s
-> Maybe (NamespaceItem s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OndimState s -> Namespace s
forall s. OndimState s -> Namespace s
expansions (OndimState s -> Maybe (NamespaceItem s))
-> Ondim s (OndimState s) -> Ondim s (Maybe (NamespaceItem s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ondim s (OndimState s)
forall s. Ondim s (OndimState s)
getOndimS
  site <- getCurrentSite
  return do
    value <- maybeToRight NotBound mbValue
    (expansion, expSite) <- fromSomeExpansion site value
    return $ expCtx name expSite . expansion
{-# INLINEABLE getExpansion #-}

expCtx :: Text -> DefinitionSite -> Ondim s a -> Ondim s a
expCtx :: forall s a. Text -> DefinitionSite -> Ondim s a -> Ondim s a
expCtx Text
name DefinitionSite
site (Ondim ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
ctx) = do
  gst <- ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  TraceData
-> Ondim s TraceData
forall s a.
ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
Ondim (ReaderT
   (TraceData, STRef s (OndimState s))
   (ExceptT OndimException (ST s))
   TraceData
 -> Ondim s TraceData)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     TraceData
-> Ondim s TraceData
forall a b. (a -> b) -> a -> b
$ ((TraceData, STRef s (OndimState s)) -> TraceData)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     TraceData
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TraceData, STRef s (OndimState s)) -> TraceData
forall a b. (a, b) -> a
fst
  if depth gst >= 200
    then -- To avoid recursive expansions
      throwException MaxExpansionDepthExceeded
    else
      Ondim $
        local
          ( first \TraceData
s ->
              TraceData
s
                { depth = depth s + 1,
                  expansionTrace =
                    (name, site)
                      : expansionTrace s
                }
          )
          ctx

-- * Expansion

{- | This function recursively expands the node and its substructures according to
   the expansions that are bound in the context.

  More precisely, if the node name matches the name of a bound expansion, then
  it feeds the node directly into the expansion. Otherwise, it runs
  'expandSubstructures' on the node, which essentially amounts to running
  'expandNode' on each substructure.
-}
expandNode :: forall t s. (OndimNode t) => t -> Ondim s [t]
expandNode :: forall t s. OndimNode t => t -> Ondim s [t]
expandNode t
node = do
  inhibit <- ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  Bool
-> Ondim s Bool
forall s a.
ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
Ondim (ReaderT
   (TraceData, STRef s (OndimState s))
   (ExceptT OndimException (ST s))
   Bool
 -> Ondim s Bool)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     Bool
-> Ondim s Bool
forall a b. (a -> b) -> a -> b
$ ((TraceData, STRef s (OndimState s)) -> Bool)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TraceData -> Bool
inhibitErrors (TraceData -> Bool)
-> ((TraceData, STRef s (OndimState s)) -> TraceData)
-> (TraceData, STRef s (OndimState s))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TraceData, STRef s (OndimState s)) -> TraceData
forall a b. (a, b) -> a
fst)
  case identify node of
    Just Text
name ->
      Text -> Ondim s (Either OndimFailure (Expansion s t))
forall t s.
OndimNode t =>
Text -> Ondim s (Either OndimFailure (Expansion s t))
getExpansion Text
name Ondim s (Either OndimFailure (Expansion s t))
-> (Either OndimFailure (Expansion s t) -> Ondim s [t])
-> Ondim s [t]
forall a b. Ondim s a -> (a -> Ondim s b) -> Ondim s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Expansion s t
expansion -> Expansion s t
expansion t
node
        Left OndimFailure
e
          | Bool
inhibit -> Ondim s [t]
continue
          | Bool
otherwise -> forall {k} (t :: k) s a.
Typeable t =>
Text -> OndimFailure -> Ondim s a
forall t s a. Typeable t => Text -> OndimFailure -> Ondim s a
throwExpFailure @t Text
name OndimFailure
e
    Maybe Text
Nothing -> Ondim s [t]
continue
  where
    continue :: Ondim s [t]
continue = t -> [t]
OneItem [t] -> [t]
forall x. One x => OneItem x -> x
one (t -> [t]) -> Ondim s t -> Ondim s [t]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Ondim s t
forall s. t -> Ondim s t
forall t s. Expansible t => t -> Ondim s t
expandSubs t
node
{-# INLINEABLE expandNode #-}

instance
  {-# OVERLAPPABLE #-}
  ( OndimNode t
  ) =>
  Expansible [t]
  where
  expandSubs :: forall s. [t] -> Ondim s [t]
expandSubs = (t -> Ondim s [t]) -> [t] -> Ondim s [t]
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM t -> Ondim s [t]
forall t s. OndimNode t => t -> Ondim s [t]
expandNode
  {-# INLINEABLE expandSubs #-}

instance
  {-# OVERLAPPABLE #-}
  ( OndimNode t
  ) =>
  Expansible (Seq t)
  where
  expandSubs :: forall s. Seq t -> Ondim s (Seq t)
expandSubs = (t -> Ondim s (Seq t)) -> Seq t -> Ondim s (Seq t)
forall b (m :: * -> *) (f :: * -> *) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (([t] -> Seq t) -> Ondim s [t] -> Ondim s (Seq t)
forall a b. (a -> b) -> Ondim s a -> Ondim s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [t] -> Seq t
[Item (Seq t)] -> Seq t
forall l. IsList l => [Item l] -> l
fromList (Ondim s [t] -> Ondim s (Seq t))
-> (t -> Ondim s [t]) -> t -> Ondim s (Seq t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Ondim s [t]
forall t s. OndimNode t => t -> Ondim s [t]
expandNode)
  {-# INLINEABLE expandSubs #-}

-- * Exceptions

{- | Run subcomputation without (most) "not bound" errors. More specifically, if
'Ondim.expandNode' finds a node whose identifier is not bound, it will not
throw an error and instead treat it as if it had no identifier, i.e., it will
ignore it and recurse into the substructures.
-}
withoutNBErrors :: Ondim s a -> Ondim s a
withoutNBErrors :: forall s a. Ondim s a -> Ondim s a
withoutNBErrors = ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
forall s a.
ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
Ondim (ReaderT
   (TraceData, STRef s (OndimState s))
   (ExceptT OndimException (ST s))
   a
 -> Ondim s a)
-> (Ondim s a
    -> ReaderT
         (TraceData, STRef s (OndimState s))
         (ExceptT OndimException (ST s))
         a)
-> Ondim s a
-> Ondim s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TraceData, STRef s (OndimState s))
 -> (TraceData, STRef s (OndimState s)))
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall a.
((TraceData, STRef s (OndimState s))
 -> (TraceData, STRef s (OndimState s)))
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((TraceData -> TraceData)
-> (TraceData, STRef s (OndimState s))
-> (TraceData, STRef s (OndimState s))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TraceData -> TraceData
f) (ReaderT
   (TraceData, STRef s (OndimState s))
   (ExceptT OndimException (ST s))
   a
 -> ReaderT
      (TraceData, STRef s (OndimState s))
      (ExceptT OndimException (ST s))
      a)
-> (Ondim s a
    -> ReaderT
         (TraceData, STRef s (OndimState s))
         (ExceptT OndimException (ST s))
         a)
-> Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall s a.
Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
unOndimT
  where
    f :: TraceData -> TraceData
f TraceData
r = TraceData
r {inhibitErrors = True}

-- | Run subcomputation with "not bound" errors.
withNBErrors :: Ondim s a -> Ondim s a
withNBErrors :: forall s a. Ondim s a -> Ondim s a
withNBErrors = ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
forall s a.
ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
Ondim (ReaderT
   (TraceData, STRef s (OndimState s))
   (ExceptT OndimException (ST s))
   a
 -> Ondim s a)
-> (Ondim s a
    -> ReaderT
         (TraceData, STRef s (OndimState s))
         (ExceptT OndimException (ST s))
         a)
-> Ondim s a
-> Ondim s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TraceData, STRef s (OndimState s))
 -> (TraceData, STRef s (OndimState s)))
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall a.
((TraceData, STRef s (OndimState s))
 -> (TraceData, STRef s (OndimState s)))
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((TraceData -> TraceData)
-> (TraceData, STRef s (OndimState s))
-> (TraceData, STRef s (OndimState s))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TraceData -> TraceData
f) (ReaderT
   (TraceData, STRef s (OndimState s))
   (ExceptT OndimException (ST s))
   a
 -> ReaderT
      (TraceData, STRef s (OndimState s))
      (ExceptT OndimException (ST s))
      a)
-> (Ondim s a
    -> ReaderT
         (TraceData, STRef s (OndimState s))
         (ExceptT OndimException (ST s))
         a)
-> Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall s a.
Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
unOndimT
  where
    f :: TraceData -> TraceData
f TraceData
r = TraceData
r {inhibitErrors = False}

catchException ::
  Ondim s a ->
  (OndimException -> Ondim s a) ->
  Ondim s a
catchException :: forall s a. Ondim s a -> (OndimException -> Ondim s a) -> Ondim s a
catchException (Ondim ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
m) OndimException -> Ondim s a
f = ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
forall s a.
ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
Ondim (ReaderT
   (TraceData, STRef s (OndimState s))
   (ExceptT OndimException (ST s))
   a
 -> Ondim s a)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
-> Ondim s a
forall a b. (a -> b) -> a -> b
$ ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> (OndimException
    -> ReaderT
         (TraceData, STRef s (OndimState s))
         (ExceptT OndimException (ST s))
         a)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall a.
ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> (OndimException
    -> ReaderT
         (TraceData, STRef s (OndimState s))
         (ExceptT OndimException (ST s))
         a)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
m (Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall s a.
Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
unOndimT (Ondim s a
 -> ReaderT
      (TraceData, STRef s (OndimState s))
      (ExceptT OndimException (ST s))
      a)
-> (OndimException -> Ondim s a)
-> OndimException
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OndimException -> Ondim s a
f)

throwException :: ExceptionType -> Ondim s a
throwException :: forall s a. ExceptionType -> Ondim s a
throwException ExceptionType
e = do
  td <- ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  TraceData
-> Ondim s TraceData
forall s a.
ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
Ondim (((TraceData, STRef s (OndimState s)) -> TraceData)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     TraceData
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (TraceData, STRef s (OndimState s)) -> TraceData
forall a b. (a, b) -> a
fst)
  Ondim $ throwError (OndimException e td)

throwTemplateError :: (HasCallStack) => Text -> Ondim s a
throwTemplateError :: forall s a. HasCallStack => Text -> Ondim s a
throwTemplateError Text
t = ExceptionType -> Ondim s a
forall s a. ExceptionType -> Ondim s a
throwException (CallStack -> Text -> ExceptionType
TemplateError CallStack
HasCallStack => CallStack
callStack Text
t)

catchFailure ::
  Ondim s a ->
  (OndimFailure -> Text -> SomeTypeRep -> TraceData -> Ondim s a) ->
  Ondim s a
catchFailure :: forall s a.
Ondim s a
-> (OndimFailure -> Text -> SomeTypeRep -> TraceData -> Ondim s a)
-> Ondim s a
catchFailure (Ondim ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
m) OndimFailure -> Text -> SomeTypeRep -> TraceData -> Ondim s a
f = ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
forall s a.
ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> Ondim s a
Ondim (ReaderT
   (TraceData, STRef s (OndimState s))
   (ExceptT OndimException (ST s))
   a
 -> Ondim s a)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
-> Ondim s a
forall a b. (a -> b) -> a -> b
$ ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> (OndimException
    -> ReaderT
         (TraceData, STRef s (OndimState s))
         (ExceptT OndimException (ST s))
         a)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall a.
ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
-> (OndimException
    -> ReaderT
         (TraceData, STRef s (OndimState s))
         (ExceptT OndimException (ST s))
         a)
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
m \(OndimException ExceptionType
exc TraceData
tdata) ->
  case ExceptionType
exc of
    Failure SomeTypeRep
trep Text
name OndimFailure
e -> Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall s a.
Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
unOndimT (Ondim s a
 -> ReaderT
      (TraceData, STRef s (OndimState s))
      (ExceptT OndimException (ST s))
      a)
-> Ondim s a
-> ReaderT
     (TraceData, STRef s (OndimState s))
     (ExceptT OndimException (ST s))
     a
forall a b. (a -> b) -> a -> b
$ OndimFailure -> Text -> SomeTypeRep -> TraceData -> Ondim s a
f OndimFailure
e Text
name SomeTypeRep
trep TraceData
tdata
    ExceptionType
_other -> ReaderT
  (TraceData, STRef s (OndimState s))
  (ExceptT OndimException (ST s))
  a
m

throwExpFailure ::
  forall t s a.
  (Typeable t) =>
  Text ->
  OndimFailure ->
  Ondim s a
throwExpFailure :: forall {k} (t :: k) s a.
Typeable t =>
Text -> OndimFailure -> Ondim s a
throwExpFailure Text
t OndimFailure
f =
  ExceptionType -> Ondim s a
forall s a. ExceptionType -> Ondim s a
throwException (ExceptionType -> Ondim s a) -> ExceptionType -> Ondim s a
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> Text -> OndimFailure -> ExceptionType
Failure (Proxy t -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @t)) Text
t OndimFailure
f