gdritter repos nml / a4e5bcf
Initial commit Getty Ritter 10 years ago
7 changed file(s) with 303 addition(s) and 0 deletion(s). Collapse all Expand all
+79
-0
Data/NML/Parse.hs less more
1 {-# LANGUAGE OverloadedStrings, RecordWildCards #-}
2
3 module Data.NML.Parse (NMLPair(..), NMLElem(..), parseNML) where
4
5 import Control.Applicative
6 import Data.Attoparsec.Text
7 import Data.Char (isAlpha,isNumber)
8 import Data.Text (Text)
9 import qualified Data.Text as T
10 import Data.Text.Encoding (decodeUtf8)
11 import Data.Word (Word8)
12 import Prelude hiding (takeWhile)
13
14 data NMLPair = NMLPair
15 { pName :: Text
16 , pAttrs :: [NMLPair]
17 , pElems :: [NMLElem]
18 } deriving (Eq, Show)
19
20 data NMLElem
21 = EEntity Text
22 | EPair NMLPair
23 | EText Text
24 deriving (Eq, Show)
25
26 parseNML :: Text -> Either String NMLPair
27 parseNML = parseOnly prElement
28
29 ----
30
31 isNameStartChar :: Char -> Bool
32 isNameStartChar = inClass ":_A-Za-z"
33
34 isNameChar :: Char -> Bool
35 isNameChar = inClass "-:_A-Za-z.0-9"
36
37 prName :: Parser Text
38 prName = do
39 c <- satisfy isNameStartChar
40 cs <- many (satisfy isNameChar)
41 return (T.pack (c:cs))
42
43 ----
44
45 prElement :: Parser NMLPair
46 prElement = do
47 string "<"
48 pName <- prName
49 skipSpace
50 pAttrs <- many (prElement <* skipSpace)
51 prFinish pName pAttrs <|> prElems pName pAttrs
52
53 prEElement :: Parser NMLElem
54 prEElement = fmap EPair prElement
55
56 prFinish :: Text -> [NMLPair] -> Parser NMLPair
57 prFinish pName pAttrs = do
58 string ">"
59 return (NMLPair { .. })
60 where pElems = []
61
62 prElems :: Text -> [NMLPair] -> Parser NMLPair
63 prElems pName pAttrs = do
64 string "|"
65 pElems <- many (prEElement <|> prEntity <|> prText)
66 string ">"
67 return (NMLPair { .. })
68
69 prEntity :: Parser NMLElem
70 prEntity = do
71 string "["
72 en <- takeWhile1 (not . (== ']'))
73 string "]"
74 return (EEntity en)
75
76 prText :: Parser NMLElem
77 prText = do
78 t <- takeWhile1 (not . (inClass "<>|"))
79 return (EText t)
+75
-0
Data/NML/XMLLight.hs less more
1 {-# LANGUAGE RecordWildCards #-}
2
3 -- | Module for converting an internal NML datum to the
4 -- @Text.XML.Light@ module provided by the package @xml@.
5 module Data.NML.XMLLight
6 ( decode
7 , encode
8 , module Text.XML.Light.Types
9 ) where
10
11 import Control.Monad ((>=>))
12 import Data.Text (Text, unpack, pack)
13 import Text.XML.Light.Output (showContent)
14 import Text.XML.Light.Types
15
16 import Data.NML.Parse
17
18 toMaybe :: Either a b -> Maybe b
19 toMaybe (Right x) = Just x
20 toMaybe _ = Nothing
21
22 -- | Parse raw text to Content
23 decode :: Text -> Maybe Content
24 decode = toMaybe . (parseNML >=> toPair)
25
26 -- | Convert Content to NML
27 encode :: Content -> Text
28 encode = pack . showContent
29
30 -- | Take an NML @<x|y>@ pair to an XML node datum
31 toPair :: NMLPair -> Either String Content
32 toPair NMLPair { .. } = do
33 elName <- toName pName
34 elAttribs <- mapM toAttr pAttrs
35 elContent <- mapM toElement pElems
36 let elLine = Nothing
37 return (Elem (Element { .. }))
38
39 -- | Take an NML name to an XML name datum
40 toName :: Text -> Either String QName
41 toName n = return $ QName
42 { qName = unpack n
43 , qURI = Nothing
44 , qPrefix = Nothing
45 }
46
47 -- | Take an NML @<x|y>@ pair to an XML attribute. Note that
48 -- it is not valid for nested pairs to be attributes.
49 toAttr :: NMLPair -> Either String Attr
50 toAttr (NMLPair { pName = nm, pAttrs = [], pElems = [ EText t ] }) = do
51 attrKey <- toName nm
52 let attrVal = unpack t
53 return Attr { .. }
54 toAttr (NMLPair { pName = nm, pAttrs = [], pElems = [] }) = do
55 attrKey <- toName nm
56 let attrVal = ""
57 return Attr { .. }
58 toAttr p@(NMLPair { pAttrs = (_:_)}) =
59 fail ("Attributes can't have their own attributes: " ++ show p)
60 toAttr p =
61 fail ("Attribute values must be raw text: " ++ show p)
62
63 -- | Take an NML element to an XML content node
64 toElement :: NMLElem -> Either String Content
65 toElement (EEntity t) =
66 return $ Text (CData { cdVerbatim = CDataRaw
67 , cdData = "&" ++ unpack t ++ ";"
68 , cdLine = Nothing
69 })
70 toElement (EText t) =
71 return $ Text (CData { cdVerbatim = CDataText
72 , cdData = unpack t
73 , cdLine = Nothing
74 })
75 toElement (EPair p) = toPair p
+58
-0
Data/NML/XMLTypes.hs less more
1 {-# LANGUAGE RecordWildCards #-}
2
3 -- | Module for converting an internal NML datum to the
4 -- @Data.XML.Types@ module provided by the package @xml-types@.
5 module Data.NML.XMLTypes
6 ( decode
7 , module Data.XML.Types
8 ) where
9
10 import Control.Monad ((>=>))
11 import Data.Text (Text)
12 import Data.XML.Types
13
14 import Data.NML.Parse
15
16 toMaybe :: Either a b -> Maybe b
17 toMaybe (Right x) = Just x
18 toMaybe _ = Nothing
19
20 -- | Parse raw text to Content
21 decode :: Text -> Maybe Node
22 decode = toMaybe . (parseNML >=> toPair)
23
24 -- | Take an NML @<x|y>@ pair to an XML node datum
25 toPair :: NMLPair -> Either String Node
26 toPair NMLPair { .. } = do
27 elementName <- toName pName
28 elementAttributes <- mapM toAttr pAttrs
29 elementNodes <- mapM toElement pElems
30 return (NodeElement (Element { .. }))
31
32 -- | Take an NML name to an XML name datum
33 toName :: Text -> Either String Name
34 toName n = return $ Name
35 { nameLocalName = n
36 , nameNamespace = Nothing
37 , namePrefix = Nothing
38 }
39
40 -- | Take an NML @<x|y>@ pair to an XML attribute. Note that
41 -- it is not valid for nested pairs to be attributes.
42 toAttr :: NMLPair -> Either String (Name, [Content])
43 toAttr (NMLPair { pName = nm, pAttrs = [], pElems = [ EText t ] }) = do
44 nm' <- toName nm
45 return (nm', [ContentText t])
46 toAttr (NMLPair { pName = nm, pAttrs = [], pElems = [] }) = do
47 nm' <- toName nm
48 return (nm', [])
49 toAttr p@(NMLPair { pAttrs = (_:_)}) =
50 fail ("Attributes can't have their own attributes: " ++ show p)
51 toAttr p =
52 fail ("Attribute values must be raw text: " ++ show p)
53
54 -- | Take an NML element to an XML content node
55 toElement :: NMLElem -> Either String Node
56 toElement (EEntity t) = return $ NodeContent (ContentEntity t)
57 toElement (EText t) = return $ NodeContent (ContentText t)
58 toElement (EPair p) = toPair p
+39
-0
Data/NML.hs less more
1 -- | NML is a convenient syntax for writing XML documents without
2 -- the excess line-noise while preserving (for the most part) the
3 -- semantics and niceties of XML documents. NML was originally
4 -- proposed by Erik Naggum, and his formulation can be seen at
5 -- <http://www.schnada.de/grapt/eriknaggum-enamel.html#impressum>.
6 --
7 -- This module exports the types 'NMLPair' and 'NMLElem' from
8 -- "Data.NML.Parse", which are strictly more expressive than XML.
9 -- For example, @\<one \<two|three\>\>@ corresponds to the XML fragment
10 -- @\<one two=\"three\"/\>@, but @\<one \<two\<a|b\>|c\>\>@ has no XML
11 -- analogue, as attributes cannot recursively possess attributes. This
12 -- means that functions which render NML to XML generally return an
13 -- @Either@ type, to account for possible failure.
14 --
15 -- Other modules are provided that expose an interface in terms of
16 -- the @xml@ package and the @xml-types@ package at
17 -- "Data.NML.XMLLight" and "Data.NML.XMLTypes", respectively.
18
19 module Data.NML
20 ( encode
21 , decode
22 , module Data.NML.Parse
23 ) where
24
25 import Data.Text (Text, pack)
26
27 import Data.NML.Parse
28
29 toMaybe :: Either a b -> Maybe b
30 toMaybe (Right x) = Just x
31 toMaybe _ = Nothing
32
33 -- | Parse an NML fragment as an NML Pair
34 decode :: Text -> Maybe NMLPair
35 decode = toMaybe . parseNML
36
37 -- | Convert an NML Pair to an NML fragment
38 encode :: NMLPair -> Text
39 encode = undefined
+30
-0
LICENSE less more
1 Copyright (c) 2014, Getty Ritter
2
3 All rights reserved.
4
5 Redistribution and use in source and binary forms, with or without
6 modification, are permitted provided that the following conditions are met:
7
8 * Redistributions of source code must retain the above copyright
9 notice, this list of conditions and the following disclaimer.
10
11 * Redistributions in binary form must reproduce the above
12 copyright notice, this list of conditions and the following
13 disclaimer in the documentation and/or other materials provided
14 with the distribution.
15
16 * Neither the name of Getty Ritter nor the names of other
17 contributors may be used to endorse or promote products derived
18 from this software without specific prior written permission.
19
20 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+2
-0
Setup.hs less more
1 import Distribution.Simple
2 main = defaultMain
+20
-0
nml.cabal less more
1 name: nml
2 version: 0.1.0.0
3 -- synopsis:
4 -- description:
5 license: BSD3
6 license-file: LICENSE
7 author: Getty Ritter
8 maintainer: gettylefou@gmail.com
9 -- copyright:
10 category: Data
11 build-type: Simple
12 -- extra-source-files:
13 cabal-version: >=1.10
14
15 library
16 exposed-modules: Data.NML, Data.NML.XMLLight, Data.NML.XMLTypes
17 other-modules: Data.NML.Parse
18 -- other-extensions:
19 build-depends: base >=4.6 && <4.7, xml, xml-types, text, attoparsec
20 default-language: Haskell2010