Parser.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module RNC.Parser where

import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..))
import Data.Bool
import Data.Either (Either(..))
import Data.Foldable (Foldable(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.Sequence (ViewL(..))
import Prelude (error)
import Text.Show (Show(..))
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Sequence as Seq
import qualified Text.Megaparsec as P

import Symantic.XML.Document (XML, XMLs)
import qualified Symantic.XML.Document as XML
import qualified Symantic.RNC.Validate as RNC

instance Ord src => P.Stream (XMLs src) where
	type Token  (XMLs src) = XML src
	type Tokens (XMLs src) = XMLs src
	take1_ s =
		case Seq.viewl s of
		 EmptyL -> Nothing
		 t@(XML.Tree XML.Sourced{XML.unSourced=n} _) :< ts
		  | RNC.isIgnoredNode n -> P.take1_ ts
		  | otherwise       -> Just (t, ts)
	takeN_ n s | n <= 0    = Just (mempty, s)
	           | null s    = Nothing
	           | otherwise =
		let (ns,rs) = Seq.splitAt n s in
		let (ko,ok) = Seq.partition (RNC.isIgnoredNode . XML.unSourced . XML.unTree) ns in
		case P.takeN_ (Seq.length ko) rs of
		 Nothing -> Just (ok, rs)
		 Just (ns',rs') -> Just (ok<>ns', rs')
	tokensToChunk _s  = Seq.fromList
	chunkToTokens _s  = toList
	chunkLength _s    = Seq.length
	takeWhile_        = Seq.spanl
	-- | NOTE: unimplemented: useless since each 'XML.Node' is annotated with its 'FileSource'.
	reachOffset       = error "[BUG] P.Stream XMLs: reachOffset is not helpful, please use annotated source locations"
	-- | NOTE: useless since each 'XML.Node' is annotated with its 'FileSource'.
	reachOffsetNoLine = error "[BUG] P.Stream XMLs: reachOffsetNoLine is not helpful, please use annotated source locations"
	showTokens _s toks = List.intercalate ", " $ toList $ showTree <$> toks
		where
		showTree (XML.Tree (XML.Sourced _src a) _ts) =
			case a of
			 XML.NodeElem n     -> "element "<>show n<>""
			 XML.NodeAttr n     -> "attribute "<>show n<>""
			 XML.NodeText _t    -> "text"
			 XML.NodeComment _c -> "comment"
			 XML.NodePI n _t    -> "processing-instruction "<>show n<>""
			 XML.NodeCDATA _t   -> "cdata"