]> Git — Sourcephile - haskell/symantic-xml.git/blob - test/RNC/Parser.hs
Drop the Language prefix in module names
[haskell/symantic-xml.git] / test / RNC / Parser.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE ScopedTypeVariables #-}
4 {-# LANGUAGE TypeFamilies #-}
5 {-# OPTIONS_GHC -fno-warn-orphans #-}
6 module RNC.Parser where
7
8 import Control.Applicative (Applicative(..))
9 import Control.Monad (Monad(..))
10 import Data.Bool
11 import Data.Either (Either(..))
12 import Data.Foldable (Foldable(..))
13 import Data.Function (($), (.))
14 import Data.Functor ((<$>))
15 import Data.Maybe (Maybe(..))
16 import Data.Monoid (Monoid(..))
17 import Data.Ord (Ord(..))
18 import Data.Semigroup (Semigroup(..))
19 import Data.Sequence (ViewL(..))
20 import Prelude (error)
21 import Text.Show (Show(..))
22 import qualified Data.List as List
23 import qualified Data.List.NonEmpty as NonEmpty
24 import qualified Data.Sequence as Seq
25 import qualified Text.Megaparsec as P
26
27 import Symantic.XML.Document (XML, XMLs)
28 import qualified Symantic.XML.Document as XML
29 import qualified Symantic.RNC.Validate as RNC
30
31 instance Ord src => P.Stream (XMLs src) where
32 type Token (XMLs src) = XML src
33 type Tokens (XMLs src) = XMLs src
34 take1_ s =
35 case Seq.viewl s of
36 EmptyL -> Nothing
37 t@(XML.Tree XML.Sourced{XML.unSourced=n} _) :< ts
38 | RNC.isIgnoredNode n -> P.take1_ ts
39 | otherwise -> Just (t, ts)
40 takeN_ n s | n <= 0 = Just (mempty, s)
41 | null s = Nothing
42 | otherwise =
43 let (ns,rs) = Seq.splitAt n s in
44 let (ko,ok) = Seq.partition (RNC.isIgnoredNode . XML.unSourced . XML.unTree) ns in
45 case P.takeN_ (Seq.length ko) rs of
46 Nothing -> Just (ok, rs)
47 Just (ns',rs') -> Just (ok<>ns', rs')
48 tokensToChunk _s = Seq.fromList
49 chunkToTokens _s = toList
50 chunkLength _s = Seq.length
51 takeWhile_ = Seq.spanl
52 -- | NOTE: unimplemented: useless since each 'XML.Node' is annotated with its 'FileSource'.
53 reachOffset = error "[BUG] P.Stream XMLs: reachOffset is not helpful, please use annotated source locations"
54 -- | NOTE: useless since each 'XML.Node' is annotated with its 'FileSource'.
55 reachOffsetNoLine = error "[BUG] P.Stream XMLs: reachOffsetNoLine is not helpful, please use annotated source locations"
56 showTokens _s toks = List.intercalate ", " $ toList $ showTree <$> toks
57 where
58 showTree (XML.Tree (XML.Sourced _src a) _ts) =
59 case a of
60 XML.NodeElem n -> "element "<>show n<>""
61 XML.NodeAttr n -> "attribute "<>show n<>""
62 XML.NodeText _t -> "text"
63 XML.NodeComment _c -> "comment"
64 XML.NodePI n _t -> "processing-instruction "<>show n<>""
65 XML.NodeCDATA _t -> "cdata"