module Hydrogen.Syntax.Parser.LayoutParser where import Hydrogen.Prelude hiding ((<|>), many) import Hydrogen.Syntax.Types import Hydrogen.Parsing.Char hiding (token, tokens, space) data LayoutConfig a = LayoutConfig { cfgValueTokens :: String -> Maybe a , cfgBlockTransformer :: POP a -> POP a , cfgIndentToken :: String } instance Default (LayoutConfig a) where def = LayoutConfig { cfgValueTokens = const Nothing , cfgBlockTransformer = id , cfgIndentToken = ";;" } parseLayout :: forall a. LayoutConfig a -> Parser (Tokens Token) (POPs a) parseLayout cfg = runTokenParser (many (liftA2 (,) getPosition (someToken 0)) <* eof) where LayoutConfig { .. } = cfg someToken :: Monad m => Int -> ParsecT [(SourcePos, Token)] u m (POP a) someToken i = choice [ sourceToken $ \case TIndent i' | i' <= i -> Just (Token SomethingT "" cfgIndentToken) TString k '\'' v -> Just (Token AposString k v) TString k '"' v -> Just (Token QuotString k v) TString k '`' v -> Just (Token TickString k v) TSpecial v -> Just (Token SomethingT "" [v]) TSomething v | isJust val -> Just (Value (fromJust val) v) | otherwise -> Just (Token SomethingT "" v) where val = cfgValueTokens v _ -> Nothing , do (k, c) <- sourceToken $ \case TBraceOpen k c -> curry Just k c _ -> Nothing i' <- sourceToken $ \(TIndent indent) -> Just indent ts <- many (liftA2 (,) getPosition (someToken i')) bt <- case c of '(' -> sourceToken $ \case TBraceClose ')' -> Just Grouping ; _ -> Nothing '[' -> sourceToken $ \case TBraceClose ']' -> Just Brackets ; _ -> Nothing '{' -> sourceToken $ \case TBraceClose '}' -> Just Mustache ; _ -> Nothing _ -> error "Popsicle!" return (cfgBlockTransformer $ Block bt k ts) ] <* skipMany (sourceToken lineContinuation) where lineContinuation = \case TIndent i' | i' > i -> Just () ; _ -> Nothing