web-routes-hsp-0.24.6.2/0000755000000000000000000000000007346545000013020 5ustar0000000000000000web-routes-hsp-0.24.6.2/LICENSE0000644000000000000000000000275707346545000014040 0ustar0000000000000000Copyright (c)2010, Jeremy Shaw All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * Neither the name of Jeremy Shaw nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT OWNER 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. web-routes-hsp-0.24.6.2/Setup.hs0000644000000000000000000000005607346545000014455 0ustar0000000000000000import Distribution.Simple main = defaultMain web-routes-hsp-0.24.6.2/Web/Routes/0000755000000000000000000000000007346545000015016 5ustar0000000000000000web-routes-hsp-0.24.6.2/Web/Routes/XMLGenT.hs0000644000000000000000000001131307346545000016567 0ustar0000000000000000{-# LANGUAGE CPP, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, TypeFamilies, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Web.Routes.XMLGenT where import Control.Applicative ((<$>)) import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import HSP import Web.Routes.RouteT (RouteT, MonadRoute(..), showURL, URL) instance (Functor m, Monad m) => XMLGen (RouteT url m) where type XMLType (RouteT url m) = XML type StringType (RouteT url m) = TL.Text newtype ChildType (RouteT url m) = UChild { unUChild :: XML } newtype AttributeType (RouteT url m) = UAttr { unUAttr :: Attribute } genElement n attrs children = do attribs <- map unUAttr <$> asAttr attrs childer <- flattenCDATA . map unUChild <$> asChild children return (Element (toName n) attribs childer ) xmlToChild = UChild pcdataToChild = xmlToChild . pcdata flattenCDATA :: [XML] -> [XML] flattenCDATA cxml = case flP cxml [] of [] -> [] [CDATA _ ""] -> [] xs -> xs where flP :: [XML] -> [XML] -> [XML] flP [] bs = reverse bs flP [x] bs = reverse (x:bs) flP (x:y:xs) bs = case (x,y) of (CDATA e1 s1, CDATA e2 s2) | e1 == e2 -> flP (CDATA e1 (s1<>s2) : xs) bs _ -> flP (y:xs) (x:bs) {- instance (Monad m, Functor m) => IsAttrValue (RouteT url m) T.Text where toAttrValue = toAttrValue . T.unpack instance (Monad m, Functor m) => IsAttrValue (RouteT url m) TL.Text where toAttrValue = toAttrValue . TL.unpack -} instance (Functor m, Monad m) => EmbedAsAttr (RouteT url m) Attribute where asAttr = return . (:[]) . UAttr instance (Functor m, Monad m) => EmbedAsAttr (RouteT url m) (Attr String Char) where asAttr (n := c) = asAttr (TL.pack n := TL.singleton c) instance (Functor m, Monad m) => EmbedAsAttr (RouteT url m) (Attr String String) where asAttr (n := str) = asAttr $ MkAttr (toName $ TL.pack n, pAttrVal $ TL.pack str) instance (Functor m, Monad m) => EmbedAsAttr (RouteT url m) (Attr TL.Text Bool) where asAttr (n := True) = asAttr $ MkAttr (toName n, pAttrVal "true") asAttr (n := False) = asAttr $ MkAttr (toName n, pAttrVal "false") instance (Functor m, Monad m) => EmbedAsAttr (RouteT url m) (Attr TL.Text Int) where asAttr (n := i) = asAttr $ MkAttr (toName n, pAttrVal (TL.pack $ show i)) instance (Functor m, Monad m) => EmbedAsAttr (RouteT url m) (Attr TL.Text Integer) where asAttr (n := i) = asAttr $ MkAttr (toName n, pAttrVal (TL.pack $ show i)) instance (Monad m, Functor m, IsName n TL.Text) => (EmbedAsAttr (RouteT url m) (Attr n TL.Text)) where asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal a) instance (Monad m, Functor m, IsName n TL.Text) => (EmbedAsAttr (RouteT url m) (Attr n T.Text)) where asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ TL.fromStrict a) instance (Functor m, Monad m) => EmbedAsAttr (RouteT url m) (Attr TL.Text url) where asAttr (n := u) = do url <- showURL u asAttr $ MkAttr (toName n, pAttrVal (TL.fromStrict url)) instance (Functor m, Monad m) => EmbedAsChild (RouteT url m) Char where asChild = XMLGenT . return . (:[]) . UChild . pcdata . TL.singleton instance (Functor m, Monad m) => EmbedAsChild (RouteT url m) String where asChild = XMLGenT . return . (:[]) . UChild . pcdata . TL.pack instance (Monad m, Functor m) => (EmbedAsChild (RouteT url m) TL.Text) where asChild = XMLGenT . return . (:[]) . UChild . pcdata instance (Monad m, Functor m) => (EmbedAsChild (RouteT url m) T.Text) where asChild = asChild . TL.fromStrict instance (Functor m, Monad m) => EmbedAsChild (RouteT url m) XML where asChild = XMLGenT . return . (:[]) . UChild instance (Functor m, Monad m) => EmbedAsChild (RouteT url m) () where asChild () = return [] instance (Functor m, Monad m) => AppendChild (RouteT url m) XML where appAll xml children = do chs <- children case xml of CDATA _ _ -> return xml Element n as cs -> return $ Element n as (cs ++ (map unUChild chs)) instance (Functor m, Monad m) => SetAttr (RouteT url m) XML where setAll xml hats = do attrs <- hats case xml of CDATA _ _ -> return xml Element n as cs -> return $ Element n (foldr (:) as (map unUAttr attrs)) cs instance (Functor m, Monad m) => XMLGenerator (RouteT url m) instance (MonadRoute m) => MonadRoute (XMLGenT m) where type URL (XMLGenT m) = URL m askRouteFn = XMLGenT askRouteFn web-routes-hsp-0.24.6.2/web-routes-hsp.cabal0000644000000000000000000000174307346545000016675 0ustar0000000000000000Name: web-routes-hsp Version: 0.24.6.2 License: BSD3 License-File: LICENSE Author: jeremy@seereason.com Maintainer: partners@seereason.com Bug-Reports: http://bugzilla.seereason.com/ Category: Web, Language Synopsis: Adds XMLGenerator instance for RouteT monad Description: The module makes it easy to use type-safe URLs in HSP templates Cabal-Version: >= 1.10 Build-type: Simple tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.1, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC==9.0.2, GHC==9.2.2 Library Default-Language: Haskell2010 Build-Depends: base >= 4 && < 5, hsp >= 0.9 && < 0.11, text >= 0.11 && < 2.1, web-routes >= 0.26 && < 0.28 Exposed-Modules: Web.Routes.XMLGenT source-repository head type: git location: https://github.com/Happstack/web-routes-hsp.git