-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- 'newtype Container' deriving produced some fake warnings
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Module, containing on-chain views declarations.
module Morley.Michelson.Typed.View
  ( -- * View
    ViewName (..)
  , mkViewName
  , viewNameToMText
  , ViewCode'
  , View' (..)
  , SomeView' (..)
  , someViewName

    -- * Views set
  , ViewsSet' (.., ViewsSet, ViewsList)
  , ViewsSetError (..)
  , mkViewsSet
  , emptyViewsSet
  , addViewToSet
  , lookupView
  , viewsSetNames
  , SomeViewsSet' (..)
  ) where

import Control.Monad.Except (throwError)
import Data.Default (Default(..))
import Data.Sequence qualified as Seq
import Fmt (Buildable(..), (+|), (|+))

import Morley.Michelson.Typed.Annotation
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Typed.T (T(..))
import Morley.Michelson.Untyped.View (ViewName(..), mkViewName, viewNameToMText)
import Morley.Util.Sing


type ViewCode' instr arg st ret = instr '[ 'TPair arg st] '[ret]

-- | Contract view.
data View' instr arg st ret = (ViewableScope arg, SingI st, ViewableScope ret) => View
  { forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewName
vName :: ViewName
    -- ^ Name of the view.
  , forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> Notes arg
vArgument :: Notes arg
    -- ^ Argument type annotations.
  , forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> Notes ret
vReturn :: Notes ret
    -- ^ Return type annotations.
  , forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewCode' instr arg st ret
vCode :: ViewCode' instr arg st ret
    -- ^ View code.
  }

deriving stock instance Show (ViewCode' instr arg st ret) => Show (View' instr arg st ret)
deriving stock instance Eq (ViewCode' instr arg st ret) => Eq (View' instr arg st ret)
instance NFData (ViewCode' instr arg st ret) => NFData (View' instr arg st ret) where
  rnf :: View' instr arg st ret -> ()
rnf (View ViewName
a Notes arg
b Notes ret
c ViewCode' instr arg st ret
d) = (ViewName, Notes arg, Notes ret, ViewCode' instr arg st ret) -> ()
forall a. NFData a => a -> ()
rnf (ViewName
a, Notes arg
b, Notes ret
c, ViewCode' instr arg st ret
d)

data SomeView' instr st where
  SomeView :: View' instr arg st ret -> SomeView' instr st

deriving stock instance
  (forall arg ret. Show (ViewCode' instr arg st ret)) =>
  Show (SomeView' instr st)
instance
  (forall arg ret. Eq (ViewCode' instr arg st ret)) =>
  Eq (SomeView' instr st) where
    SomeView v1 :: View' instr arg st ret
v1@View{} == :: SomeView' instr st -> SomeView' instr st -> Bool
== SomeView v2 :: View' instr arg st ret
v2@View{} = View' instr arg st ret
v1 View' instr arg st ret -> View' instr arg st ret -> Bool
forall {k1} {k2} {k3} (a1 :: k1) (a2 :: k1) (b1 :: k2) (b2 :: k2)
       (c1 :: k3) (c2 :: k3) (t :: k1 -> k2 -> k3 -> *).
(SingI a1, SingI a2, SingI b1, SingI b2, SingI c1, SingI c2,
 SDecide k1, SDecide k2, SDecide k3, Eq (t a1 b1 c1)) =>
t a1 b1 c1 -> t a2 b2 c2 -> Bool
`eqParamSing3` View' instr arg st ret
v2
instance
  (forall arg ret. NFData (ViewCode' instr arg st ret)) =>
  NFData (SomeView' instr st) where
    rnf :: SomeView' instr st -> ()
rnf (SomeView View' instr arg st ret
v) = View' instr arg st ret -> ()
forall a. NFData a => a -> ()
rnf View' instr arg st ret
v

-- | Obtain the name of the view.
someViewName :: SomeView' instr st -> ViewName
someViewName :: forall (instr :: [T] -> [T] -> *) (st :: T).
SomeView' instr st -> ViewName
someViewName (SomeView View' instr arg st ret
v) = View' instr arg st ret -> ViewName
forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewName
vName View' instr arg st ret
v

-- View sets
----------------------------------------------------------------------------

-- | Views that belong to one contract.
--
-- Invariant: all view names are unique.
--
-- Implementation note: lookups still take linear time.
-- We use 'Seq' for simplicity, as in either case we need to preserve the order
-- of views (so that decoding/encoding roundtrip).
newtype ViewsSet' instr st = UnsafeViewsSet { forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> Seq $ SomeView' instr st
unViewsSet :: Seq $ SomeView' instr st }
  deriving newtype (ViewsSet' instr st
ViewsSet' instr st -> Default (ViewsSet' instr st)
forall a. a -> Default a
forall (instr :: [T] -> [T] -> *) (st :: T). ViewsSet' instr st
def :: ViewsSet' instr st
$cdef :: forall (instr :: [T] -> [T] -> *) (st :: T). ViewsSet' instr st
Default, Eq (Element (ViewsSet' instr st)) =>
Element (ViewsSet' instr st) -> ViewsSet' instr st -> Bool
Ord (Element (ViewsSet' instr st)) =>
ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
Monoid (Element (ViewsSet' instr st)) =>
ViewsSet' instr st -> Element (ViewsSet' instr st)
(Element (ViewsSet' instr st) ~ Bool) => ViewsSet' instr st -> Bool
ViewsSet' instr st -> Bool
ViewsSet' instr st -> Int
ViewsSet' instr st -> [Element (ViewsSet' instr st)]
ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
(Element (ViewsSet' instr st) -> Bool)
-> ViewsSet' instr st -> Bool
(Element (ViewsSet' instr st) -> Bool)
-> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
(Element (ViewsSet' instr st)
 -> Element (ViewsSet' instr st) -> Element (ViewsSet' instr st))
-> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
(ViewsSet' instr st -> [Element (ViewsSet' instr st)])
-> (ViewsSet' instr st -> Bool)
-> (forall b.
    (Element (ViewsSet' instr st) -> b -> b)
    -> b -> ViewsSet' instr st -> b)
-> (forall b.
    (b -> Element (ViewsSet' instr st) -> b)
    -> b -> ViewsSet' instr st -> b)
-> (forall b.
    (b -> Element (ViewsSet' instr st) -> b)
    -> b -> ViewsSet' instr st -> b)
-> (ViewsSet' instr st -> Int)
-> (Eq (Element (ViewsSet' instr st)) =>
    Element (ViewsSet' instr st) -> ViewsSet' instr st -> Bool)
-> (forall m.
    Monoid m =>
    (Element (ViewsSet' instr st) -> m) -> ViewsSet' instr st -> m)
-> (Monoid (Element (ViewsSet' instr st)) =>
    ViewsSet' instr st -> Element (ViewsSet' instr st))
-> (forall b.
    (Element (ViewsSet' instr st) -> b -> b)
    -> b -> ViewsSet' instr st -> b)
-> (Eq (Element (ViewsSet' instr st)) =>
    Element (ViewsSet' instr st) -> ViewsSet' instr st -> Bool)
-> ((Element (ViewsSet' instr st) -> Bool)
    -> ViewsSet' instr st -> Bool)
-> ((Element (ViewsSet' instr st) -> Bool)
    -> ViewsSet' instr st -> Bool)
-> ((Element (ViewsSet' instr st) ~ Bool) =>
    ViewsSet' instr st -> Bool)
-> ((Element (ViewsSet' instr st) ~ Bool) =>
    ViewsSet' instr st -> Bool)
-> ((Element (ViewsSet' instr st) -> Bool)
    -> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st)))
-> (ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st)))
-> (Ord (Element (ViewsSet' instr st)) =>
    ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st)))
-> (Ord (Element (ViewsSet' instr st)) =>
    ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st)))
-> ((Element (ViewsSet' instr st)
     -> Element (ViewsSet' instr st) -> Element (ViewsSet' instr st))
    -> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st)))
-> ((Element (ViewsSet' instr st)
     -> Element (ViewsSet' instr st) -> Element (ViewsSet' instr st))
    -> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st)))
-> Container (ViewsSet' instr st)
forall m.
Monoid m =>
(Element (ViewsSet' instr st) -> m) -> ViewsSet' instr st -> m
forall t.
(t -> [Element t])
-> (t -> Bool)
-> (forall b. (Element t -> b -> b) -> b -> t -> b)
-> (forall b. (b -> Element t -> b) -> b -> t -> b)
-> (forall b. (b -> Element t -> b) -> b -> t -> b)
-> (t -> Int)
-> (Eq (Element t) => Element t -> t -> Bool)
-> (forall m. Monoid m => (Element t -> m) -> t -> m)
-> (Monoid (Element t) => t -> Element t)
-> (forall b. (Element t -> b -> b) -> b -> t -> b)
-> (Eq (Element t) => Element t -> t -> Bool)
-> ((Element t -> Bool) -> t -> Bool)
-> ((Element t -> Bool) -> t -> Bool)
-> ((Element t ~ Bool) => t -> Bool)
-> ((Element t ~ Bool) => t -> Bool)
-> ((Element t -> Bool) -> t -> Maybe (Element t))
-> (t -> Maybe (Element t))
-> (Ord (Element t) => t -> Maybe (Element t))
-> (Ord (Element t) => t -> Maybe (Element t))
-> ((Element t -> Element t -> Element t)
    -> t -> Maybe (Element t))
-> ((Element t -> Element t -> Element t)
    -> t -> Maybe (Element t))
-> Container t
forall b.
(b -> Element (ViewsSet' instr st) -> b)
-> b -> ViewsSet' instr st -> b
forall b.
(Element (ViewsSet' instr st) -> b -> b)
-> b -> ViewsSet' instr st -> b
forall (instr :: [T] -> [T] -> *) (st :: T).
Eq (Element (ViewsSet' instr st)) =>
Element (ViewsSet' instr st) -> ViewsSet' instr st -> Bool
forall (instr :: [T] -> [T] -> *) (st :: T).
Ord (Element (ViewsSet' instr st)) =>
ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
forall (instr :: [T] -> [T] -> *) (st :: T).
Monoid (Element (ViewsSet' instr st)) =>
ViewsSet' instr st -> Element (ViewsSet' instr st)
forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st) ~ Bool) =>
ViewsSet' instr st -> Bool
forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> Bool
forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> Int
forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> [Element (ViewsSet' instr st)]
forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st) -> Bool)
-> ViewsSet' instr st -> Bool
forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st) -> Bool)
-> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st)
 -> Element (ViewsSet' instr st) -> Element (ViewsSet' instr st))
-> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
forall (instr :: [T] -> [T] -> *) (st :: T) m.
Monoid m =>
(Element (ViewsSet' instr st) -> m) -> ViewsSet' instr st -> m
forall (instr :: [T] -> [T] -> *) (st :: T) b.
(b -> Element (ViewsSet' instr st) -> b)
-> b -> ViewsSet' instr st -> b
forall (instr :: [T] -> [T] -> *) (st :: T) b.
(Element (ViewsSet' instr st) -> b -> b)
-> b -> ViewsSet' instr st -> b
safeFoldl1 :: (Element (ViewsSet' instr st)
 -> Element (ViewsSet' instr st) -> Element (ViewsSet' instr st))
-> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
$csafeFoldl1 :: forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st)
 -> Element (ViewsSet' instr st) -> Element (ViewsSet' instr st))
-> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
safeFoldr1 :: (Element (ViewsSet' instr st)
 -> Element (ViewsSet' instr st) -> Element (ViewsSet' instr st))
-> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
$csafeFoldr1 :: forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st)
 -> Element (ViewsSet' instr st) -> Element (ViewsSet' instr st))
-> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
safeMinimum :: Ord (Element (ViewsSet' instr st)) =>
ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
$csafeMinimum :: forall (instr :: [T] -> [T] -> *) (st :: T).
Ord (Element (ViewsSet' instr st)) =>
ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
safeMaximum :: Ord (Element (ViewsSet' instr st)) =>
ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
$csafeMaximum :: forall (instr :: [T] -> [T] -> *) (st :: T).
Ord (Element (ViewsSet' instr st)) =>
ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
safeHead :: ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
$csafeHead :: forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
find :: (Element (ViewsSet' instr st) -> Bool)
-> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
$cfind :: forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st) -> Bool)
-> ViewsSet' instr st -> Maybe (Element (ViewsSet' instr st))
or :: (Element (ViewsSet' instr st) ~ Bool) => ViewsSet' instr st -> Bool
$cor :: forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st) ~ Bool) =>
ViewsSet' instr st -> Bool
and :: (Element (ViewsSet' instr st) ~ Bool) => ViewsSet' instr st -> Bool
$cand :: forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st) ~ Bool) =>
ViewsSet' instr st -> Bool
any :: (Element (ViewsSet' instr st) -> Bool)
-> ViewsSet' instr st -> Bool
$cany :: forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st) -> Bool)
-> ViewsSet' instr st -> Bool
all :: (Element (ViewsSet' instr st) -> Bool)
-> ViewsSet' instr st -> Bool
$call :: forall (instr :: [T] -> [T] -> *) (st :: T).
(Element (ViewsSet' instr st) -> Bool)
-> ViewsSet' instr st -> Bool
notElem :: Eq (Element (ViewsSet' instr st)) =>
Element (ViewsSet' instr st) -> ViewsSet' instr st -> Bool
$cnotElem :: forall (instr :: [T] -> [T] -> *) (st :: T).
Eq (Element (ViewsSet' instr st)) =>
Element (ViewsSet' instr st) -> ViewsSet' instr st -> Bool
foldr' :: forall b.
(Element (ViewsSet' instr st) -> b -> b)
-> b -> ViewsSet' instr st -> b
$cfoldr' :: forall (instr :: [T] -> [T] -> *) (st :: T) b.
(Element (ViewsSet' instr st) -> b -> b)
-> b -> ViewsSet' instr st -> b
fold :: Monoid (Element (ViewsSet' instr st)) =>
ViewsSet' instr st -> Element (ViewsSet' instr st)
$cfold :: forall (instr :: [T] -> [T] -> *) (st :: T).
Monoid (Element (ViewsSet' instr st)) =>
ViewsSet' instr st -> Element (ViewsSet' instr st)
foldMap :: forall m.
Monoid m =>
(Element (ViewsSet' instr st) -> m) -> ViewsSet' instr st -> m
$cfoldMap :: forall (instr :: [T] -> [T] -> *) (st :: T) m.
Monoid m =>
(Element (ViewsSet' instr st) -> m) -> ViewsSet' instr st -> m
elem :: Eq (Element (ViewsSet' instr st)) =>
Element (ViewsSet' instr st) -> ViewsSet' instr st -> Bool
$celem :: forall (instr :: [T] -> [T] -> *) (st :: T).
Eq (Element (ViewsSet' instr st)) =>
Element (ViewsSet' instr st) -> ViewsSet' instr st -> Bool
length :: ViewsSet' instr st -> Int
$clength :: forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> Int
foldl' :: forall b.
(b -> Element (ViewsSet' instr st) -> b)
-> b -> ViewsSet' instr st -> b
$cfoldl' :: forall (instr :: [T] -> [T] -> *) (st :: T) b.
(b -> Element (ViewsSet' instr st) -> b)
-> b -> ViewsSet' instr st -> b
foldl :: forall b.
(b -> Element (ViewsSet' instr st) -> b)
-> b -> ViewsSet' instr st -> b
$cfoldl :: forall (instr :: [T] -> [T] -> *) (st :: T) b.
(b -> Element (ViewsSet' instr st) -> b)
-> b -> ViewsSet' instr st -> b
foldr :: forall b.
(Element (ViewsSet' instr st) -> b -> b)
-> b -> ViewsSet' instr st -> b
$cfoldr :: forall (instr :: [T] -> [T] -> *) (st :: T) b.
(Element (ViewsSet' instr st) -> b -> b)
-> b -> ViewsSet' instr st -> b
null :: ViewsSet' instr st -> Bool
$cnull :: forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> Bool
toList :: ViewsSet' instr st -> [Element (ViewsSet' instr st)]
$ctoList :: forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> [Element (ViewsSet' instr st)]
Container)

deriving stock instance
  (forall i o. Show (instr i o)) =>
  Show (ViewsSet' instr st)
deriving stock instance
  (forall i o. Eq (instr i o)) =>
  Eq (ViewsSet' instr st)
instance
  (forall i o. NFData (instr i o)) =>
  NFData (ViewsSet' instr st) where
    rnf :: ViewsSet' instr st -> ()
rnf (ViewsSet Seq (SomeView' instr st)
vs) = Seq (SomeView' instr st) -> ()
forall a. NFData a => a -> ()
rnf Seq (SomeView' instr st)
vs

pattern ViewsSet :: Seq (SomeView' instr st) -> ViewsSet' instr st
pattern $mViewsSet :: forall {r} {instr :: [T] -> [T] -> *} {st :: T}.
ViewsSet' instr st
-> (Seq (SomeView' instr st) -> r) -> (Void# -> r) -> r
ViewsSet views <- UnsafeViewsSet views
{-# COMPLETE ViewsSet #-}

pattern ViewsList :: [SomeView' instr st] -> ViewsSet' instr st
pattern $mViewsList :: forall {r} {instr :: [T] -> [T] -> *} {st :: T}.
ViewsSet' instr st
-> ([SomeView' instr st] -> r) -> (Void# -> r) -> r
ViewsList views <- ViewsSet (toList -> views)
{-# COMPLETE ViewsList #-}

-- | Errors possible when constructing 'ViewsSet\''.
data ViewsSetError
  = DuplicatedViewName ViewName
  deriving stock (Int -> ViewsSetError -> ShowS
[ViewsSetError] -> ShowS
ViewsSetError -> String
(Int -> ViewsSetError -> ShowS)
-> (ViewsSetError -> String)
-> ([ViewsSetError] -> ShowS)
-> Show ViewsSetError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewsSetError] -> ShowS
$cshowList :: [ViewsSetError] -> ShowS
show :: ViewsSetError -> String
$cshow :: ViewsSetError -> String
showsPrec :: Int -> ViewsSetError -> ShowS
$cshowsPrec :: Int -> ViewsSetError -> ShowS
Show, ViewsSetError -> ViewsSetError -> Bool
(ViewsSetError -> ViewsSetError -> Bool)
-> (ViewsSetError -> ViewsSetError -> Bool) -> Eq ViewsSetError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewsSetError -> ViewsSetError -> Bool
$c/= :: ViewsSetError -> ViewsSetError -> Bool
== :: ViewsSetError -> ViewsSetError -> Bool
$c== :: ViewsSetError -> ViewsSetError -> Bool
Eq)

instance Buildable ViewsSetError where
  build :: ViewsSetError -> Builder
build = \case
    DuplicatedViewName ViewName
name -> Builder
"Duplicated view name '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ViewName
name ViewName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"'"

-- | Construct views set.
mkViewsSet :: [SomeView' instr st] -> Either ViewsSetError (ViewsSet' instr st)
mkViewsSet :: forall (instr :: [T] -> [T] -> *) (st :: T).
[SomeView' instr st] -> Either ViewsSetError (ViewsSet' instr st)
mkViewsSet [SomeView' instr st]
views = do
  [[ViewName]]
-> (Element [[ViewName]] -> Either ViewsSetError ())
-> Either ViewsSetError ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ ([ViewName] -> [[ViewName]]
forall a. Eq a => [a] -> [[a]]
group ([ViewName] -> [[ViewName]])
-> ([ViewName] -> [ViewName]) -> [ViewName] -> [[ViewName]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ViewName] -> [ViewName]
forall a. Ord a => [a] -> [a]
sort ([ViewName] -> [[ViewName]]) -> [ViewName] -> [[ViewName]]
forall a b. (a -> b) -> a -> b
$ (SomeView' instr st -> ViewName)
-> [SomeView' instr st] -> [ViewName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SomeView' instr st -> ViewName
forall (instr :: [T] -> [T] -> *) (st :: T).
SomeView' instr st -> ViewName
someViewName [SomeView' instr st]
views) ((Element [[ViewName]] -> Either ViewsSetError ())
 -> Either ViewsSetError ())
-> (Element [[ViewName]] -> Either ViewsSetError ())
-> Either ViewsSetError ()
forall a b. (a -> b) -> a -> b
$ \case
    ViewName
name : ViewName
_ : [ViewName]
_ -> ViewsSetError -> Either ViewsSetError ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ViewsSetError -> Either ViewsSetError ())
-> ViewsSetError -> Either ViewsSetError ()
forall a b. (a -> b) -> a -> b
$ ViewName -> ViewsSetError
DuplicatedViewName ViewName
name
    ViewName
_ : [ViewName]
_ -> Either ViewsSetError ()
forall (f :: * -> *). Applicative f => f ()
pass
    [] -> Text -> Either ViewsSetError ()
forall a. HasCallStack => Text -> a
error Text
"impossible"
  pure ((Seq $ SomeView' instr st) -> ViewsSet' instr st
forall (instr :: [T] -> [T] -> *) (st :: T).
(Seq $ SomeView' instr st) -> ViewsSet' instr st
UnsafeViewsSet ((Seq $ SomeView' instr st) -> ViewsSet' instr st)
-> (Seq $ SomeView' instr st) -> ViewsSet' instr st
forall a b. (a -> b) -> a -> b
$ [ListElement (Seq $ SomeView' instr st)]
-> Seq $ SomeView' instr st
forall l. (FromList l, FromListC l) => [ListElement l] -> l
fromList [ListElement (Seq $ SomeView' instr st)]
[SomeView' instr st]
views)

-- | No views.
emptyViewsSet :: ViewsSet' instr st
emptyViewsSet :: forall (instr :: [T] -> [T] -> *) (st :: T). ViewsSet' instr st
emptyViewsSet = (Seq $ SomeView' instr st) -> ViewsSet' instr st
forall (instr :: [T] -> [T] -> *) (st :: T).
(Seq $ SomeView' instr st) -> ViewsSet' instr st
UnsafeViewsSet Seq $ SomeView' instr st
forall a. Monoid a => a
mempty

-- | Add a view to set.
addViewToSet
  :: View' instr arg st ret
  -> ViewsSet' instr st
  -> Either ViewsSetError (ViewsSet' instr st)
addViewToSet :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret
-> ViewsSet' instr st -> Either ViewsSetError (ViewsSet' instr st)
addViewToSet View' instr arg st ret
v ViewsSet' instr st
views = do
  Bool -> Either ViewsSetError () -> Either ViewsSetError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (View' instr arg st ret -> ViewName
forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewName
vName View' instr arg st ret
v Element [ViewName] -> [ViewName] -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`elem` ViewsSet' instr st -> [ViewName]
forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> [ViewName]
viewsSetNames ViewsSet' instr st
views) (Either ViewsSetError () -> Either ViewsSetError ())
-> Either ViewsSetError () -> Either ViewsSetError ()
forall a b. (a -> b) -> a -> b
$
    ViewsSetError -> Either ViewsSetError ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ViewsSetError -> Either ViewsSetError ())
-> ViewsSetError -> Either ViewsSetError ()
forall a b. (a -> b) -> a -> b
$ ViewName -> ViewsSetError
DuplicatedViewName (View' instr arg st ret -> ViewName
forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewName
vName View' instr arg st ret
v)
  return ((Seq $ SomeView' instr st) -> ViewsSet' instr st
forall (instr :: [T] -> [T] -> *) (st :: T).
(Seq $ SomeView' instr st) -> ViewsSet' instr st
UnsafeViewsSet ((Seq $ SomeView' instr st) -> ViewsSet' instr st)
-> (Seq $ SomeView' instr st) -> ViewsSet' instr st
forall a b. (a -> b) -> a -> b
$ ViewsSet' instr st -> Seq $ SomeView' instr st
forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> Seq $ SomeView' instr st
unViewsSet ViewsSet' instr st
views (Seq $ SomeView' instr st)
-> SomeView' instr st -> Seq $ SomeView' instr st
forall a. Seq a -> a -> Seq a
Seq.|> View' instr arg st ret -> SomeView' instr st
forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> SomeView' instr st
SomeView View' instr arg st ret
v)

-- | Find a view in the set.
lookupView :: ViewName -> ViewsSet' instr st -> Maybe (SomeView' instr st)
lookupView :: forall (instr :: [T] -> [T] -> *) (st :: T).
ViewName -> ViewsSet' instr st -> Maybe (SomeView' instr st)
lookupView ViewName
name (ViewsSet Seq (SomeView' instr st)
views) =
  (Element (Seq (SomeView' instr st)) -> Bool)
-> Seq (SomeView' instr st)
-> Maybe (Element (Seq (SomeView' instr st)))
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find (\(SomeView View{ViewCode' instr arg st ret
ViewName
Notes arg
Notes ret
vCode :: ViewCode' instr arg st ret
vReturn :: Notes ret
vArgument :: Notes arg
vName :: ViewName
vCode :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewCode' instr arg st ret
vReturn :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> Notes ret
vArgument :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> Notes arg
vName :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewName
..}) -> ViewName
vName ViewName -> ViewName -> Bool
forall a. Eq a => a -> a -> Bool
== ViewName
name) Seq (SomeView' instr st)
views

-- | Get all taken names in views set.
viewsSetNames :: ViewsSet' instr st -> [ViewName]
viewsSetNames :: forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> [ViewName]
viewsSetNames = (SomeView' instr st -> ViewName)
-> [SomeView' instr st] -> [ViewName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SomeView' instr st -> ViewName
forall (instr :: [T] -> [T] -> *) (st :: T).
SomeView' instr st -> ViewName
someViewName ([SomeView' instr st] -> [ViewName])
-> (ViewsSet' instr st -> [SomeView' instr st])
-> ViewsSet' instr st
-> [ViewName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewsSet' instr st -> [SomeView' instr st]
forall t. Container t => t -> [Element t]
toList

data SomeViewsSet' instr where
  SomeViewsSet :: SingI st => ViewsSet' instr st -> SomeViewsSet' instr

deriving stock instance
  (forall i o. Show (instr i o)) =>
  Show (SomeViewsSet' instr)
instance
  (forall i o. Eq (instr i o)) =>
  Eq (SomeViewsSet' instr) where
    SomeViewsSet ViewsSet' instr st
vs1 == :: SomeViewsSet' instr -> SomeViewsSet' instr -> Bool
== SomeViewsSet ViewsSet' instr st
vs2 = ViewsSet' instr st -> ViewsSet' instr st -> Bool
forall {k} (a1 :: k) (a2 :: k) (t :: k -> *).
(SingI a1, SingI a2, SDecide k, Eq (t a1)) =>
t a1 -> t a2 -> Bool
eqParamSing ViewsSet' instr st
vs1 ViewsSet' instr st
vs2
instance
  (forall i o. NFData (instr i o)) =>
  NFData (SomeViewsSet' instr) where
    rnf :: SomeViewsSet' instr -> ()
rnf (SomeViewsSet ViewsSet' instr st
vs) = ViewsSet' instr st -> ()
forall a. NFData a => a -> ()
rnf ViewsSet' instr st
vs