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(..), join)
  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 readTCT ::
  33  FilePath -> TL.Text ->
  34  Either ErrorRead (Trees (Cell Node))
  35 readTCT inp txt = do
  36         trs <- P.runParser (p_Trees <* P.eof) inp txt
  37         join <$> traverse (go $ NodeHeader HeaderDash)
  38          (debug0 "readTCT" trs)
  39         where
  40         go :: Node -> Tree (Cell Node) -> Either ErrorRead (Trees (Cell Node))
  41         go parent t@(Tree c@(Cell bn en nod) ts) =
  42                 case nod of
  43                  NodeLower{} -> Right $ pure t
  44                  -- NOTE: preserve NodeText ""
  45                  NodeText n | TL.null n -> Right $ pure t
  46                  NodeText n ->
  47                         case parent of
  48                          NodeHeader HeaderBar{}      -> Right $ pure t
  49                          NodeHeader HeaderEqual{}    -> Right $ pure t
  50                          NodeHeader HeaderDashDash{} -> Right $ pure t
  51                          _ -> do
  52                                 toks <- parseTokens <$> parseLexemes inp (Cell bn en n)
  53                                 Right $ toks
  54                  _ -> pure . Tree c . join <$> traverse (go nod') ts
  55                         where
  56                         -- NOTE: skip parent 'Node's whose semantic does not change 'NodeText'
  57                         nod' = case nod of
  58                          NodePara -> parent
  59                          _ -> nod
  60
  61 -- * Type 'ErrorRead'
  62 type ErrorRead = P.ParseError (P.Token TL.Text) (P.ErrorFancy Void)