hsx 0.6.2 → 0.7.0

raw patch · 4 files changed

+54/−23 lines, 4 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• hsx.cabal +18/−10
• src/HSX/Transform.hs +9/−6
• src/HSX/XMLGenerator.hs +8/−0
• src/Trhsx.hs +19/−7

@@ -1,8 +1,8 @@ Name:                   hsx-Version:                0.6.2+Version:                0.7.0 License:                BSD3 License-File:           LICENSE-Author:                 Niklas Broberg, Joel Björnson+Author:                 Niklas Broberg, Joel Bjornson Maintainer:             Niklas Broberg <nibro@cs.chalmers.se>  Stability:              Experimental@@ -29,15 +29,23 @@                          Homepage:               http://code.google.com/hsp -Build-Depends:          base>3 && <5, mtl, haskell-src-exts >= 1.5, utf8-string-Build-Type:             Simple Tested-With:            GHC==6.8.3, GHC==6.10.1 Cabal-Version: 		>= 1.2.3+Build-Type:             Simple -Hs-Source-Dirs: src-Exposed-Modules:        HSX.XMLGenerator, HSX.Transform+Flag base4 -Extensions:             MultiParamTypeClasses,+Library+  Build-depends:	mtl, haskell-src-exts >= 1.5, utf8-string+  if flag(base4)+    Build-depends:      base >= 4 && < 5+    cpp-options:        -DBASE4+  else+    Build-depends:      base >= 3 && < 4+  Hs-Source-Dirs: 	src+  Exposed-Modules:      HSX.XMLGenerator, HSX.Transform++  Extensions:           MultiParamTypeClasses,                         FunctionalDependencies,                         OverlappingInstances,                         UndecidableInstances,@@ -49,6 +57,6 @@                         TypeOperators,                         CPP -Executable:             trhsx-Main-Is:                Trhsx.hs-Hs-Source-Dirs:         src+Executable trhsx+  Main-Is:                Trhsx.hs+  Hs-Source-Dirs:         src

@@ -1260,7 +1260,7 @@         flatten S = consFun                         -- (:)         flatten (L mt) =             let f = flatten mt-                r = paren $ metaMap f+                r = paren $ metaMap [f]              in paren $ foldCompFun `metaComp` r    -- (foldComp . (map $flatten))         flatten (E mt1 mt2) =             let f1 = flatten mt1@@ -1782,18 +1782,18 @@ -- meta-level functions, i.e. functions that represent functions, -- and that take arguments representing arguments... whew! -metaReturn, metaConst, metaMap, metaUnzip :: Exp -> Exp+metaReturn, metaConst, metaUnzip :: Exp -> Exp metaReturn e = metaFunction "return" [e] metaConst e  = metaFunction "const" [e]-metaMap e    = metaFunction "map" [e] metaUnzip e  = metaFunction "unzip" [e]  metaEither, metaMaybe :: Exp -> Exp -> Exp metaEither e1 e2 = metaFunction "either" [e1,e2] metaMaybe e1 e2 = metaFunction "maybe" [e1,e2] -metaConcat :: [Exp] -> Exp+metaConcat, metaMap :: [Exp] -> Exp metaConcat es = metaFunction "concat" [listE es]+metaMap       = metaFunction "map"  metaAppend :: Exp -> Exp -> Exp metaAppend l1 l2 = infixApp l1 appendOp l2@@ -1870,7 +1870,7 @@ metaGenElement name ats mat cs =     let (d,n) = xNameParts name         ne    = tuple [metaMkMaybe $ fmap strE d, strE n]-        m = maybe id (\x y -> paren $ y `metaAppend` (metaMap $ metaAsAttr x)) mat+        m = maybe id (\x y -> paren $ y `metaAppend` (metaMap [argAsAttr, x])) mat         attrs = m $ listE $ map metaAsAttr ats      in metaFunction "genElement" [ne, attrs, listE cs] @@ -1879,13 +1879,16 @@ metaGenEElement name ats mat =     let (d,n) = xNameParts name         ne    = tuple [metaMkMaybe $ fmap strE d, strE n]-        m = maybe id (\x y -> paren $ y `metaAppend` (metaMap $ metaAsAttr x)) mat+        m = maybe id (\x y -> paren $ y `metaAppend` (metaMap [argAsAttr, x])) mat         attrs = m $ listE $ map metaAsAttr ats      in metaFunction "genEElement" [ne, attrs]  -- | Create an attribute by applying the overloaded @asAttr@ metaAsAttr :: Exp -> Exp metaAsAttr e = metaFunction "asAttr" [e]++argAsAttr :: Exp+argAsAttr = var $ name "asAttr"  -- | Create a property from an attribute and a value. metaAssign :: Exp -> Exp -> Exp

