HJScript 0.6.1 → 0.7.0

raw patch · 4 files changed

+72/−58 lines, 4 filesdep +hspdep +textdep −hsxnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: hsp, text

Dependencies removed: hsx

API changes (from Hackage documentation)

Files

• HJScript.cabal +3/−3
• src/HJScript/Lang.hs +29/−29
• src/HJScript/Monad.hs +14/−14
• src/HJScript/XMLGenerator.hs +26/−12

@@ -1,5 +1,5 @@ Name:             HJScript-Version:          0.6.1+Version:          0.7.0 License:          BSD3 License-File:     LICENSE Author:           Joel Bjornson, Niklas Broberg@@ -22,7 +22,7 @@  source-repository head     type:     darcs-    location: http://patch-tag.com/r/nibro/hsx+    location: http://hub.darcs.com/r/stepcut/hjscript  Library     Hs-Source-Dirs:   src@@ -54,7 +54,7 @@                       HJScript.Utils     Other-Modules:    HJScript.Monad -    Build-Depends:    base < 5, HJavaScript >= 0.4.6, mtl, hsx >= 0.10.2 && < 0.11+    Build-Depends:    base < 5, HJavaScript >= 0.4.6, mtl, hsp >= 0.9, text >= 0.11      Extensions:       MultiParamTypeClasses,                       GADTs,

