blaze-shields 0.1.0.1 → 0.1.1.2

raw patch · 3 files changed

+61/−19 lines, 3 filesdep +textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: text

API changes (from Hackage documentation)

Files

• blaze-shields.cabal +4/−2
• lib/Text/Blaze/Svg/Shields.hs +12/−17
• lib/Text/Blaze/Svg/Shields/Url.hs +45/−0

@@ -1,5 +1,5 @@ name: blaze-shields-version: 0.1.0.1+version: 0.1.1.2 synopsis: create svg by Haskell description: a Haskell version of shields ,which is on github. homepage: http://githubcom/Qinka/blaze-shields@@ -15,11 +15,13 @@ library     exposed-modules:       Text.Blaze.Svg.Shields+      Text.Blaze.Svg.Shields.Url     build-depends:       base >= 4    && < 5,       blaze-markup >= 0.7 && < 1,       blaze-html >= 0.8 && <1,-      blaze-svg >=0.3 && < 0.6+      blaze-svg >=0.3 && < 0.6,+      text >=1.2 && <1.6     default-language: Haskell2010     hs-source-dirs:lib     ghc-options: -Wall

@@ -12,14 +12,13 @@     ) where        import Prelude hiding (id,show)-      import Control.Monad(when)       import Data.Maybe(fromMaybe)        import Text.Blaze(ToMarkup,AttributeValue)-      import Text.Blaze.Internal(string,stringValue,attribute,AttributeValue,Attribute)+      import Text.Blaze.Internal(stringValue,attribute,Attribute)       import Text.Blaze.Html((!),toHtml)       import Text.Blaze.Html5(style)-      import Text.Blaze.Html5.Attributes(xmlns,href)+      import Text.Blaze.Html5.Attributes(xmlns)       import Text.Blaze.Svg(Svg)       import Text.Blaze.Svg11(         svg,lineargradient,stop,rect,g,path,text_,rect,@@ -32,18 +31,18 @@         )       import qualified Text.Blaze.Svg11 as S11       import qualified Text.Blaze.Svg11.Attributes as S11A-      import qualified Text.Blaze.Html5.Attributes as H5A       import qualified Prelude as P        show :: Show a => a -> AttributeValue-      show x = stringValue  show_-        where-          show_ = P.show x+      show = stringValue . P.show+++       xmlnsXlink :: AttributeValue  -- ^ Attribute value.-            -> Attribute       -- ^ Resulting attribute.+                 -> Attribute       -- ^ Resulting attribute.       xmlnsXlink = attribute "xmlns:xlink" " xmlns:xlink=\"" -      plasticStyle ::(Show a,ToMarkup a,Show b,Num b,Floating b)=> (a,b)        --left+      plasticStyle ::(Show a,ToMarkup a,Show b,Floating b)=> (a,b)        --left                                                       -> (a,b)        --right                                                       -> Maybe String --colorA                                                       -> Maybe String --colorB@@ -69,7 +68,7 @@           colorA = stringValue $ fromMaybe "#555" cA           colorB = stringValue $ fromMaybe "#4c1" cB -      flatStyle ::(Show a,ToMarkup a,Show b,Num b,Floating b)=> (a,b)        --left+      flatStyle ::(Show a,ToMarkup a,Show b,Floating b)=> (a,b)        --left                                                    -> (a,b)        --right                                                    -> Maybe String --colorA                                                    -> Maybe String --colorB@@ -95,7 +94,7 @@   -      flatSquareStyle ::(Show a,ToMarkup a,Show b,Num b,Floating b)=> (a,b)        --left+      flatSquareStyle ::(Show a,ToMarkup a,Show b,Floating b)=> (a,b)        --left                                                         -> (a,b)        --right                                                         -> Maybe String --colorA                                                         -> Maybe String --colorB@@ -111,18 +110,14 @@         where           colorA = stringValue $ fromMaybe "#555" cA           colorB = stringValue $ fromMaybe "#4c1" cB-      socialStyle ::(Show a,ToMarkup a,Show b,Num b,Floating b)=> (a,b)        --left+      socialStyle ::(Show a,ToMarkup a,Show b,Floating b)=> (a,b)        --left                                                      -> (a,b)        --right                                                      -> Maybe String --logo-url                                                      -> Maybe String --link1                                                      -> Maybe String --link2                                                      -> Svg          -- rt       socialStyle (l,lp) (r,rp) logo la lb= svg ! xmlns "http://www.w3.org/2000/svg" ! xmlnsXlink "http://www.w3.org/1999/xlink"! width (show $ lp+ww+pp+rp+21) ! height "20" $ do-          style ! type_ "text/css" $ do-            "<![CDATA[\n"-            "    #llink:hover { fill:url(#b); stroke:#ccc; }\n"-            "    #rlink:hover { fill:#4183C4; }\n"-            "  ]]>"+          style ! type_ "text/css" $ "<![CDATA[\n    #llink:hover { fill:url(#b); stroke:#ccc; }\n    #rlink:hover { fill:#4183C4; }\n  ]]>"           lineargradient ! id_ "a" ! x2 "0" ! y2 "100%" $ do             stop ! offset "0" ! stopColor "#fcfcfc" ! stopOpacity "0"             stop ! offset "1" ! stopOpacity ".1"

@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}+++++module Text.Blaze.Svg.Shields.Url+    (+    SvgShields(..),+    eval+    ) where++      import Text.Blaze(ToMarkup)+      import Text.Blaze.Svg(Svg)+      import Text.Blaze.Svg.Shields(+        plasticStyle,+        flatStyle,+        socialStyle,+        flatSquareStyle+        )+      import Data.Text.Lazy(unpack)+      import Data.Text.Internal.Lazy(Text)+++++      data (Show a,ToMarkup a,Read a,Show b,Floating b,Read b) => (SvgShields a b)+        = PlasticStyle (a,b) (a,b) (Maybe String) (Maybe String)+        | FlatStyle (a,b) (a,b) (Maybe String) (Maybe String)+        | FlatSquareStyle (a,b) (a,b) (Maybe String) (Maybe String)+        | SocialStyle (a,b) (a,b) (Maybe String) (Maybe String) (Maybe String)+        deriving (Show,Read)++      eval :: Text -> Svg+      eval url= case ssData of+          PlasticStyle (l,lp) (r,rp) cA cB ->+            plasticStyle (l,lp) (r,rp) cA cB+          FlatStyle (l,lp) (r,rp) cA cB ->+            flatStyle (l,lp) (r,rp) cA cB+          FlatSquareStyle (l,lp) (r,rp) cA cB ->+            flatSquareStyle (l,lp) (r,rp) cA cB+          SocialStyle (l,lp) (r,rp) cA cB u ->+            socialStyle (l,lp) (r,rp) cA cB u+          where+            ssData = read url' ::SvgShields String Double+            url' = unpack url