@@ -32,6 +32,10 @@ unXMLGenT :: XMLGenT m a -> m a
 unXMLGenT   (XMLGenT ma) =  ma
 
+-- | map the inner monad
+mapXMLGenT :: (m a -> n b) -> XMLGenT m a -> XMLGenT n b
+mapXMLGenT f (XMLGenT m) = XMLGenT (f m)
+
 instance MonadTrans XMLGenT where
  lift = XMLGenT
 
@@ -46,6 +50,7 @@  genEElement :: Name -> [XMLGenT m [Attribute m]]                          -> XMLGenT m (XML m)
  genEElement n ats = genElement n ats []
  xmlToChild :: XML m -> Child m
+ pcdataToChild :: String -> Child m
 
 -- | Type synonyms to avoid writing out the XMLnGenT all the time
 type GenXML m           = XMLGenT m (XML m)
@@ -77,6 +82,9 @@ instance (XMLGen m) => EmbedAsChild m (XML m) where
 #endif
  asChild = return . return . xmlToChild
+
+instance XMLGen m => EmbedAsChild m String where
+ asChild = return . return . pcdataToChild
 
 
 -- | Similarly embed values as attributes of an XML element.

@@ -1,17 +1,28 @@+{-# LANGUAGE CPP #-} module Main where  import Language.Haskell.Exts hiding (parse) import Prelude hiding (readFile, writeFile)-import System.IO.UTF8 (readFile, writeFile)+import System.IO.UTF8 (readFile, writeFile,hPutStrLn)+import System.IO (stderr) import HSX.Transform+import System.Exit (exitFailure)  import System.Environment (getArgs) import Data.List (isPrefixOf)+#ifdef BASE4+import Control.OldException (handle,ErrorCall(..))+#else+import Control.Exception (handle,ErrorCall(..))+#endif+  +showSrcLoc (SrcLoc {srcFilename=srcFilename,srcLine=srcLine,srcColumn=srcColumn}) = +  srcFilename ++ ":" ++ show srcLine ++ ":" ++ show srcColumn  checkParse :: ParseResult b -> b checkParse p = case p of                   ParseOk m -> m-                  ParseFailed loc s -> error $ "Error at " ++ show loc ++ ":\n" ++ s+                  ParseFailed loc s -> error $ showSrcLoc loc ++ ": " ++ s  transformFile :: String -> String -> String -> IO () transformFile origfile infile outfile = do@@ -41,11 +52,12 @@  main :: IO () main = do args <- getArgs-          case args of-           [origfile, infile, outfile] -> transformFile origfile infile outfile-           [infile, outfile] -> transformFile infile infile outfile-           [infile] -> testFile infile-           _ -> putStrLn usageString+          handle (\(ErrorCall text) -> hPutStrLn stderr text >> exitFailure ) $+           case args of+            [origfile, infile, outfile] -> transformFile origfile infile outfile+            [infile, outfile] -> transformFile infile infile outfile+            [infile] -> testFile infile+            _ -> putStrLn usageString  process :: FilePath -> String -> String process fp fc = prettyPrintWithMode (defaultMode {linePragmas=True}) $