From 48bc05972b003785c635eb497cfc44105d24e8f8 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Thu, 25 Jul 2024 07:56:12 +0300
Subject: [PATCH] wip

---
 hbs2-cli/lib/HBS2/CLI/Run/Internal.hs | 18 +++++++++++++++++-
 hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs |  4 ++--
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs
index a9e974f6..df7ffb83 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs
@@ -21,6 +21,7 @@ pattern StringLike e <- (stringLike -> Just e)
 pattern StringLikeList :: forall {c} . [String] -> [Syntax c]
 pattern StringLikeList e <- (stringLikeList -> e)
 
+
 class Display a where
   display :: MonadIO m => a -> m ()
 
@@ -88,6 +89,17 @@ stringLike = \case
 stringLikeList :: [Syntax c] -> [String]
 stringLikeList syn = [ stringLike s | s <- syn ] & takeWhile isJust & catMaybes
 
+pattern PairList :: [Syntax c] -> [Syntax c]
+pattern PairList es <- (pairList -> es)
+
+pairList :: [Syntax c ] -> [Syntax c]
+pairList syn = [ isPair s | s <- syn ] & takeWhile isJust & catMaybes
+
+isPair :: Syntax c -> Maybe (Syntax c)
+isPair = \case
+  e@(ListVal [_,_]) -> Just e
+  _ -> Nothing
+
 data BindAction c ( m :: Type -> Type)  =
     BindLambda { fromLambda :: [Syntax c] -> RunM c m (Syntax c) }
   | BindValue  (Syntax c)
@@ -279,8 +291,12 @@ internalEntries = do
         pure $ mkList @C es
 
     entry $ bindMatch "dict" $ \case
-      es -> do
+      [a, b] -> do
+        pure $ mkForm "dict" [ mkList [a, b] ]
+      PairList es -> do
         pure $ mkForm "dict" es
+      _ -> do
+        throwIO (BadFormException @C nil)
 
     entry $ bindMatch "lambda" $ \case
       [a, b] -> do
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs b/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs
index a9ef0e94..d5946449 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs
@@ -111,8 +111,8 @@ metaDataEntries = do
 
     case syn of
 
-      (ListVal o : what : args) -> do
-        error $ show $ pretty o <+> pretty what <+> pretty args
+      args -> do
+        error $ show $ pretty args
 
       (LitStrVal s : meta) -> do
         let lbs = fromString (Text.unpack s) :: LBS.ByteString