diff --git a/miscellaneous/suckless-conf/examples/templ.ss b/miscellaneous/suckless-conf/examples/templ.ss new file mode 100644 index 00000000..bf3dddb1 --- /dev/null +++ b/miscellaneous/suckless-conf/examples/templ.ss @@ -0,0 +1,29 @@ + +(define h html) +(define (bold . co) [html b [kw] co]) +(define (ul . co) [html :ul [kw] co] ) + +print + + [h body [kw] + [h h1 [kw] "jopa kita" ] + [h br] + + [h p [kw] [bold current time:] (now)] + + [h p [kw] + "МАМА МЫЛА РАМУ А У ПАПЫ ЗАПОЙ" + [h a [kw href http://localhost:5000/] LOCALHOST ] + [h br] + + Тут конечно надо все элементы пробивать пробелами, + и это легко сделать! + + [ul + [map [fn 1 [html li [kw] [car _1] ] ] [grep NIX [env]]] + ] + + ] + ] + + 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 cab504ef..969df429 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs +++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs @@ -48,6 +48,7 @@ import Data.Text (Text) import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (ignore) import Data.Time.Clock.POSIX +import HTMLEntities.Text as Html import GHC.Generics hiding (C) import Prettyprinter import Prettyprinter.Render.Terminal @@ -278,7 +279,7 @@ pattern Lambda a e <- ListVal [SymbolVal "lambda", LambdaArgs a, e] pattern LambdaArgs :: [Id] -> Syntax c pattern LambdaArgs a <- (lambdaArgList -> Just a) - +-- FIXME: detect-invalid-varags lambdaArgList :: Syntax c -> Maybe [Id] lambdaArgList (ListVal a) = sequence argz @@ -472,15 +473,22 @@ applyLambda :: forall c m . ( IsContext c -> RunM c m (Syntax c) applyLambda decl body ev = do - when (length decl /= length ev) do + let (manda,opt) = List.break (== ".") decl + + when (length manda > length ev) do throwIO (ArityMismatch @c nil) tv <- ask d0 <- readTVarIO tv - forM_ (zip decl ev) $ \(n,v) -> do + let (mandatory,optional) = splitAt (length manda) ev + + forM_ (zip decl mandatory) $ \(n,v) -> do bind n v + forM_ (headMay (tailSafe opt)) $ \n -> do + bind n (mkList optional) + e <- eval body atomically $ writeTVar tv d0 @@ -866,14 +874,7 @@ internalEntries = do (concat 1 2 3 4 5) 12345|] - $ entry $ bindMatch "concat" $ \syn -> do - - case syn of - [ListVal xs] -> do - pure $ mkStr ( show $ hcat (fmap fmt xs) ) - - xs -> do - pure $ mkStr ( show $ hcat (fmap fmt xs) ) + $ entry $ bindMatch "concat" (pure . concatTerms hcat) entry $ bindMatch "join" $ \case [ x, ListVal es ] -> do @@ -1570,6 +1571,34 @@ internalEntries = do _ -> pure nil + + entry $ bindMatch "html" $ \syn -> do + + let what = case syn of + (TextLike tag : ListVal a : [ListVal content] ) -> Just (tag,a,content) + (TextLike tag : ListVal a : content ) -> Just (tag,a,content) + [TextLike tag] -> Just (tag,mempty,mempty) + _ -> Nothing + + case what of + + Nothing -> pure nil + + Just (tag, a, content) -> do + + let attrs = [ Text.pack (show $ " " <> pretty k <> "=" <> dquotes (pretty (Html.text v))) + | ListVal [TextLike k, TextLike v] <- a + ] & mconcat + + let body = case concatTerms hsep content of + TextLike s -> s + _ -> mempty + + let wtf = angles (pretty tag <> pretty attrs) <> pretty body <> angles ( "/" <> pretty tag ) + + pure $ mkStr (show wtf) + + parseJson :: forall c . IsContext c => LBS.ByteString -> Syntax c parseJson input = case Aeson.decode @Value input of Just val -> mkSyntax @c val @@ -1646,3 +1675,10 @@ compareLists (x:xs) (y:ys) = EQ -> compareLists xs ys ord -> ord +concatTerms :: forall ann c . IsContext c => ( [Doc ann] -> Doc ann) -> [Syntax c] -> Syntax c +concatTerms s = \case + [ListVal xs] -> do + mkStr @c ( show $ s (fmap fmt xs) ) + + xs -> mkStr ( show $ s (fmap fmt xs) ) + diff --git a/miscellaneous/suckless-conf/suckless-conf.cabal b/miscellaneous/suckless-conf/suckless-conf.cabal index 99239949..f9e42edb 100644 --- a/miscellaneous/suckless-conf/suckless-conf.cabal +++ b/miscellaneous/suckless-conf/suckless-conf.cabal @@ -84,6 +84,7 @@ library , filepattern , fuzzy-parse >= 0.1.3.1 , hashable + , html-entities , ini , interpolatedstring-perl6 , microlens-platform