Fix Token reading.
authorJulien Moutinho <julm+tct@autogeree.net>
Mon, 23 Oct 2017 14:22:41 +0000 (16:22 +0200)
committerJulien Moutinho <julm+tct@autogeree.net>
Mon, 23 Oct 2017 14:22:41 +0000 (16:22 +0200)
Language/TCT/Read/Token.hs

index c82f9e262a19b28878f2d1b304337630f75a87d4..11d47edfd22855d4204d4c1bf6b176750dd5b6a2 100644 (file)
@@ -28,10 +28,14 @@ import qualified Data.Text.Lazy.Builder as Builder
 import qualified Text.Megaparsec as P
 
 import Language.TCT.Token
-import Language.TCT.Elem
+import Language.TCT.Elem      -- hiding (dbg)
 import Language.TCT.Read.Elem -- hiding (pdbg)
 
--- pdbg m p = P.dbg m p
+{-
+import Debug.Trace (trace)
+dbg m x = trace (m <> ": " <> show x) x
+pdbg m p = P.dbg m p
+-}
 
 textOf :: Buildable a => a -> Text
 textOf = TL.toStrict . Builder.toLazyText . build
@@ -75,7 +79,7 @@ closeUnpaired acc (p,tn) = dbg "closeUnpaired" $
                 Just i -> Tokens $ TokenTag tag <| TokenPlain t' <| ts
                        where (tag,t') = Text.splitAt i t
                 Nothing -> Tokens $ TokenTag t <| ts
-        _ -> tokens [TokenPlain $ fst $ pairBorders p mempty] <> tn <> acc
+        _ -> tokens [TokenPlain $ fst $ pairBorders p $ tokens [TokenPlain ""]] <> tn <> acc
        where
        isTagChar c =
                Char.isAlphaNum c ||
@@ -153,14 +157,24 @@ p_PunctOrSym = P.satisfy $ \c ->
 p_PairCloseWhite :: Parser e s [Lexeme]
 p_PairCloseWhite = pdbg "PairCloseWhite" $
        (\c b -> mconcat c <> b)
-        <$> P.some (P.try p_PairClose <|> pure . LexemePunctOrSym <$> p_PunctOrSym)
+        <$> P.some (
+               P.try p_ElemOpen <|>
+               P.try p_ElemClose <|>
+               P.try p_PairClose <|>
+               pure . LexemePunctOrSym <$> p_PunctOrSym
+        )
         <*> ((pure <$> p_White) <|> P.eof $> [])
 
 p_PairWhiteOpen :: Bool -> Parser e s [Lexeme]
 p_PairWhiteOpen isBOF = pdbg "PairWhiteOpen" $
        (\b o -> b <> mconcat o)
         <$> (if isBOF then return [] else pure <$> p_White)
-        <*> P.some (P.try p_PairOpen <|> pure . LexemePunctOrSym <$> p_PunctOrSym)
+        <*> P.some (
+               P.try p_ElemOpen <|>
+               P.try p_ElemClose <|>
+               P.try p_PairOpen <|>
+               pure . LexemePunctOrSym <$> p_PunctOrSym
+        )
 
 p_PairCloseBorder :: Parser e s [Lexeme]
 p_PairCloseBorder = pdbg "PairCloseBorder" $
@@ -174,12 +188,9 @@ p_PairCloseBorder = pdbg "PairCloseBorder" $
                         , P.try p_ElemClose
                         , do
                                c <- p_PunctOrSym
-                               case l_PairClose c of
+                               case l_PairOpen c <|> l_PairClose c of
                                 Just l -> return [l]
-                                Nothing ->
-                                       case l_PairOpenAndClose LexemePairOpen c <|> l_PairOpen c of
-                                        Nothing -> return [LexemePunctOrSym c]
-                                        _ -> fail ""
+                                Nothing -> fail ""
                         ])
        p1 =
                (\c b -> mconcat c <> [LexemePunctOrSym b])
@@ -312,11 +323,10 @@ p_Escape =
         <*> P.satisfy Char.isPrint
 
 p_ElemSingle :: Parser e s [Lexeme]
-p_ElemSingle = pdbg "ElemOpen" $
+p_ElemSingle = pdbg "ElemSingle" $
        (\e as ->
                [ LexemePairOpen  $ PairElem e as
-               , LexemeToken     $ Tokens mempty
-                 -- NOTE: encode that it's the same Elem for open and close
+               , LexemeToken     $ mempty
                , LexemePairClose $ PairElem e [] ])
         <$  P.char '<'
         <*> p_Word
@@ -328,9 +338,11 @@ p_ElemOpen = pdbg "ElemOpen" $
        (\e as oc ->
                case oc of
                 True  -> [ LexemePairOpen  $ PairElem e as
-                         , LexemeToken     $ Tokens mempty
+                         , LexemeToken     $ mempty
                          , LexemePairClose $ PairElem e [] ]
-                False -> [LexemePairOpen $ PairElem e as])
+                False -> [ LexemePairOpen  $ PairElem e as
+                         , LexemeToken     $ tokens [TokenPlain ""]
+                         ])
         <$  P.char '<'
         <*> p_Word
         <*> p_Attrs