diff --git a/.travis.yml b/.travis.yml new file mode 100644 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,29 @@ +language: haskell +before_install: +env: + - GHCVER=7.4.2 CABALVER=1.18 HAPPYVER=1.19.4 ALEXVER=3.1.3 + - GHCVER=7.6.3 CABALVER=1.18 HAPPYVER=1.19.4 ALEXVER=3.1.3 + - GHCVER=7.8.4 CABALVER=1.22 HAPPYVER=1.19.4 ALEXVER=3.1.3 + - GHCVER=7.10.1 CABALVER=1.22 HAPPYVER=1.19.4 ALEXVER=3.1.3 + - GHCVER=head CABALVER=head HAPPYVER=1.19.4 ALEXVER=3.1.3 + +matrix: + allow_failures: + - env: GHCVER=7.10.1 CABALVER=1.22 HAPPYVER=1.19.4 ALEXVER=3.1.3 + - env: GHCVER=head CABALVER=head HAPPYVER=1.19.4 ALEXVER=3.1.3 + +before_install: + - travis_retry sudo add-apt-repository -y ppa:hvr/ghc + - travis_retry sudo apt-get update + - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER happy-$HAPPYVER alex-$ALEXVER + - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/happy/$HAPPYVER/bin:/opt/alex/$ALEXVER/bin:$HOME/.cabal/bin:$PATH + - cabal --version + +install: + - travis_retry cabal update + - cabal install --only-dependencies --enable-tests --constraint="Cabal==$CABALVER.*" + +script: + - cabal configure --enable-tests + - cabal build + - cabal test diff --git a/hsx2hs.cabal b/hsx2hs.cabal --- a/hsx2hs.cabal +++ b/hsx2hs.cabal @@ -1,51 +1,53 @@ Name: hsx2hs -Version: 0.13.2 +Version: 0.13.3 License: BSD3 License-File: LICENSE Author: Niklas Broberg, Joel Bjornson -Maintainer: Niklas Broberg +Maintainer: Jeremy Shaw Stability: Experimental Category: Language Synopsis: HSX (Haskell Source with XML) allows literal XML syntax in Haskell source code. Description: HSX (Haskell Source with XML) allows literal XML syntax 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 + 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://hub.darcs.net/nibro/hsx2hs +Homepage: https://github.com/seereason/hsx2hs + Tested-With: GHC==7.6.3, GHC==7.8.2 Cabal-Version: >= 1.6 Build-Type: Simple +Extra-source-files: .travis.yml source-repository head - type: darcs - location: http://hub.darcs.net/nibro/hsx2hs + type: git + location: https://github.com/seereason/hsx2hs Flag base4 Library Build-depends: mtl >= 2.0 && < 2.3, - haskell-src-exts >= 1.14 && < 1.16, + haskell-src-exts >= 1.16 && < 1.17, haskell-src-meta >= 0.6 && < 0.7, template-haskell >= 2.7 && < 2.10, - utf8-string == 0.3.* + bytestring, + utf8-string >= 0.3 && < 1.1 if flag(base4) Build-depends: base >= 4 && < 5 diff --git a/src/Language/Haskell/HSX/Transform.hs b/src/Language/Haskell/HSX/Transform.hs --- a/src/Language/Haskell/HSX/Transform.hs +++ b/src/Language/Haskell/HSX/Transform.hs @@ -84,7 +84,7 @@ let (decls', (harp, hsx)) = runHsxM $ mapM transformDecl decls -- We may need to add an import for Match.hs that defines the matcher monad imps1 = if harp - then (:) $ ImportDecl s match_mod True False Nothing + then (:) $ ImportDecl s match_mod True False False Nothing (Just match_qual_mod) Nothing else id @@ -104,7 +104,7 @@ transformDecl d = case d of -- Pattern binds can contain regular patterns in the pattern being bound -- as well as on the right-hand side and in declarations in a where clause - PatBind srcloc pat mty rhs decls -> do + PatBind srcloc pat rhs decls -> do -- Preserve semantics of irrefutable regular patterns by postponing -- their evaluation to a let-expression on the right-hand side let ([pat'], rnpss) = unzip $ renameIrrPats [pat] @@ -120,14 +120,14 @@ return $ BDecls $ decls'' ++ ds' _ -> error "Cannot bind implicit parameters in the \ \ \'where\' clause of a function using regular patterns." - return $ PatBind srcloc pat'' mty rhs' decls' + return $ PatBind srcloc pat'' rhs' decls' -- Function binds can contain regular patterns in their matches FunBind ms -> fmap FunBind $ mapM transformMatch ms -- Instance declarations can contain regular patterns in the -- declarations of functions inside it - InstDecl s c n ts idecls -> - fmap (InstDecl s c n ts) $ mapM transformInstDecl idecls + InstDecl s mo tvbs c n ts idecls -> + fmap (InstDecl s mo tvbs c n ts) $ mapM transformInstDecl idecls -- Class declarations can contain regular patterns in the -- declarations of automatically instantiated functions ClassDecl s c n ns ds cdecls -> @@ -442,7 +442,7 @@ transformLDs k l ds = case ds of [] -> return [] (d:ds) -> case d of - PatBind srcloc pat mty rhs decls -> do + PatBind srcloc pat rhs decls -> do -- We need to transform all pattern bindings in a set of -- declarations in the same context w.r.t. generating fresh -- variable names, since they will all be in scope at the same time. @@ -472,7 +472,7 @@ -- The generated guards, which should be at most one, should be -- added as declarations rather than as guards due to the -- scoping issue described above. - return $ (PatBind srcloc pat' mty rhs' decls') : ags' ++ gs' ++ ds' + return $ (PatBind srcloc pat' rhs' decls') : ags' ++ gs' ++ ds' -- We only need to treat pattern binds separately, other declarations -- can be transformed normally. @@ -570,7 +570,7 @@ ([pat''], attrGuards, guards, decls'') <- transformPatterns srcloc [pat'] -- Transform the right-hand side, and add any generated guards -- and let expressions to it. - rhs' <- mkGAlts srcloc (attrGuards ++ guards) (concat rnpss) rhs + rhs' <- mkRhs srcloc (attrGuards ++ guards) (concat rnpss) rhs -- Transform declarations in the where clause, adding any generated -- declarations to it. decls' <- case decls of @@ -581,35 +581,6 @@ return $ Alt srcloc pat'' rhs' decls' - -- Transform and update guards and right-hand side of a case-expression. - -- The supplied list of guards is prepended to the original guards, and - -- subterms are traversed and transformed. - where mkGAlts :: SrcLoc -> [Guard] -> [(Name, Pat)] -> GuardedAlts -> HsxM GuardedAlts - mkGAlts s guards rnps (UnGuardedAlt rhs) = do - -- Add the postponed patterns to the right-hand side by placing - -- them in a let-expression to make them lazily evaluated. - -- Then transform the whole right-hand side as an expression. - rhs' <- transformExpM $ addLetDecls s rnps rhs - case guards of - -- There were no guards before, and none should be added, - -- so we still have an unguarded right-hand side - [] -> return $ UnGuardedAlt rhs' - -- There are guards to add. These should be added as pattern - -- guards, i.e. as statements. - _ -> return $ GuardedAlts [GuardedAlt s (map mkStmtGuard guards) rhs'] - mkGAlts s gs rnps (GuardedAlts galts) = - fmap GuardedAlts $ mapM (mkGAlt gs rnps) galts - where mkGAlt :: [Guard] -> [(Name, Pat)] -> GuardedAlt -> HsxM GuardedAlt - mkGAlt gs rnps (GuardedAlt s oldgs rhs) = do - -- Add the postponed patterns to the right-hand side by placing - -- them in a let-expression to make them lazily evaluated. - -- Then transform the whole right-hand side as an expression. - rhs' <- transformExpM $ addLetDecls s rnps rhs - -- Now there are guards, so first we need to transform those - oldgs' <- fmap concat $ mapM (transformStmt GuardStmt) oldgs - -- ... and then prepend the newly generated ones, as statements - return $ GuardedAlt s ((map mkStmtGuard gs) ++ oldgs') rhs' - ---------------------------------------------------------------------------------- -- Guards @@ -699,7 +670,6 @@ PXETag _ _ _ _ -> rename p -- The rest of the rules simply try to rename regular patterns in -- their immediate subpatterns. - PNeg p -> rename1pat p PNeg renameRP PInfixApp p1 n p2 -> rename2pat p1 p2 (\p1 p2 -> PInfixApp p1 n p2) renameRP @@ -741,12 +711,12 @@ where renameLetDecl :: Decl -> RN (Decl, [(SrcLoc, Name, Pat)]) renameLetDecl d = case d of -- We need only bother about pattern bindings. - PatBind srcloc pat mty rhs decls -> do + PatBind srcloc pat rhs decls -> do -- Rename any regular patterns that appear in the -- pattern being bound. (p, ms) <- renameRP pat let sms = map (\(n,p) -> (srcloc, n, p)) ms - return $ (PatBind srcloc p mty rhs decls, sms) + return $ (PatBind srcloc p rhs decls, sms) _ -> return (d, []) @@ -763,7 +733,6 @@ return $ (PIrrPat q, ms) -- The rest of the rules simply try to rename regular patterns in -- irrefutable patterns in their immediate subpatterns. - PNeg p -> rename1pat p PNeg renameIrrP PInfixApp p1 n p2 -> rename2pat p1 p2 (\p1 p2 -> PInfixApp p1 n p2) renameIrrP @@ -996,8 +965,7 @@ e' <- liftTr $ transformExpM e tr1pat p (PViewPat e') (trPattern s) PVar _ -> return p - PLit _ -> return p - PNeg q -> tr1pat q PNeg (trPattern s) + PLit _ _ -> return p PInfixApp p1 op p2 -> tr2pat p1 p2 (\p1 p2 -> PInfixApp p1 op p2) (trPattern s) PApp n ps -> trNpat ps (PApp n) (trPattern s) PTuple bx ps -> trNpat ps (PTuple bx) (trPattern s) @@ -1492,7 +1460,6 @@ gatherPVars :: Pat -> [Name] gatherPVars p = case p of PVar v -> [v] - PNeg q -> gatherPVars q PInfixApp p1 _ p2 -> gatherPVars p1 ++ gatherPVars p2 PApp _ ps -> concatMap gatherPVars ps diff --git a/src/hsx2hs.hs b/src/hsx2hs.hs --- a/src/hsx2hs.hs +++ b/src/hsx2hs.hs @@ -12,8 +12,26 @@ import Language.Haskell.HSX.Transform (transform) import System.Exit (exitFailure) import System.Environment (getArgs) -import System.IO.UTF8 (readFile, writeFile,hPutStrLn) +#if MIN_VERSION_utf8_string(1,0,0) +import qualified Data.ByteString as BS (readFile, writeFile) +import Data.ByteString.UTF8 (fromString, toString) +import System.IO (hPutStrLn, stderr, hSetEncoding, utf8, withBinaryFile, IOMode(ReadMode, WriteMode), hGetContents) +#else +import qualified System.IO.UTF8 as UTF8 (readFile, writeFile, hPutStrLn) import System.IO (stderr) +#endif + +#if MIN_VERSION_utf8_string(1,0,0) +readFile :: FilePath -> IO String +readFile path = BS.readFile path >>= return . toString +writeFile :: FilePath -> String -> IO () +writeFile path s = BS.writeFile path (fromString s) +#else +readFile :: FilePath -> IO String +readFile = UTF8.readfile +writeFile :: FilePath -> String -> IO () +writeFile = UTF8.writeFile +#endif showSrcLoc :: SrcLoc -> String showSrcLoc (SrcLoc {srcFilename=srcFilename,srcLine=srcLine,srcColumn=srcColumn}) =