wip

bf6/hbs23

@@ -5,37 +5,51 @@
 ; # (println (grep (sym "-g") *args))
 
 (match *args
+
   ( (list? [sym? store] ...)
     (begin
-      (local optdef (kw -g 1 --group-key 1))
+      (local optdef
-      (local cli (cli:split optdef ...))
+        `( [-g          1 GROUPKEY]
-      (local opts (nth 0 cli))
+           [--group-key 1 GROUPKEY] ))
-      (local gk1 (lookup:uw --group-key opts))
-      (local gk2 (lookup:uw -g opts))
-      (local gk (car (filter [fn x . [not [nil? x]]] `[,gk1 ,gk2])))
-      (local fname (head (nth 1 cli)))
 
-      (local kwa `[ ,(if gk [list :gk gk] '() )
+      (local split (cli:split optdef ...))
-                  ]
+      (local opts (nth 0 split))
-      )
+      (local args (nth 1 split))
 
-      [local r
+      (local gk (@? GROUPKEY opts))
+      (local fname (head args))
+
+      (local kwa `[ ,(if gk [list :gk gk] '() ) ])
+
+      ; (display kwa)
+
+      (display
         (if fname
-          (hbs2:tree:metadata:file  kwa fname)
+          (hbs2:tree:metadata:file kwa fname)
-          (hbs2:tree:metadata:stdin kwa))]
+          (hbs2:tree:metadata:stdin kwa)))
-
-      (display r)
-
     )
-
   )
 
+
   ( (list? [sym? cat] ...)
     (begin
       (println "FUCKING CAT" space ...))
 
   )
 
+  ( (list? [sym? keyring] [sym? new] ...)
+      (begin
+
+        (local optdef `( [-n       1 NUM]
+                         [--number 1 NUM]
+                       ))
+
+        (local opts (nth 0 (cli:split optdef ...)))
+        ;  (println opts)
+        (print (hbs2:keyring:new (@? NUM opts)))
+      )
+  )
+
   ( _  (--help) )
 )
 

hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs

@@ -248,17 +248,27 @@ file-name: "qqq.txt"
     _ -> throwIO (BadFormException @c nil)
 
 
-groupKeyFromSyntax :: Syntax c -> Maybe HashRef
+groupKeyFromSyntax :: Syntax c -> Either (Syntax c) (Maybe HashRef)
 groupKeyFromSyntax = \case
-  ListVal es -> headMay [ v | ListVal [ TextLike "gk", HashLike v ] <- es ]
+  ListVal es -> do
-  _ -> Nothing
+    let mbGk = headMay [ z | z@(ListVal [ TextLike "gk", v ]) <- es ]
+
+    case mbGk of
+      Just (ListVal [ TextLike "gk", HashLike v]) -> Right (Just v)
+      Just w@(ListVal [ TextLike "gk", v]) -> Left w
+      _ -> Right Nothing
+
+  _ -> Right Nothing
 
 loadGroupKeyFromSyntax :: ( ForMetadata c m )
                        => Syntax c
                        -> RunM c m (Maybe (GroupKey 'Symm 'HBS2Basic))
 
 loadGroupKeyFromSyntax syn = runMaybeT do
-  hash <- groupKeyFromSyntax syn & toMPlus
+  hash <- case groupKeyFromSyntax syn of
+             Right w -> toMPlus w
+             Left e -> throwIO (BadFormException e)
+
   toMPlus =<< lift (loadGroupKey hash)
 
 metadataFromSyntax :: Syntax c -> HashMap Text Text
@@ -278,8 +288,11 @@ doCreateMetadataTree meta0 syn getLbs = do
 
   gk <- loadGroupKeyFromSyntax syn
 
-  when (isJust gkh && isNothing gk) do
+  -- notice $ "GK" <+> pretty (isRight gkh) <+> pretty gk
-    throwIO (GroupKeyNotFound 1)
+
+  case (gkh, gk) of
+    (Right (Just _), Nothing) -> throwIO (GroupKeyNotFound 1)
+    _ -> none
 
   sto <- getStorage
 

miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs

@@ -1410,6 +1410,8 @@ internalEntries = do
       [k, ListVal es ] -> pure $ headDef nil [ r | r@(ListVal (w:_)) <- es, k == w ]
       _ -> throwIO (BadFormException @c nil)
 
+
+
     --TODO: integral sum
 
     entry $ bindMatch "upper" $ \case
@@ -1524,6 +1526,8 @@ internalEntries = do
 
       _ -> throwIO (BadFormException @c nil)
 
+    entry $ bindAlias "@?" "lookup:uw"
+
     entry $ bindMatch "lookup" $ \case
       [k, ListVal es ] -> do
         let val = headDef nil [ mkList rest | ListVal (w:rest) <- es, k == w ]
@@ -2155,8 +2159,15 @@ internalEntries = do
 
           opts <- Map.fromList <$> S.toList_ do
              for_ p $ \case
-               StringLike x -> S.yield (x, 0)
+               StringLike x ->
-               ListVal [StringLike x, LitIntVal n] -> S.yield (x, n)
+                 S.yield (x, (0, mkSym x))
+
+               ListVal [StringLike x, LitIntVal n] ->
+                 S.yield (x, (n, mkSym @c x))
+
+               ListVal [StringLike x, LitIntVal n, StringLike alias] ->
+                 S.yield (x, (n, mkSym @c alias))
+
                _ -> pure ()
 
           -- error $ show opts
@@ -2166,12 +2177,12 @@ internalEntries = do
 
             ( w@(StringLike piece) : rest ) -> do
               case Map.lookup piece opts of
-                Nothing     -> S.yield  (Right w) >> go rest
+                Nothing     -> S.yield (Right w) >> go rest
-                Just 0 -> S.yield (Left (nil @c)) >> go rest
+                Just (0,s)  -> S.yield (Left (mkList [s, mkBool True])) >> go rest
-                Just 1 -> S.yield (Left (mkList [w, headDef nil rest])) >> go (drop 1 rest)
+                Just (1,s)  -> S.yield (Left (mkList [s, headDef nil rest])) >> go (drop 1 rest)
-                Just n' -> do
+                Just (n',s) -> do
                   let n = fromIntegral n'
-                  S.yield (Left (mkList [w, mkList (take n rest)]))
+                  S.yield (Left (mkList [s, mkList (take n rest)]))
                   go (drop n rest)
 
             ( w : rest ) -> do