Language/TCT/Read.hs

   1 module Language.TCT.Read
   2  ( module Language.TCT.Read.Tree
   3  , module Language.TCT.Read.Token
   4  , module Language.TCT.Read.Cell
   5  , module Language.TCT.Read
   6  ) where
   7
   8 import Control.Applicative (Applicative(..))
   9 import Control.Monad (Monad(..))
  10 import Data.Either (Either(..))
  11 import Data.Foldable (Foldable(..))
  12 import Data.Function (($))
  13 import Data.Functor ((<$>))
  14 import Data.Traversable (Traversable(..))
  15 import Data.TreeSeq.Strict (Tree(..), Trees)
  16 import Data.Void (Void)
  17 import System.IO (FilePath)
  18 import qualified Data.Text.Lazy as TL
  19 import qualified Text.Megaparsec as P
  20
  21 import Language.TCT.Debug
  22 import Language.TCT.Tree
  23 import Language.TCT.Cell
  24 import Language.TCT.Read.Cell
  25 import Language.TCT.Read.Tree
  26 import Language.TCT.Read.Token
  27
  28 -- | Parsing is done in two phases:
  29 --
  30 -- 1. indentation-sensitive parsing on 'TL.Text'
  31 -- 2. pair-sensitive parsing on some 'NodeText's resulting of 1.
  32 readTrees ::
  33  FilePath -> TL.Text ->
  34  Either (P.ParseError (P.Token TL.Text) (P.ErrorFancy Void)) (Trees (Cell Node))
  35 readTrees inp txt = do
  36         trs <- P.runParser (p_Trees <* P.eof) inp txt
  37         traverse (go NodeGroup) $ debug0 "readTrees" trs
  38         where
  39         go :: Node -> Tree (Cell Node) ->
  40          Either (P.ParseError (P.Token TL.Text) (P.ErrorFancy Void))
  41                 (Tree (Cell Node))
  42         go parent t@(Tree c@(Cell bn en nod) ts) =
  43                 case nod of
  44                  NodeLower{} -> Right t
  45                  NodeText n ->
  46                         case parent of
  47                          NodeHeader HeaderBar{}   -> Right t
  48                          NodeHeader HeaderEqual{} -> Right t
  49                          _ -> do
  50                                 toks <- parseTokens <$> parseLexemes inp (Cell bn en n)
  51                                 return $
  52                                         case toList toks of
  53                                          [tok] -> tok
  54                                          _ -> Tree (Cell bn en NodeGroup) toks
  55                  _ -> Tree c <$> traverse (go nod) ts