Skip to content
This repository
Browse code

Add 'parseDoc' function

  • Loading branch information...
commit 898cd9f88634011115dded7f0352ff75f34ee16f 1 parent 1aa64bf
Gregory Collins authored June 17, 2010
1  src/Text/Templating/Heist.hs
@@ -97,6 +97,7 @@ module Text.Templating.Heist
97 97
 
98 98
     -- * Misc functions
99 99
   , getDoc
  100
+  , parseDoc
100 101
   , bindStaticTag
101 102
 
102 103
   ) where
95  src/Text/Templating/Heist/Internal.hs
... ...
@@ -1,32 +1,33 @@
  1
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1 2
 {-# LANGUAGE OverloadedStrings #-}
  3
+{-# LANGUAGE PackageImports #-}
2 4
 {-# LANGUAGE ScopedTypeVariables #-}
3  
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4 5
 
5 6
 module Text.Templating.Heist.Internal where
6 7
 
7 8
 ------------------------------------------------------------------------------
8  
-import           Control.Applicative
9  
-import           Control.Exception (SomeException)
10  
-import           Control.Monad.CatchIO
11  
-import           Control.Monad.RWS.Strict
12  
-import qualified Data.Attoparsec.Char8 as AP
13  
-import           Data.ByteString.Char8 (ByteString)
14  
-import qualified Data.ByteString.Char8 as B
15  
-import qualified Data.ByteString.Lazy as L
16  
-import           Data.Either
17  
-import qualified Data.Foldable as F
18  
-import           Data.List
19  
-import qualified Data.Map as Map
20  
-import           Data.Maybe
21  
-import           Prelude hiding (catch)
22  
-import           System.Directory.Tree hiding (name)
23  
-import           System.FilePath
24  
-import           Text.XML.Expat.Format
25  
-import qualified Text.XML.Expat.Tree as X
  9
+import             Control.Applicative
  10
+import             Control.Exception (SomeException)
  11
+import             Control.Monad.CatchIO
  12
+import "monads-fd" Control.Monad.RWS.Strict
  13
+import qualified   Data.Attoparsec.Char8 as AP
  14
+import             Data.ByteString.Char8 (ByteString)
  15
+import qualified   Data.ByteString.Char8 as B
  16
+import qualified   Data.ByteString.Lazy as L
  17
+import             Data.Either
  18
+import qualified   Data.Foldable as F
  19
+import             Data.List
  20
+import qualified   Data.Map as Map
  21
+import             Data.Maybe
  22
+import             Prelude hiding (catch)
  23
+import             System.Directory.Tree hiding (name)
  24
+import             System.FilePath
  25
+import             Text.XML.Expat.Format
  26
+import qualified   Text.XML.Expat.Tree as X
26 27
 
27 28
 ------------------------------------------------------------------------------
28  
-import           Text.Templating.Heist.Constants
29  
-import           Text.Templating.Heist.Types
  29
+import             Text.Templating.Heist.Constants
  30
+import             Text.Templating.Heist.Types
30 31
 
31 32
 
32 33
 ------------------------------------------------------------------------------
@@ -447,29 +448,47 @@ renderTemplate ts name = do
447 448
 -- Template loading
448 449
 ------------------------------------------------------------------------------
449 450
 
450  
--- | Reads an XML document from disk.
451  
-getDoc :: String -> IO (Either String InternalTemplate)
452  
-getDoc f = do
453  
-    bs <- catch (liftM Right $ B.readFile f)
454  
-                (\(e::SomeException) -> return $ Left $ show e)
455  
-    return $ do
456  
-        (doctype, rest) <- liftM extractDoctype bs
457  
-        let wrap b = "<snap:root>\n" `B.append` b `B.append` "\n</snap:root>"
458  
-            toTemplate t = InternalTemplate {
459  
-                _itDoctype = doctype,
460  
-                _itNodes = t
461  
-            }
462  
-        mapRight (toTemplate . X.getChildren) .
463  
-            mapLeft genErrorMsg .
464  
-            X.parse' heistExpatOptions . wrap $ rest
  451
+-- | Turns an in-memory XML/XHTML bytestring into a (doctype,'[Node]') pair.
  452
+parseDoc :: ByteString -> IO (Either String (Maybe ByteString,[Node]))
  453
+parseDoc bs = do
  454
+    let (doctype,rest) = extractDoctype bs
  455
+    let wrap b = B.concat ["<snap:root>\n", b, "\n</snap:root>"]
  456
+
  457
+    return $
  458
+      mapRight (\n -> (doctype,X.getChildren n)) $
  459
+      mapLeft genErrorMsg $
  460
+      X.parse' heistExpatOptions (wrap rest)
  461
+
465 462
   where
466  
-    genErrorMsg (X.XMLParseError str loc) = f ++ " " ++ locMsg loc ++ ": " ++ translate str
  463
+    genErrorMsg (X.XMLParseError str loc) = locMsg loc ++ ": " ++ translate str
  464
+
467 465
     locMsg (X.XMLParseLocation line col _ _) =
468 466
         "(line " ++ show (line-1) ++ ", col " ++ show col ++ ")"
  467
+
469 468
     translate "junk after document element" = "document must have a single root element"
470 469
     translate s = s
471 470
 
472 471
 
  472
+-- | Reads an XML document from disk.
  473
+getDoc :: String -> IO (Either String InternalTemplate)
  474
+getDoc f = do
  475
+    bs <- catch (liftM Right $ B.readFile f)
  476
+                (\(e::SomeException) -> return $ Left $ show e)
  477
+
  478
+    d' <- either (return . Left)
  479
+                 parseDoc
  480
+                 bs
  481
+
  482
+    let d = mapLeft (\s -> f ++ " " ++ s) d'
  483
+
  484
+    return $ either Left
  485
+               (\(doctype, nodes) -> Right $ InternalTemplate {
  486
+                    _itDoctype = doctype,
  487
+                    _itNodes = nodes
  488
+                })
  489
+               d
  490
+
  491
+
473 492
 ------------------------------------------------------------------------------
474 493
 -- | Checks whether the bytestring has a doctype.
475 494
 hasDoctype :: ByteString -> Bool
@@ -482,7 +501,7 @@ hasDoctype bs = "<!DOCTYPE" `B.isPrefixOf` bs
482 501
 extractDoctype :: ByteString -> (Maybe ByteString, ByteString)
483 502
 extractDoctype bs = 
484 503
     if hasDoctype bs
485  
-        then (Just $ B.snoc (B.takeWhile p bs) '>', B.tail $ B.dropWhile p bs)
  504
+        then (Just $ B.snoc (B.takeWhile p bs) '>',B.tail $ B.dropWhile p bs)
486 505
         else (Nothing, bs)
487 506
   where
488 507
     p = (/='>')
34  src/Text/Templating/Heist/Types.hs
... ...
@@ -1,9 +1,10 @@
  1
+{-# LANGUAGE FlexibleInstances #-}
  2
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
  3
+{-# LANGUAGE MultiParamTypeClasses #-}
1 4
 {-# LANGUAGE OverloadedStrings #-}
  5
+{-# LANGUAGE PackageImports #-}
2 6
 {-# LANGUAGE ScopedTypeVariables #-}
3  
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4  
-{-# LANGUAGE FlexibleInstances #-}
5 7
 {-# LANGUAGE UndecidableInstances #-}
6  
-{-# LANGUAGE MultiParamTypeClasses #-}
7 8
 
8 9
 {-|
9 10
 
@@ -21,20 +22,19 @@ liberating us from the unused writer portion of RWST.
21 22
 module Text.Templating.Heist.Types where
22 23
 
23 24
 ------------------------------------------------------------------------------
24  
-import           Control.Applicative
25  
-import           Control.Monad.Cont
26  
-import           Control.Monad.Error
27  
-import           Control.Monad.Reader
28  
-import           Control.Monad.State
29  
-import           Control.Monad.Trans
30  
-import           Data.ByteString.Char8 (ByteString)
31  
-import qualified Data.ByteString.Char8 as B
32  
-import qualified Data.Map as Map
33  
-import           Data.Map (Map)
34  
-import           Data.Monoid
35  
-import           Data.Typeable
36  
-import           Prelude hiding (catch)
37  
-import qualified Text.XML.Expat.Tree as X
  25
+import             Control.Applicative
  26
+import "monads-fd" Control.Monad.Cont
  27
+import "monads-fd" Control.Monad.Error
  28
+import "monads-fd" Control.Monad.Reader
  29
+import "monads-fd" Control.Monad.State
  30
+import "monads-fd" Control.Monad.Trans
  31
+import             Data.ByteString.Char8 (ByteString)
  32
+import qualified   Data.Map as Map
  33
+import             Data.Map (Map)
  34
+import             Data.Monoid
  35
+import             Data.Typeable
  36
+import             Prelude hiding (catch)
  37
+import qualified   Text.XML.Expat.Tree as X
38 38
 
39 39
 
40 40
 ------------------------------------------------------------------------------

0 notes on commit 898cd9f

Please sign in to comment.
Something went wrong with that request. Please try again.