diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2014 Julian Fleischer + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hydrogen-syntax.cabal b/hydrogen-syntax.cabal new file mode 100644 --- /dev/null +++ b/hydrogen-syntax.cabal @@ -0,0 +1,39 @@ +name: hydrogen-syntax +version: 0.5 +homepage: https://github.com/scravy/hydrogen-syntax +synopsis: Hydrogen Syntax +license: BSD3 +license-file: LICENSE +extra-source-files: CHANGELOG.md +author: Julian Fleischer +maintainer: julfleischer@paypal.com +category: Language +build-type: Simple +cabal-version: >=1.18 + +source-repository head + type: git + location: https://github.com/scravy/hydrogen-syntax + +library + exposed-modules: Hydrogen.Syntax.Parser + , Hydrogen.Syntax.Types + build-depends: base ==4.7.* + , containers ==0.5.* + , hydrogen-prelude ==0.5 + , hydrogen-util ==0.5 + , nicify ==1.1.* + , parsec ==3.1.* + , uuid ==1.3.* + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + default-extensions: CPP + , EmptyCase + , FlexibleContexts + , GADTs + , LambdaCase + , MultiWayIf + , NoImplicitPrelude + , RecordWildCards + , TupleSections diff --git a/src/Hydrogen/Syntax/Parser.hs b/src/Hydrogen/Syntax/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Hydrogen/Syntax/Parser.hs @@ -0,0 +1,140 @@ +module Hydrogen.Syntax.Parser where + +import Hydrogen.Prelude hiding ((<|>), many) +import Hydrogen.Syntax.Types + +import Hydrogen.Util.Parsec hiding (token, tokens) +import Text.Parsec.Char (char, hexDigit, noneOf, oneOf, string) + +tokenize :: String -> Parser String (Tokens Token) +tokenize srcName = either mkError sanitize . runIdentity . runParserT tokens () srcName + where + tokens = many (liftA2 (,) getPosition token) <* eof + + token = choice [ + TIndent <$> indent + , something >>= \x -> choice [ + TString x '\'' <$> chars' '\'' + , TString x '\"' <$> chars' '\"' + , TString x '`' <$> chars' '`' + , TSomething <$> return x + ] + , TString "" '\'' <$> chars '\'' + , TString "" '\"' <$> chars '\"' + , TString "" '`' <$> chars '`' + , const TSpaces <$> many1 (char ' ') + , const TComma <$> char ',' + , const TSemicolon <$> char ';' + , TBraceOpen "" <$> oneOf "([{" + , TBraceClose <$> oneOf ")]}" + ] + + something = many1 (noneOf ("([{)]}\'\"`;, " ++ ['\0' .. '\x1F'])) + + indent = many1 (try (many space >> (nl <|> comment))) *> (length <$> many space) + where + space = char ' ' + nl = string "\n" + comment = string ";;" >> many (noneOf "\n") <* char '\n' + + chars' d = inBetween (char d) (many (try (char '\\' >> char d) <|> noneOf [d])) + + chars d = inBetween (char d) (many (noneOf (d : "\\") <|> escape)) + + inBetween d p = d *> p <* d + + escape = char '\\' >> choice [ + oneOf "\\\'\"?`" + , special <$> oneOf (map fst escapes) + , char 'x' >> (convert <$> count 2 hexDigit) + , char 'u' >> (convert <$> count 4 hexDigit) + , char 'U' >> (convert <$> count 8 hexDigit) -- like Python + ] + where + special = fromJust . flip lookup escapes + escapes = [ + ('0', '\0'), + ('a', '\a'), + ('b', '\b'), + ('f', '\f'), + ('n', '\n'), + ('r', '\r'), + ('t', '\t'), + ('v', '\v') ] + convert str = let [(hex, _)] = readHex str in toEnum hex + + sanitize (t1@(p1, v1) : ts@(_t2@(p2, v2) : tss)) = case (v1, v2) of + + (TSomething k, TBraceOpen _ t) -> sanitize ((p1, TBraceOpen k t) : tss) + + (TString _ _ _, TSomething _) -> Left (p2, []) + (TString _ _ _, TBraceOpen _ _) -> Left (p2, []) + + (TBraceClose _, TSomething _) -> Left (p2, []) + (TBraceClose _, TString _ _ _) -> Left (p2, []) + (TBraceClose _, TBraceOpen _ _) -> Left (p2, []) + + (TBraceOpen _ _, TIndent _) -> sanitize (t1 : tss) + (TBraceOpen _ _, TSpaces) -> sanitize (t1 : tss) + (TBraceOpen _ _, _) -> + fmap ([t1, (p2, TIndent (sourceColumn p2 - 1))] ++) (sanitize ts) + + (TSpaces, _) -> sanitize ts + + (TIndent _, TBraceOpen _ '{') -> sanitize ts + (TIndent _, TBraceClose _) -> sanitize ts + (TIndent _, TSemicolon) -> sanitize ts + + (TSemicolon, TIndent _) -> sanitize (t1 : tss) + + _ -> fmap (t1 :) (sanitize ts) + + sanitize [t@(_, v)] = Right $ case v of + TSpaces -> [] + TIndent _ -> [] + TSemicolon -> [t] + _ -> [t] + + sanitize [] = Right [] + +layout :: Parser (Tokens Token) POPs +layout = either mkError Right . runIdentity . runParserT document () "-" + where + document = many (liftA2 (,) getPosition (someToken 0)) <* eof + + someToken :: Monad m => Int -> ParsecT [(SourcePos, Token)] u m POP + someToken i = choice [ + sourceToken $ \case + + TIndent i' | i' <= i -> Just (Token SomethingT "" ";;") + + TString k '\'' v -> Just (Token AposString k v) + TString k '"' v -> Just (Token QuotString k v) + TString k '`' v -> Just (Token TickString k v) + + TComma -> Just (Token SomethingT "" ",") + TSemicolon -> Just (Token SomethingT "" ";") + TSomething v -> Just (Token SomethingT "" 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 (Block bt k ts) + + ] <* skipMany (sourceToken lineContinuation) + where + lineContinuation = \case TIndent i' | i' > i -> Just () ; _ -> Nothing + +parse :: String -> Parser String POPs +parse srcName = tokenize srcName >+> layout + diff --git a/src/Hydrogen/Syntax/Types.hs b/src/Hydrogen/Syntax/Types.hs new file mode 100644 --- /dev/null +++ b/src/Hydrogen/Syntax/Types.hs @@ -0,0 +1,36 @@ +module Hydrogen.Syntax.Types where + +import Hydrogen.Prelude +import Hydrogen.Util.Parsec + +type POPs = [(SourcePos, POP)] + +data POP where + Token :: TokenType -> [Char] -> [Char] -> POP + Block :: BlockType -> [Char] -> POPs -> POP + deriving (Show) + +data TokenType where + AposString :: TokenType + QuotString :: TokenType + TickString :: TokenType + SomethingT :: TokenType + deriving (Eq, Show) + +data BlockType where + Grouping :: BlockType + Brackets :: BlockType + Mustache :: BlockType + deriving (Eq, Show) + +data Token where + TComma :: Token + TSemicolon :: Token + TBraceOpen :: [Char] -> Char -> Token + TBraceClose :: Char -> Token + TSomething :: [Char] -> Token + TIndent :: Int -> Token + TSpaces :: Token + TString :: [Char] -> Char -> [Char] -> Token + deriving (Show) +