diff --git a/bf6/hbs23 b/bf6/hbs23 index 6da75d1b..8752f58e 100755 --- a/bf6/hbs23 +++ b/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 cli (cli:split optdef ...)) - (local opts (nth 0 cli)) - (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 optdef + `( [-g 1 GROUPKEY] + [--group-key 1 GROUPKEY] )) - (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:stdin kwa))] - - (display r) - + (hbs2:tree:metadata:file kwa fname) + (hbs2:tree:metadata:stdin kwa))) ) - ) + ( (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) ) ) diff --git a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs b/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs index 342c5d88..a2212884 100644 --- a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs +++ b/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 ] - _ -> Nothing + ListVal es -> do + 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 - throwIO (GroupKeyNotFound 1) + -- notice $ "GK" <+> pretty (isRight gkh) <+> pretty gk + + case (gkh, gk) of + (Right (Just _), Nothing) -> throwIO (GroupKeyNotFound 1) + _ -> none sto <- getStorage diff --git a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs index 37a263e0..b7e3a8ec 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs +++ b/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) - ListVal [StringLike x, LitIntVal n] -> S.yield (x, n) + StringLike x -> + 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 - Just 0 -> S.yield (Left (nil @c)) >> go rest - Just 1 -> S.yield (Left (mkList [w, headDef nil rest])) >> go (drop 1 rest) - Just n' -> do + Nothing -> S.yield (Right w) >> go rest + Just (0,s) -> S.yield (Left (mkList [s, mkBool True])) >> go rest + Just (1,s) -> S.yield (Left (mkList [s, headDef nil rest])) >> go (drop 1 rest) + 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