diff --git a/hbs2-cli/app/Main.hs b/hbs2-cli/app/Main.hs index eec137a2..a7e79ccb 100644 --- a/hbs2-cli/app/Main.hs +++ b/hbs2-cli/app/Main.hs @@ -1,7 +1,75 @@ +{-# Language AllowAmbiguousTypes #-} +{-# Language UndecidableInstances #-} +{-# Language FunctionalDependencies #-} module Main where +import HBS2.Prelude.Plated +import HBS2.OrDie +import HBS2.CLI + +import Data.Config.Suckless +import System.Environment +import Data.Text qualified as Text +import Data.Text.IO qualified as TIO +import Data.HashMap.Strict (HashMap) +import Data.HashMap.Strict qualified as HM +import Data.Maybe +import Data.Kind +import Control.Monad.State +import Control.Monad.Writer + +import Prettyprinter + + +data BindAction c m = BindAction { getAction :: [Syntax c] -> m (Syntax c) } + +data BindMeta c m = BindMeta + { bindAction :: BindAction c m + , bindName :: Id + , bindDescShort :: Text + } deriving (Generic) + +deriving newtype instance Hashable Id + +class IsContext c => Bindable c a m where + bind :: Id -> a -> [BindMeta c m] + +newtype PM c m = PM { unPM :: [Syntax c] -> m (Syntax c) } + +instance (MonadIO m, IsContext c) => Bindable c (PM c m) m where + bind i (PM f) = [BindMeta (BindAction f) i ""] + +run :: forall c m . (IsContext c, MonadIO m) => [BindMeta c m] -> [Syntax c] -> m () +run meta syn = do + let binds = [ (bindName x,x) | x <- meta ] & HM.fromList + mapM_ (runExpr binds) syn + + where + runExpr b = \case + ListVal (SymbolVal what : args) -> do + args' <- for args $ \a -> runExpr b a + let fn = HM.lookup what b <&> bindAction + case fn of + Just (BindAction e) -> e args' + _ -> error "not matched" + _ -> error "not matched" + +nil = List (noContext @C) [] main :: IO () main = do - print "yay!" + wat <- getContents + >>= either (error.show) pure . parseTop + + let i = execWriter do + tell $ bind "hello" $ PM $ \case + [SymbolVal s] -> print ("hello" <+> pretty s) >> pure nil + [LitStrVal s] -> print ("hello" <+> pretty s) >> pure nil + _ -> pure nil + tell $ bind "fuck" $ PM $ \case + [] -> print "FUCK" >> pure nil + _ -> pure nil + + run i wat + diff --git a/hbs2-cli/hbs2-cli.cabal b/hbs2-cli/hbs2-cli.cabal index bcba3eb2..ba558688 100644 --- a/hbs2-cli/hbs2-cli.cabal +++ b/hbs2-cli/hbs2-cli.cabal @@ -49,6 +49,8 @@ common shared-properties , TupleSections , TypeApplications , TypeFamilies + , PatternSynonyms + , ViewPatterns build-depends: