hsx (empty) → 0.4

raw patch · 5 files changed

+252/−0 lines, 5 filesdep +basedep +haskell-src-extsdep +mtlsetup-changed

Dependencies added: base, haskell-src-exts, mtl

Files

HSX/XMLGenerator.hs +114/−0
LICENSE +28/−0
Setup.hs +2/−0
Trhsx.hs +58/−0
hsx.cabal +50/−0

+ HSX/XMLGenerator.hs view

@@ -0,0 +1,114 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  HSX.XMLGenerator
+-- Copyright   :  (c) Niklas Broberg 2008
+-- License     :  BSD-style (see the file LICENSE.txt)
+-- 
+-- Maintainer  :  Niklas Broberg, nibro@cs.chalmers.se
+-- Stability   :  experimental
+-- Portability :  requires newtype deriving and MPTCs with fundeps
+--
+-- The class and monad transformer that forms the basis of the literal XML
+-- syntax translation. Literal tags will be translated into functions of
+-- the GenerateXML class, and any instantiating monads with associated XML
+-- types can benefit from that syntax.
+-----------------------------------------------------------------------------
+module HSX.XMLGenerator where
+
+import Control.Monad.Trans
+import Control.Monad (liftM)
+
+----------------------------------------------
+-- General XML Generation
+
+-- | The monad transformer that allows a monad to generate XML values.
+newtype XMLGenT m a = XMLGenT (m a)
+  deriving (Monad, Functor, MonadIO)
+
+-- | un-lift.
+unXMLGenT :: XMLGenT m a -> m a
+unXMLGenT   (XMLGenT ma) =  ma
+
+instance MonadTrans XMLGenT where
+ lift = XMLGenT
+
+type Name = (Maybe String, String)
+
+-- | Generate XML values in some XMLGenerator monad.
+class Monad m => XMLGenerator m where
+ type XML m
+ type Child m
+ type Attribute m
+ genElement  :: Name -> [XMLGenT m (Attribute m)] -> [XMLGenT m [Child m]] -> XMLGenT m (XML m)
+ genEElement :: Name -> [XMLGenT m (Attribute m)]                          -> XMLGenT m (XML m)
+ genEElement n ats = genElement n ats []
+
+-- | Embed values as child nodes of an XML element. The parent type will be clear
+-- from the context so it is not mentioned.
+class EmbedAsChild a c where
+ asChild :: a -> c
+
+-- | Similarly embed values as attributes of an XML element.
+class EmbedAsAttr a at where
+ asAttr :: a -> at
+
+data Attr n a = n := a
+  deriving Show
+
+
+-------------------------------------
+-- Setting attributes
+
+-- | Set attributes on XML elements
+class XMLGenerator m => SetAttr m t where
+ setAttr :: t -> XMLGenT m (Attribute m) -> XMLGenT m (XML m)
+ setAll  :: t -> XMLGenT m [Attribute m] -> XMLGenT m (XML m)
+ setAttr t v = setAll t $ liftM return v
+
+(<@), set :: (SetAttr m t, EmbedAsAttr a (XMLGenT m (Attribute m))) => t -> a -> XMLGenT m (XML m)
+set xml at = setAttr xml (asAttr at)
+(<@) = set
+
+(<<@) :: (SetAttr m t, EmbedAsAttr a (XMLGenT m (Attribute m))) => t -> [a] -> XMLGenT m (XML m)
+xml <<@ ats = setAll xml (mapM asAttr ats)
+
+-------------------------------------
+-- Appending children
+
+class XMLGenerator m => AppendChild m t where
+ appChild :: t -> XMLGenT m (Child m) -> XMLGenT m (XML m)
+ appAll   :: t -> XMLGenT m [Child m] -> XMLGenT m (XML m)
+ appChild t c = appAll t $ liftM return c
+
+(<:), app :: (AppendChild m t, EmbedAsChild c (XMLGenT m [Child m])) => t -> c -> XMLGenT m (XML m)
+app t c = appAll t $ asChild c
+(<:) = app
+
+-------------------------------------
+-- Names
+
+-- | Names can be simple or qualified with a domain. We want to conveniently
+-- use both simple strings or pairs wherever a Name is expected.
+class Show n => IsName n where
+ toName :: n -> Name
+
+-- | Names can represent names, of course.
+instance IsName Name where
+ toName = id
+
+-- | Strings can represent names, meaning a simple name with no domain.
+instance IsName String where
+ toName s = (Nothing, s)
+
+-- | Pairs of strings can represent names, meaning a name qualified with a domain.
+instance IsName (String, String) where
+ toName (ns, s) = (Just ns, s)
+
+
+-- literally lifted from the HList library
+class TypeCast   a b   | a -> b, b -> a      where typeCast   :: a -> b
+class TypeCast'  t a b | t a -> b, t b -> a  where typeCast'  :: t->a->b
+class TypeCast'' t a b | t a -> b, t b -> a  where typeCast'' :: t->a->b
+instance TypeCast'  () a b => TypeCast a b   where typeCast x = typeCast' () x
+instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''
+instance TypeCast'' () a a where typeCast'' _ x  = x

+ LICENSE view

@@ -0,0 +1,28 @@+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ Trhsx.hs view

@@ -0,0 +1,58 @@+module Main where++import Language.Haskell.Exts++import HSX.Transform++import System.Environment (getArgs)+import Data.List (isPrefixOf)++checkParse :: ParseResult b -> b+checkParse p = case p of+                  ParseOk m -> m+                  ParseFailed loc s -> error $ "Error at " ++ show loc ++ ":\n" ++ s++transformFile :: String -> String -> String -> IO ()+transformFile origfile infile outfile = do+        f <- readFile infile+        let fm = process origfile f+        writeFile outfile fm++testFile :: String -> IO ()+testFile file = do+        f <- readFile file+        putStrLn $ process file f++testTransform :: String -> IO ()+testTransform file = do+        f <- readFile file+        putStrLn $ show $ transform $ checkParse $ parse file f++testPretty :: String -> IO ()+testPretty file = do+        f <- readFile file+        putStrLn $ prettyPrint $ checkParse $ parse file f++testParse :: String -> IO ()+testParse file = do+        f <- readFile file+        putStrLn $ show $ parse file f++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++process :: FilePath -> String -> String+process fp fc = prettyPrintWithMode (defaultMode {linePragmas=True}) $+                 transform $ checkParse $ parse fp fc++parse :: String -> String -> ParseResult HsModule+parse fn fc = parseModuleWithMode (ParseMode fn) fcuc+  where fcuc= unlines $ filter (not . isPrefixOf "#") $ lines fc++usageString :: String+usageString = "Usage: trhsx <infile> [<outfile>]"

+ hsx.cabal view

@@ -0,0 +1,50 @@+Name:                   hsx+Version:                0.4+License:                BSD3+License-File:           LICENSE+Author:                 Niklas Broberg, Joel Björnson+Maintainer:             Niklas Broberg <nibro@cs.chalmers.se>++Stability:              Experimental+Category:               Language+Synopsis:               HSX (Haskell Source with XML) allows literal XML syntax to be used in Haskell source code.+Description:            HSX (Haskell Source with XML) allows literal XML syntax to be used in Haskell source code.+			+			The trhsx preprocessor translates .hsx source files into ordinary .hs files. Literal+			XML syntax is translated into function calls for creating XML values of the appropriate+			forms.+			+			trhsx transforms literal XML syntax into a series of function calls. Any project+			can make use of the syntax by providing definitions for those functions, and the+			XML values produced will be of the types specified. This works for any types, since+			trhsx doesn't make any assumptions, or inserts any information depending on types.+			+			XMLGenerator defines a few typeclasses that together cover the functions injected by the+			preprocessor. A project that uses these classes to provide the semantics for the injected+			syntax will be able to use any functions written in terms of these, allowing better code +			reusability than if each project defines its own semantics for the XML syntax. Also, the classes+			makes it possible to use the literal syntax at different types within the same module.+			Achieving that is not as simple as it may seem, but the XMLGenerator module provides all the+			necessary machinery.+			+Homepage:               http://code.google.com/hsp++Build-Depends:          base>3, mtl, haskell-src-exts>=0.3.2+Build-Type:             Simple+Tested-With:            GHC==6.8.3++Exposed-Modules:        HSX.XMLGenerator++GHC-Options:            -Wall+Extensions:             MultiParamTypeClasses,+                        FunctionalDependencies,+                        OverlappingInstances,+                        UndecidableInstances,+                        FlexibleInstances,+                        GeneralizedNewtypeDeriving,+                        TypeFamilies,+                        TypeSynonymInstances,+                        FlexibleContexts++Executable:             trhsx+Main-Is:                Trhsx.hs