packages feed

hydrogen-syntax (empty) → 0.5

raw patch · 6 files changed

+236/−0 lines, 6 filesdep +basedep +containersdep +hydrogen-preludesetup-changed

Dependencies added: base, containers, hydrogen-prelude, hydrogen-util, nicify, parsec, uuid

Files

+ CHANGELOG.md view
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hydrogen-syntax.cabal view
@@ -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
+ src/Hydrogen/Syntax/Parser.hs view
@@ -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+
+ src/Hydrogen/Syntax/Types.hs view
@@ -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)+