From ac12723dd130df6c6318430240642fffde7462c6 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Mon, 3 Feb 2025 07:58:53 +0300 Subject: [PATCH] suckless, css dsl --- miscellaneous/suckless-conf/examples/css.ss | 14 ++++ miscellaneous/suckless-conf/examples/page.ss | 78 +++++++++++++++++++ .../Data/Config/Suckless/Script/Internal.hs | 59 ++++++++++---- 3 files changed, 135 insertions(+), 16 deletions(-) create mode 100644 miscellaneous/suckless-conf/examples/css.ss create mode 100644 miscellaneous/suckless-conf/examples/page.ss diff --git a/miscellaneous/suckless-conf/examples/css.ss b/miscellaneous/suckless-conf/examples/css.ss new file mode 100644 index 00000000..812b74ab --- /dev/null +++ b/miscellaneous/suckless-conf/examples/css.ss @@ -0,0 +1,14 @@ +print [join chr:lf + + [css body [kw font-family sans-serif margin 40px]] + [css table [kw border-collapse [sym (unwords collapse width 100%)]]] + + [css (list td th) [kw border [sym (unwords 1px solid #ccc)] + padding 8px + text-align left]] + + [css th [kw background-color #f2f2f2]] + [css .che [kw margin-right 8px]] + +] + diff --git a/miscellaneous/suckless-conf/examples/page.ss b/miscellaneous/suckless-conf/examples/page.ss new file mode 100644 index 00000000..f2d40846 --- /dev/null +++ b/miscellaneous/suckless-conf/examples/page.ss @@ -0,0 +1,78 @@ + +[define source [json:file miscellaneous/fuzzy-parse/nix/pkgs.json]] + +; iterate println source + +print +[html :html [kw] + [html :head [kw] + [html :title [kw] "Suckless HTML Page"] + [html :meta [kw :charset "UTF-8"]] + [html :style [kw] + [css body [kw font-family sans-serif margin 40px]] + [css table [kw border-collapse "collapse width 100%"]] + + [css (list td th) [kw border "1px solid #ccc" + padding 8px + text-align left]] + + [css th [kw background-color #f2f2f2]] + [css .che [kw margin-right 8px]] + ] + ] + + [html :body [kw] + [html :h1 [kw] "Пример страницы"] + [html :h2 [kw] "Сделано на Suckless Script"] + + [html :p [kw] "Это пример страницы, созданной в `hbs2`."] + + [html :form [kw action "#" method "POST"] + [html :label [kw for "cb1"] + [html :input [kw :type checkbox name :checkbox1 :id cb1 :class che]] + "Согласен с условиями" + ] + [html :br] + [html :input [kw :type text :name username :placeholder "Введите имя"]] + [html :br] + [html :input [kw :type submit :value "Отправить"]] + ] + + [html :br] + + [html :p [kw] + "Этот текст с " + [html :b [kw] "жирным"] + ", " + [html :i [kw] "курсивом"] + " и " + [html :u [kw] "подчёркнутым"] + " стилями." + ] + + [html :br] + + [html :table [kw] + [html :thead [kw] + [html :tr [kw] + [html [kw] :td] + [html [kw] :td] + ] + ] + + [html :tbody [kw] + [map [fn 1 [html :tr [kw] [html :th [kw] [car _1]] + [html :td [kw] [nth 1 _1]] ] ] source] + ] + ] + + [html :br] + + [html :p [kw] + Подробнее читайте на + [html :a [kw href "http://example.com"] нашем сайте] + "." + ] + ] +] + 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 471dce9a..c43d84d1 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs +++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs @@ -304,8 +304,8 @@ pairList syn = [ isPair s | s <- syn ] & takeWhile isJust & catMaybes optlist :: IsContext c => [Syntax c] -> [(Id, Syntax c)] optlist = reverse . go [] where - go acc ( SymbolVal i : b : rest ) = go ((i, b) : acc) rest - go acc [ SymbolVal i ] = (i, nil) : acc + go acc ( TextLike i : b : rest ) = go ((Id i, b) : acc) rest + go acc [ TextLike i ] = (Id i, nil) : acc go acc _ = acc @@ -880,11 +880,13 @@ internalEntries = do $ entry $ bindMatch "concat" (pure . concatTerms hcat) - entry $ bindMatch "join" $ \case - [ x, ListVal es ] -> do - let xs = List.intersperse x es - pure $ mkStr ( show $ hcat (fmap fmt xs) ) + let mkJoin x es = do + let xs = List.intersperse x es + pure $ mkStr ( show $ hcat (fmap fmt xs) ) + entry $ bindMatch "join" $ \case + [ x, ListVal es ] -> mkJoin x es + (x : es ) -> mkJoin x es _ -> throwIO (BadFormException @C nil) brief "creates a list of elements" @@ -1037,13 +1039,6 @@ internalEntries = do _ -> throwIO (BadFormException @c nil) - entry $ bindMatch "join" $ \case - TextLikeList (x:xs) -> - pure $ mkStr $ Text.intercalate x xs - - _ -> throwIO (BadFormException @c nil) - - entry $ bindMatch "filter" $ \case [pred, ListVal xs] -> do filtered <- flip filterM xs $ \x -> do @@ -1170,6 +1165,11 @@ internalEntries = do [ TextLike x ] -> pure $ mkList [ mkSym y | y <- Text.words x ] _ -> pure nil + entry $ bindMatch "unwords" $ \case + [ ListVal (TextLikeList xs) ] -> pure $ mkStr (Text.unwords xs) + ( TextLikeList xs) -> pure $ mkStr (Text.unwords xs) + _ -> pure $ mkStr "" + entry $ bindMatch "lines" $ \case [ TextLike x ] -> pure $ mkList [ mkSym y | y <- Text.lines x ] _ -> pure nil @@ -1641,15 +1641,35 @@ internalEntries = do [ StringLike p ] -> lift do what <- S.toList_ $ dirEntries p $ \e -> do let r = case e of - EntryFile what -> mkList @c [mkSym what, mkSym "file" ] - EntryDir what -> mkList @c [ mkSym what, mkSym "dir" ] - EntryOther what -> mkList @c [ mkSym what,mkSym "other" ] + EntryFile what -> mkList @c [mkSym what, mkSym "file" ] + EntryDir what -> mkList @c [mkSym what, mkSym "dir" ] + EntryOther what -> mkList @c [mkSym what, mkSym "other" ] S.yield r pure True pure $ mkList what _ -> throwIO $ BadFormException @c nil + + entry $ bindMatch "css" $ \case + [ sel, ListVal kwa ] -> do + + let se = case sel of + ListVal es -> asSym $ concatTerms hcat $ List.intersperse (mkSym ",") es + TextLike s -> pretty $ mkSym @c s + other -> pretty $ mkSym @c (show $ pretty other) + + let body = braces $ hcat $ punctuate " " + [ pretty k <> ":" <+> pretty v <> semi + | ListVal [TextLike k, v] <- kwa + ] + + let css = se <+> body + + pure $ mkStr (show css) + + _ -> pure nil + entry $ bindMatch "html" $ \syn -> do let what = case syn of @@ -1761,3 +1781,10 @@ concatTerms s = \case xs -> mkStr ( show $ s (fmap fmt xs) ) + +asSym :: forall ann c . IsContext c => Syntax c -> Doc ann +asSym = \case + TextLike s -> pretty (mkSym @c s) + other -> pretty other + +