@@ -16,25 +16,25 @@      -- Method calls     this, callMethod, callVoidMethod, callProc,-    +     -- Functions and declarations     function, procedure, functionDecl, procedureDecl,-    +     -- Control flow     for, forIn, forInVar, while, doWhile, doIf, doElse, doIfElse, doIfNoElse, noElse,-    +     -- Objects     var, varWith, inVar, new, delete, ( # ), ( #. ),     rec, first, second, x, y,-    -    -- Helpers    -    ( #! ) , jnull, jShow, castObject, hasFeature, ++    -- Helpers+    ( #! ) , jnull, jShow, castObject, hasFeature,     break, continue, true ,ifOp, false, int, float, bool, string,      -- Re-exports from internal module HJScript.Monad-    HJScript, IsHJScript(..), +    HJScript, IsHJScript(..),     outputBlock, outputStmt,-    +     -- Evaluating HJScript     evaluateHJScript, evalHJScript, @@ -49,9 +49,9 @@   -- Infix operators-infixr  2   .||. +infixr  2   .||. infixr  3   .&&.-infix   4   .=. , .==. , .!=., .>., .<. , .<=. , .>=. , ? , +infix   4   .=. , .==. , .!=., .>., .<. , .<=. , .>=. , ? ,             `doIfNoElse` , `doIfElse` infixl  6   .+. , .-. infixl  7   .*., ./.@@ -61,7 +61,7 @@ -- Operators ------------------------------------------------------------------- type HJSJBinOperator t r = Exp t -> Exp t -> Exp r-                        + -- | Incrementing or decrementing numbers. preinc :: Num t => Var t -> HJScript () preinc = outputStmt . ExpStmt . JIncrement Pre@@ -69,7 +69,7 @@ postinc :: Num t => Var t -> HJScript () postinc = outputStmt . ExpStmt . JIncrement Pst -predec :: Num t => Var t -> HJScript () +predec :: Num t => Var t -> HJScript () predec = outputStmt . ExpStmt . JDecrement Pre  postdec :: Num t => Var t -> HJScript ()@@ -97,10 +97,10 @@ (.||.) = binOp Or  (.==.) :: HJSJBinOperator a Bool-(.==.) = binOp Equals +(.==.) = binOp Equals  (.!=.) :: HJSJBinOperator a Bool-(.!=.) = binOp NotEquals +(.!=.) = binOp NotEquals  (.>.) :: Num a => HJSJBinOperator a Bool (.>.) = binOp GThan@@ -136,21 +136,21 @@     inc name  = JIncrement Pst (JVar name)  :: JInt     pre name  = VarDeclAssign name from     cond name = (val $ JVar name) .<=. to-    --- | for (var in object) { .. }    ++-- | for (var in object) { .. } forIn :: (IsDeref d) => d -> (JString -> HJScript ()) -> HJScript () forIn obj script =   do v <- var      (_, body) <- hjsInside $ script (val v)      outputStmt $ ForIn v obj body-     --- | for (var in object) { .. }    ++-- | for (var in object) { .. } forInVar :: (IsDeref d) => d -> (Var a -> HJScript ()) -> HJScript () forInVar obj script =   do v <- var      (_, body) <- hjsInside $ script (obj # propertyVar (val v))-     outputStmt $ ForIn v obj body     -     +     outputStmt $ ForIn v obj body+ -- | while while :: JBool -> HJScript t -> HJScript () while cond script = do@@ -167,7 +167,7 @@   (_,body) <- hjsInside script   els' <- els   outputStmt $ If cond body els'-  + -- | doElse doElse :: HJScript () -> HJScript (Elses ()) doElse script = do@@ -191,7 +191,7 @@  -- | Only an if branch doIfNoElse :: Exp Bool -> HJScript () -> HJScript ()-doIfNoElse cond script = doIf cond script noElse    +doIfNoElse cond script = doIf cond script noElse  -- | No else branch. noElse :: HJScript (Elses ())@@ -204,7 +204,7 @@ -- | Anonymous function, returning an expression function :: (FormalParams a t, VarsToExps a e) =>             (e -> HJScript (Exp r)) ->  HJScript (Exp (t -> r))-function fun = do +function fun = do   n <- newVarNum   let args = mkFParams (\_ -> ()) n   let script = fun $ v2e args@@ -231,7 +231,7 @@   (ret,body) <- hjsInside script   let body' = addReturn ret body   outputStmt $ ExpStmt $ JFunction (Just name) args body'-   + -- | Procedure declaration. procedureDecl ::  (FormalParams a t, VarsToExps a e) =>                   String -> (e -> HJScript ()) -> HJScript ()@@ -254,7 +254,7 @@ -----------------------------------------------------------  evaluateHJScript :: HJScript (Exp t) -> Block t-evaluateHJScript m = +evaluateHJScript m =     let (v,b) = evalHJScript m      in addReturn v b @@ -286,7 +286,7 @@ varWith e = do   name <- newVarName   outputStmt $ VarDeclAssign name e-  return $ JVar name +  return $ JVar name  inVar :: Exp t -> HJScript (Exp t) inVar = fmap val . varWith@@ -299,7 +299,7 @@  -- Create new Objects. new ::  (HasConstructor o e t, Args e t) => o -> e -> HJScript (Exp o)-new o = fmap val . varWith . JNew o                     +new o = fmap val . varWith . JNew o  -- |delete a property --@@ -315,10 +315,10 @@ ( # ) :: a -> (a -> b) -> b a # f = f a --- Operator used for binding dereferencing without argument, +-- Operator used for binding dereferencing without argument, -- e.g. "style #. display" ( #. ) :: (a -> b) -> (b -> c) -> (a -> c)-( #. ) = flip (.) +( #. ) = flip (.)  -- Creating a record rec :: Exp a -> Exp b -> Exp (Rec a b)

@@ -12,7 +12,7 @@     -- * Data types and classes     HJScript, HJScript',     IsHJScript(..),-    +     -- * Functions     evalHJScript,     runHJScript,@@ -23,12 +23,12 @@     hjsInside,    )  where-  + import Language.HJavaScript.Syntax import Control.Monad.Writer import Control.Monad.State -import HSX.XMLGenerator (XMLGenT, unXMLGenT)+import HSP (XMLGenT, unXMLGenT)  -- | HJScript Monad type HJScript'= StateT HJState (Writer (Block ()))@@ -50,17 +50,17 @@   mempty = EmptyBlock   mappend EmptyBlock b = b   mappend b EmptyBlock = b-  mappend b1 (Sequence b2 s) = Sequence (mappend b1 b2) s  -  +  mappend b1 (Sequence b2 s) = Sequence (mappend b1 b2) s+ -- | Evaluate a script returning a tuple of the produced value and -- a block of code. evalHJScript :: HJScript t -> (t, Block ()) evalHJScript m = runWriter $ evalStateT (unXMLGenT m) initState --- | Runs a script returning the value, the new state and +-- | Runs a script returning the value, the new state and -- the block of code.-runHJScript :: HJScript t -> HJState -> (t, HJState, Block ()) -runHJScript m state = +runHJScript :: HJScript t -> HJState -> (t, HJState, Block ())+runHJScript m state =   let ((v,state'),block) = runWriter $ runStateT (unXMLGenT m) state   in  (v,state',block) @@ -71,7 +71,7 @@ -- Set the state putHJState :: HJState -> HJScript () putHJState = lift . put-  + -- | Adds a statement outputStmt :: Stmt () -> HJScript () outputStmt = outputBlock . toBlock@@ -97,20 +97,20 @@ hjsInside :: HJScript t -> HJScript (t, Block ()) hjsInside script = do   state <- getHJState-  let (v,state',block) = runHJScript script state +  let (v,state',block) = runHJScript script state   putHJState state'   return (v,block)  ------------------------------------------------------------------- -- IsHJScript ---------------------------------------------------------------------- | IsHJscript class with function toHJScript for converting +-- | IsHJscript class with function toHJScript for converting -- instances to HJScript () class IsHJScript a where   toHJScript :: a -> HJScript ()-  + instance IsHJScript (HJScript t) where-  toHJScript s = s >> return ()  +  toHJScript s = s >> return ()  instance IsHJScript (Block ()) where   toHJScript = outputBlock@@ -119,4 +119,4 @@   toHJScript = outputStmt  instance IsHJScript (Exp t) where-  toHJScript = toHJScript . ExpStmt  +  toHJScript = toHJScript . ExpStmt

@@ -1,12 +1,13 @@-{-# LANGUAGE OverlappingInstances, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, OverlappingInstances, TypeSynonymInstances, UndecidableInstances, TypeFamilies #-} module HJScript.XMLGenerator ( --        ToChildNodes(..), ToAttributeNode(..),-        -        genElement, genEElement, asChild, asAttr, Attr(..)++        XML, Child, Attribute, genElement, genEElement, asChild, asAttr, fromStringLit, Attr(..)         ) where  --import qualified HSX.XMLGenerator as HSX (XMLGen(..))-import HSX.XMLGenerator+import qualified Data.Text.Lazy as TL+import HSP.XMLGenerator  import HJScript.Monad import HJScript.Lang@@ -23,6 +24,7 @@  instance XMLGen HJScript' where  type XMLType          HJScript' = XML+ type StringType       HJScript' = String  newtype ChildType     HJScript' = HJSChild Child  newtype AttributeType HJScript' = HJSAttr Attribute  genElement = element@@ -30,9 +32,12 @@  xmlToChild = HJSChild . castToNode  pcdataToChild str = HJSChild . castToNode $ document # createTextNode (string str) -element :: (EmbedAsChild HJScript' c, -            EmbedAsAttr HJScript' a) -            => Name -> [a] -> [c] -> HJScript XML+fromStringLit :: String -> String+fromStringLit = id++element :: (EmbedAsChild HJScript' c,+            EmbedAsAttr HJScript' a)+            => Name String -> [a] -> [c] -> HJScript XML element (ns, ln) atts xmls = do   let name = (maybe id (\x y -> y ++ ':':x) ns) ln   elem <- fmap val $ varWith $ document # createElement (string name)@@ -42,9 +47,14 @@   mapM (\child -> elem # appendChild child) $ map stripChild cxml   return elem -eElement :: EmbedAsAttr HJScript' a => Name -> [a] -> HJScript XML+eElement :: EmbedAsAttr HJScript' a => Name String -> [a] -> HJScript XML eElement n attrs = element n attrs ([] :: [Child])-+{-+instance EmbedAsAttr HJScript' (Attr TL.Text TL.Text) where+    asAttr (n := v) = asAttr (TL.unpack n := TL.unpack v)+-}+instance EmbedAsChild HJScript' TL.Text where+    asChild t = asChild (TL.unpack t)  instance XMLGenerator HJScript' @@ -71,10 +81,10 @@ instance EmbedAsAttr HJScript' Attribute where  asAttr = asAttr . HJSAttr -instance (IsName n, IsAttrNodeValue a) => EmbedAsAttr HJScript' (Attr n a) where+instance (IsAttrNodeValue a, IsName n TL.Text) => EmbedAsAttr HJScript' (Attr n a) where  asAttr (k := a) = asAttr $ do     let (ns, ln) = toName k-        name = (maybe id (\x y -> y ++ ':':x) ns) ln+        name = (maybe id (\x y -> y ++ ':':x) (fmap TL.unpack ns)) (TL.unpack ln)     v <- toAttrNodeValue a     an <- inVar $ document # createAttribute (string name)     an # value .=. v@@ -85,7 +95,11 @@  toAttrNodeValue :: a -> HJScript JString  instance JShow a => IsAttrNodeValue a where- toAttrNodeValue = return . jshow+    toAttrNodeValue = return . jshow++instance IsAttrNodeValue TL.Text where+    toAttrNodeValue = return . jshow . TL.unpack+  instance IsAttrNodeValue a => IsAttrNodeValue (HJScript a) where  toAttrNodeValue = (>>= toAttrNodeValue)