Language/TCT/Read.hs

   1 {-# LANGUAGE TypeFamilies #-}
   2 module Language.TCT.Read
   3  ( module Language.TCT.Read.Tree
   4  , module Language.TCT.Read.Markup
   5  , module Language.TCT.Read
   6  ) where
   7
   8 import Control.Applicative (Applicative(..))
   9 import Data.Char (Char)
  10 import Data.Either (Either)
  11 import Data.Function (($))
  12 import Data.Functor ((<$>))
  13 import Data.Semigroup (Semigroup(..))
  14 import Data.Text (Text)
  15 import Data.Traversable (sequence)
  16 import Data.Tuple (fst, snd)
  17 import Prelude (fromIntegral)
  18 import System.IO (FilePath)
  19 import qualified Text.Megaparsec as P
  20
  21 import Language.TCT.Tree
  22 import Language.TCT.Markup
  23 import Language.TCT.Read.Tree
  24 import Language.TCT.Read.Markup
  25
  26 readTCT :: FilePath -> Text -> Either (P.ParseError (P.Token Text) P.Dec) (TCT (Cell Markup))
  27 readTCT inp txt = do
  28         tct <- P.runParser (p_Trees <* P.eof) inp txt
  29         sequence $ (<$> tct) $ \tr ->
  30                 sequence $ (<$> tr) $ \(Cell pos posEnd t) ->
  31                         Cell pos posEnd <$>
  32                                 P.runParser (do
  33                                         P.setTabWidth $ P.unsafePos $ fromIntegral $ snd pos
  34                                         P.setPosition $ P.SourcePos inp
  35                                          (P.unsafePos $ fromIntegral $ fst pos)
  36                                          (P.unsafePos $ fromIntegral $ snd pos)
  37                                         p_Markup <* P.eof
  38                                  ) inp (StreamCell t)
  39
  40 -- * Type 'StreamCell'
  41 -- | Wrap 'Text' to have a 'P.Stream' instance
  42 -- whose 'P.updatePos' method abuses the tab width state
  43 -- to instead pass the line indent.
  44 -- This in order to report correct 'P.SourcePos'
  45 -- when parsing a 'Cell' containing newlines.
  46 newtype StreamCell = StreamCell Text
  47 instance P.Stream StreamCell where
  48         type Token StreamCell = Char
  49         uncons (StreamCell t) = (StreamCell <$>) <$> P.uncons t
  50         updatePos _s indent apos@(P.SourcePos n l c) ch = (apos, npos)
  51                 where
  52                 u = P.unsafePos 1
  53                 npos =
  54                         case ch of
  55                          '\n' -> P.SourcePos n (l <> u) indent
  56                          _    -> P.SourcePos n l (c <> u)