hamlet 0.7.1 → 0.7.2

raw patch · 5 files changed

+211/−1 lines, 5 files

Files

Text/Cassius.hs +123/−0
Text/Hamlet/Parse.hs +6/−0
Text/MkSizeType.hs +71/−0
hamlet.cabal +2/−1
runtests.hs +9/−0

Text/Cassius.hs view

@@ -20,6 +20,16 @@     , Color (..)     , colorRed     , colorBlack+      -- ** Size+    , mkSize+    , AbsoluteUnit (..)+    , AbsoluteSize (..)+    , absoluteSize+    , EmSize (..)+    , ExSize (..)+    , PercentageSize (..)+    , percentageSize+    , PixelSize (..) #if HAMLET6TO7     , parseBlocks     , Content (..)@@ -27,8 +37,10 @@ #endif     ) where +import Text.MkSizeType import Text.Shakespeare import Text.ParserCombinators.Parsec hiding (Line)+import Text.Printf (printf) import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH.Syntax import Language.Haskell.TH@@ -295,3 +307,114 @@                 fromText $ TS.pack $ render' u p             _ -> error $ show d ++ ": expected CDUrlParam"     go'' (k, v) = (toLazyText $ mconcat $ map go' k, mconcat $ map go' v)+++-- CSS size wrappers++-- | Create a CSS size, e.g. $(mkSize "100px").+mkSize :: String -> ExpQ+mkSize s = appE nameE valueE+  where [(value, unit)] = reads s :: [(Double, String)]+        absoluteSizeE = varE $ mkName "absoluteSize"+        nameE = case unit of+          "cm" -> appE absoluteSizeE (conE $ mkName "Centimeter")+          "em" -> conE $ mkName "EmSize"+          "ex" -> conE $ mkName "ExSize"+          "in" -> appE absoluteSizeE (conE $ mkName "Inch")+          "mm" -> appE absoluteSizeE (conE $ mkName "Millimeter")+          "pc" -> appE absoluteSizeE (conE $ mkName "Pica")+          "pt" -> appE absoluteSizeE (conE $ mkName "Point")+          "px" -> conE $ mkName "PixelSize"+          "%" -> varE $ mkName "percentageSize"+        valueE = litE $ rationalL (toRational value)++-- | Absolute size units.+data AbsoluteUnit = Centimeter+                  | Inch+                  | Millimeter+                  | Pica+                  | Point+                  deriving (Eq, Show)++data AbsoluteSize = AbsoluteSize -- | Not intended for direct use, see 'mkSize'.+                      AbsoluteUnit -- | Units used for text formatting.+                      Rational -- | Normalized value in centimeters.++-- | Absolute size unit convertion rate to centimeters.+absoluteUnitRate :: AbsoluteUnit -> Rational+absoluteUnitRate Centimeter = 1+absoluteUnitRate Inch = 2.54+absoluteUnitRate Millimeter = 0.1+absoluteUnitRate Pica = 12 * absoluteUnitRate Point+absoluteUnitRate Point = 1 / 72 * absoluteUnitRate Inch++-- | Constructs 'AbsoluteSize'. Not intended for direct use, see 'mkSize'.+absoluteSize :: AbsoluteUnit -> Rational -> AbsoluteSize+absoluteSize unit value = AbsoluteSize unit (value * absoluteUnitRate unit)++instance Show AbsoluteSize where+  show (AbsoluteSize unit value') = printf "%f" value ++ suffix+    where value = fromRational (value' / absoluteUnitRate unit) :: Double+          suffix = case unit of+            Centimeter -> "cm"+            Inch -> "in"+            Millimeter -> "mm"+            Pica -> "pc"+            Point -> "pt"++instance Eq AbsoluteSize where+  (AbsoluteSize _ v1) == (AbsoluteSize _ v2) = v1 == v2++instance Ord AbsoluteSize where+  compare (AbsoluteSize _ v1) (AbsoluteSize _ v2) = compare v1 v2++instance Num AbsoluteSize where+  (AbsoluteSize u1 v1) + (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 + v2)+  (AbsoluteSize u1 v1) * (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 * v2)+  (AbsoluteSize u1 v1) - (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 - v2)+  abs (AbsoluteSize u v) = AbsoluteSize u (abs v)+  signum (AbsoluteSize u v) = AbsoluteSize u (abs v)+  fromInteger x = AbsoluteSize Centimeter (fromInteger x)++instance Fractional AbsoluteSize where+  (AbsoluteSize u1 v1) / (AbsoluteSize _ v2) = AbsoluteSize u1 (v1 / v2)+  fromRational x = AbsoluteSize Centimeter (fromRational x)++instance ToCss AbsoluteSize where+  toCss = TL.pack . show++data PercentageSize = PercentageSize -- | Not intended for direct use, see 'mkSize'.+                        Rational -- | Normalized value, 1 == 100%.+                    deriving (Eq, Ord)++-- | Constructs 'PercentageSize'. Not intended for direct use, see 'mkSize'.+percentageSize :: Rational -> PercentageSize+percentageSize value = PercentageSize (value / 100)++instance Show PercentageSize where+  show (PercentageSize value') = printf "%f" value ++ "%"+    where value = fromRational (value' * 100) :: Double++instance Num PercentageSize where+  (PercentageSize v1) + (PercentageSize v2) = PercentageSize (v1 + v2)+  (PercentageSize v1) * (PercentageSize v2) = PercentageSize (v1 * v2)+  (PercentageSize v1) - (PercentageSize v2) = PercentageSize (v1 - v2)+  abs (PercentageSize v) = PercentageSize (abs v)+  signum (PercentageSize v) = PercentageSize (abs v)+  fromInteger x = PercentageSize (fromInteger x)++instance Fractional PercentageSize where+  (PercentageSize v1) / (PercentageSize v2) = PercentageSize (v1 / v2)+  fromRational x = PercentageSize (fromRational x)++instance ToCss PercentageSize where+  toCss = TL.pack . show++-- | Converts number and unit suffix to CSS format.+showSize :: Rational -> String -> String+showSize value' unit = printf "%f" value ++ unit+  where value = fromRational value' :: Double++mkSizeType "EmSize" "em"+mkSizeType "ExSize" "ex"+mkSizeType "PixelSize" "px"

