mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
40c3ac6d1a
commit
48bc05972b
|
@ -21,6 +21,7 @@ pattern StringLike e <- (stringLike -> Just e)
|
|||
pattern StringLikeList :: forall {c} . [String] -> [Syntax c]
|
||||
pattern StringLikeList e <- (stringLikeList -> e)
|
||||
|
||||
|
||||
class Display a where
|
||||
display :: MonadIO m => a -> m ()
|
||||
|
||||
|
@ -88,6 +89,17 @@ stringLike = \case
|
|||
stringLikeList :: [Syntax c] -> [String]
|
||||
stringLikeList syn = [ stringLike s | s <- syn ] & takeWhile isJust & catMaybes
|
||||
|
||||
pattern PairList :: [Syntax c] -> [Syntax c]
|
||||
pattern PairList es <- (pairList -> es)
|
||||
|
||||
pairList :: [Syntax c ] -> [Syntax c]
|
||||
pairList syn = [ isPair s | s <- syn ] & takeWhile isJust & catMaybes
|
||||
|
||||
isPair :: Syntax c -> Maybe (Syntax c)
|
||||
isPair = \case
|
||||
e@(ListVal [_,_]) -> Just e
|
||||
_ -> Nothing
|
||||
|
||||
data BindAction c ( m :: Type -> Type) =
|
||||
BindLambda { fromLambda :: [Syntax c] -> RunM c m (Syntax c) }
|
||||
| BindValue (Syntax c)
|
||||
|
@ -279,8 +291,12 @@ internalEntries = do
|
|||
pure $ mkList @C es
|
||||
|
||||
entry $ bindMatch "dict" $ \case
|
||||
es -> do
|
||||
[a, b] -> do
|
||||
pure $ mkForm "dict" [ mkList [a, b] ]
|
||||
PairList es -> do
|
||||
pure $ mkForm "dict" es
|
||||
_ -> do
|
||||
throwIO (BadFormException @C nil)
|
||||
|
||||
entry $ bindMatch "lambda" $ \case
|
||||
[a, b] -> do
|
||||
|
|
|
@ -111,8 +111,8 @@ metaDataEntries = do
|
|||
|
||||
case syn of
|
||||
|
||||
(ListVal o : what : args) -> do
|
||||
error $ show $ pretty o <+> pretty what <+> pretty args
|
||||
args -> do
|
||||
error $ show $ pretty args
|
||||
|
||||
(LitStrVal s : meta) -> do
|
||||
let lbs = fromString (Text.unpack s) :: LBS.ByteString
|
||||
|
|
Loading…
Reference in New Issue