bf6 executable + maybe splices support

Makefile

@@ -15,6 +15,7 @@ OUT_FILES := $(RT_FILES:.rt=.out)
 GHC_VERSION := 9.6.6
 BIN_DIR := ./bin
 BINS := \
+	bf6                \
   hbs2               \
   hbs2-peer          \
   hbs2-keyman        \

miscellaneous/fuzzy-parse/src/Data/Text/Fuzzy/SExp.hs

@@ -181,7 +181,7 @@ instance MonadError SExpParseError m => MonadError SExpParseError (SExpM m) wher
 tokenizeSexp :: Text -> [TTok]
 tokenizeSexp txt =  do
   let spec = delims " \r\t" <> comment ";"
-                            <> punct ",`'{}()[]\n"
+                            <> punct "@,`'{}()[]\n"
                             <> sqq
                             <> uw
                             <> esc
@@ -230,7 +230,8 @@ parseTop txt = do
       [List one] -> lift $ S.yield (List one)
       xs    -> lift $ S.yield (List xs)
 
-sexp :: (ForMicroSexp c, MonadError SExpParseError m) => [TTok] -> SExpM m (MicroSexp c, [TTok])
+
+sexp :: forall c m . (ForMicroSexp c, MonadError SExpParseError m) => [TTok] -> SExpM m (MicroSexp c, [TTok])
 sexp s = case s of
   [] -> do
     checkBraces
@@ -248,10 +249,17 @@ sexp s = case s of
     (w, t) <- sexp rest
     pure (List [Symbol "`", w], t)
 
+  (TPunct ',' : TPunct '@' : rest) -> do
+    (w, t) <- sexp rest
+    pure $ (List [Symbol ",@", w], t)
+
   (TPunct ',' : rest) -> do
     (w, t) <- sexp rest
     pure (List [Symbol ",", w], t)
 
+  (TPunct '@' : TText x : rest) -> do
+    sexp (TText ("@" <> x) : rest)
+
   (TPunct '\n' : rest) -> succLno >> sexp rest
 
   (TPunct c : rest) | isSpace c  -> sexp rest

miscellaneous/suckless-conf/bf6/Main.hs

@@ -0,0 +1,52 @@
+{-# Language AllowAmbiguousTypes #-}
+{-# Language UndecidableInstances #-}
+module Main where
+
+import Data.Config.Suckless.Script
+import Data.Config.Suckless.Script.File as SF
+
+import System.Environment
+import System.IO qualified as IO
+import UnliftIO
+
+
+main :: IO ()
+main = do
+
+  cli <- getArgs <&> unlines . fmap unwords . splitForms
+           >>= either (error.show) pure . parseTop
+
+  let dict = makeDict do
+
+        internalEntries
+        SF.entries
+
+        entry $ bindMatch "--help" $ nil_ \case
+          HelpEntryBound what -> helpEntry what
+          [StringLike s]      -> helpList False (Just s)
+          _                   -> helpList False Nothing
+
+        entry $ bindMatch "debug:cli:show" $ nil_ \case
+          _ -> display cli
+
+
+  case cli of
+    [ListVal [SymbolVal "stdin"]] -> do
+      what <- liftIO getContents
+                >>= either (error.show) pure . parseTop
+
+      run dict what >>= eatNil display
+
+    [] -> do
+      eof <- liftIO IO.isEOF
+      if eof then
+        void $ run dict [mkForm  "help" []]
+      else do
+        what <- liftIO getContents
+                  >>= either (error.show) pure . parseTop
+
+        run dict what >>= eatNil display
+
+    _ -> do
+      run dict cli >>= eatNil display
+

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

@@ -610,6 +610,20 @@ evalQQ d0 = \case
 
   other       -> pure other
 
+unsplice :: forall c m . ( IsContext c
+                         , MonadUnliftIO m
+                         , Exception (BadFormException c)
+                         ) => [Syntax c] -> RunM c m [Syntax c]
+unsplice s = u s
+  where
+    u ( ListVal [SymbolVal ",@", e] : es) = unnest <$> eval @c e  <*> u es
+    u ( e : es ) = (e:) <$> u es
+    u [] = pure []
+
+    unnest = \case
+      ListVal es -> mappend es
+      e -> (e :)
+
 eval :: forall c m . ( IsContext c
                      , MonadUnliftIO m
                      , Exception (BadFormException c)
@@ -659,11 +673,14 @@ eval' dict0 syn' = handle (handleForm syn') $ do
       ListVal [ SymbolVal ",", x] -> do
         pure  x
 
+      ListVal [ SymbolVal ",@", x] -> do
+        eval x
+
       ListVal [ SymbolVal "`", ListVal b] -> do
-        mkList <$> mapM (evalQQ dict) b
+        mkList <$> (unsplice b >>= mapM (evalQQ dict))
 
       ListVal [ SymbolVal "quasiquot", ListVal b] -> do
-        mkList <$> mapM (evalQQ dict) b
+        mkList <$> (mapM (evalQQ dict) =<< unsplice b)
 
       ListVal [ SymbolVal "quot", b] -> do
         pure b

miscellaneous/suckless-conf/suckless-conf.cabal

@@ -111,6 +111,20 @@ library
     hs-source-dirs:   lib
     default-language: Haskell2010
 
+
+
+executable bf6
+    import:           shared-properties
+    main-is:          Main.hs
+    -- other-modules:
+    -- other-extensions:
+    build-depends:
+          base, unliftio, suckless-conf
+
+    hs-source-dirs:   bf6
+    default-language: GHC2021
+
+
 test-suite spec
   import:          shared-properties
   type: exitcode-stdio-1.0