Text/Hamlet/Parse.hs view

@@ -73,6 +73,7 @@                            (char '\t' >> return 4))     x <- doctype <|>          comment <|>+         htmlComment <|>          backslash <|>          controlIf <|>          controlElseIf <|>@@ -97,6 +98,11 @@         return $ LineContent [ContentRaw $ hamletDoctype set ++ "\n"]     comment = do         _ <- try $ string "$#"+        _ <- many $ noneOf "\r\n"+        eol+        return $ LineContent []+    htmlComment = do+        _ <- try $ string "<!--"         _ <- many $ noneOf "\r\n"         eol         return $ LineContent []

+ Text/MkSizeType.hs view

@@ -0,0 +1,71 @@+-- | Internal functions to generate CSS size wrapper types.+module Text.MkSizeType (mkSizeType) where++import Language.Haskell.TH.Syntax++mkSizeType :: String -> String -> Q [Dec]+mkSizeType name' unit = return [ dataDec name+                               , showInstanceDec name unit+                               , numInstanceDec name+                               , fractionalInstanceDec name+                               , toCssInstanceDec name ]+  where name = mkName $ name'++dataDec :: Name -> Dec+dataDec name = DataD [] name [] [constructor] derives+  where constructor = NormalC name [(NotStrict, ConT $ mkName "Rational")]+        derives = map mkName ["Eq", "Ord"]++showInstanceDec :: Name -> String -> Dec+showInstanceDec name unit' = InstanceD [] (instanceType "Show" name) [showDec]+  where showSize = VarE $ mkName "showSize"+        x = mkName "x"+        unit = LitE $ StringL unit'+        showDec = FunD (mkName "show") [Clause [showPat] showBody []]+        showPat = ConP name [VarP x]+        showBody = NormalB $ AppE (AppE showSize $ VarE x) unit++numInstanceDec :: Name -> Dec+numInstanceDec name = InstanceD [] (instanceType "Num" name) decs+  where decs = map (binaryFunDec name) ["+", "*", "-"] +++               map (unariFunDec1 name) ["abs", "signum"] +++               [unariFunDec2 name "fromInteger"]++fractionalInstanceDec :: Name -> Dec+fractionalInstanceDec name = InstanceD [] (instanceType "Fractional" name) decs+  where decs = [binaryFunDec name "/", unariFunDec2 name "fromRational"]++toCssInstanceDec :: Name -> Dec+toCssInstanceDec name = InstanceD [] (instanceType "ToCss" name) [toCssDec]+  where toCssDec = FunD (mkName "toCss") [Clause [] showBody []]+        showBody = NormalB $ AppE (AppE dot pack) show+        pack = VarE (mkName "TL.pack")+        dot = VarE (mkName ".")+        show = VarE (mkName "show")++instanceType :: String -> Name -> Type+instanceType className name = AppT (ConT $ mkName className) (ConT name)++binaryFunDec :: Name -> String -> Dec+binaryFunDec name fun' = FunD fun [Clause [pat1, pat2] body []]+  where pat1 = ConP name [VarP v1]+        pat2 = ConP name [VarP v2]+        body = NormalB $ AppE (ConE name) result+        result = AppE (AppE (VarE fun) (VarE v1)) (VarE v2)+        fun = mkName fun'+        v1 = mkName "v1"+        v2 = mkName "v2"++unariFunDec1 :: Name -> String -> Dec+unariFunDec1 name fun' = FunD fun [Clause [pat] body []]+  where pat = ConP name [VarP v]+        body = NormalB $ AppE (ConE name) (AppE (VarE fun) (VarE v))+        fun = mkName fun'+        v = mkName "v"++unariFunDec2 :: Name -> String -> Dec+unariFunDec2 name fun' = FunD fun [Clause [pat] body []]+  where pat = VarP x+        body = NormalB $ AppE (ConE name) (AppE (VarE fun) (VarE x))+        fun = mkName fun'+        x = mkName "x"

hamlet.cabal view

@@ -1,5 +1,5 @@ name:            hamlet-version:         0.7.1+version:         0.7.2 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -57,6 +57,7 @@     other-modules:   Text.Hamlet.Parse                      Text.Hamlet.Quasi                      Text.Hamlet.Debug+                     Text.MkSizeType                      Text.Shakespeare     ghc-options:     -Wall

runtests.hs view

@@ -98,6 +98,7 @@     , testCase "string literals" caseStringLiterals
     , testCase "embed json" caseEmbedJson
     , testCase "interpolated operators" caseOperators
+    , testCase "HTML comments" caseHtmlComments
     ]
 
 data Url = Home | Sub SubUrl
@@ -905,3 +906,11 @@ caseOperators = do
     helper "3" [$hamlet|#{show $ (+) 1 2}|]
     helper "6" [$hamlet|#{show $ sum $ (:) 1 ((:) 2 $ return 3)}|]
+
+caseHtmlComments = do
+    helper "<p>1</p><p>2</p>" [$hamlet|
+<p>1
+<!-- ignored comment -->
+<p
+    2
+|]