hamlet 0.9.0 → 0.10.0

raw patch · 12 files changed

+28/−1350 lines, 12 filesdep +shakespearedep ~hamletdep ~hspecdep ~processsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: shakespeare

Dependency ranges changed: hamlet, hspec, process

API changes (from Hackage documentation)

Files

• Setup.lhs +1/−4
• Text/Cassius.hs +0/−299
• Text/Coffee.hs +0/−67
• Text/Css.hs +0/−214
• Text/Hamlet.hs +17/−17
• Text/Hamlet/Parse.hs +2/−2
• Text/Julius.hs +0/−64
• Text/Lucius.hs +0/−165
• Text/MkSizeType.hs +0/−73
• Text/Romeo.hs +0/−205
• Text/Shakespeare.hs +0/−225
• hamlet.cabal +8/−15

@@ -5,7 +5,4 @@ > import System.Cmd (system)  > main :: IO ()-> main = defaultMainWithHooks (simpleUserHooks { runTests = runTests' })--> runTests' :: a -> b -> c -> d -> IO ()-> runTests' _ _ _ _ = system "runhaskell -DTEST runtests.hs" >> return ()+> main = defaultMain

@@ -1,299 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}-module Text.Cassius-    ( -- * Datatypes-      Cassius-    , Css-      -- * Type class-    , ToCss (..)-      -- * Rendering-    , renderCassius-    , renderCss-      -- * Parsing-    , cassius-    , cassiusFile-    , cassiusFileDebug-      -- * ToCss instances-      -- ** Color-    , Color (..)-    , colorRed-    , colorBlack-      -- ** Size-    , mkSize-    , AbsoluteUnit (..)-    , AbsoluteSize (..)-    , absoluteSize-    , EmSize (..)-    , ExSize (..)-    , PercentageSize (..)-    , percentageSize-    , PixelSize (..)-    ) where--import Text.Css-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-import Data.Text.Lazy.Builder (fromText, fromLazyText)-import Data.Maybe (catMaybes)-import Data.Word (Word8)-import Data.Bits-import qualified Data.Text as TS-import qualified Data.Text.Lazy as TL-import Data.Char (isSpace)--data Color = Color Word8 Word8 Word8-    deriving Show-instance ToCss Color where-    toCss (Color r g b) =-        let (r1, r2) = toHex r-            (g1, g2) = toHex g-            (b1, b2) = toHex b-         in fromText $ TS.pack $ '#' :-            if r1 == r2 && g1 == g2 && b1 == b2-                then [r1, g1, b1]-                else [r1, r2, g1, g2, b1, b2]-      where-        toHex :: Word8 -> (Char, Char)-        toHex x = (toChar $ shiftR x 4, toChar $ x .&. 15)-        toChar :: Word8 -> Char-        toChar c-            | c < 10 = mkChar c 0 '0'-            | otherwise = mkChar c 10 'A'-        mkChar :: Word8 -> Word8 -> Char -> Char-        mkChar a b' c =-            toEnum $ fromIntegral $ a - b' + fromIntegral (fromEnum c)--colorRed :: Color-colorRed = Color 255 0 0--colorBlack :: Color-colorBlack = Color 0 0 0--renderCassius :: (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Cassius url -> TL.Text-renderCassius r s = renderCss $ s r--type Cassius url = (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Css--parseBlocks :: Parser [Block]-parseBlocks = (map compressBlock . catMaybes) `fmap` many parseBlock--parseEmptyLine :: Parser ()-parseEmptyLine = do-    try $ skipMany $ oneOf " \t"-    parseComment <|> eol--parseComment :: Parser ()-parseComment = do-    _ <- try (skipMany (oneOf " \t") >> string "/*")-    _ <- manyTill anyChar $ try $ string "*/"-    -- FIXME This requires that any line beginning with a comment is entirely a comment-    skipMany $ oneOf " \t"-    _ <- eol <|> eof-    return ()--parseIndent :: Parser Int-parseIndent =-    sum `fmap` many ((char ' ' >> return 1) <|> (char '\t' >> return 4))--parseBlock :: Parser (Maybe Block)-parseBlock = do-    indent <- parseIndent-    (emptyBlock >> return Nothing)-        <|> (eof >> if indent > 0 then return Nothing else fail "")-        <|> realBlock indent-  where-    emptyBlock = parseEmptyLine-    realBlock indent = do-        name <- many1 $ parseContent True-        eol-        pairs <- fmap catMaybes $ many $ parsePair' indent-        case pairs of-            [] -> return Nothing-            _ -> return $ Just $ Block [name] pairs []-    parsePair' indent = try (parseEmptyLine >> return Nothing)-                    <|> try (Just `fmap` parsePair indent)--parsePair :: Int -> Parser (Contents, Contents)-parsePair minIndent = do-    indent <- parseIndent-    if indent <= minIndent then fail "not indented" else return ()-    key <- manyTill (parseContent False) $ char ':'-    spaces-    value <- manyTill (parseContent True) $ eol <|> eof-    return (trim key, value) -- FIXME consider trimming value as well--trim :: Contents -> Contents-trim =-    reverse . go . reverse . go-  where-    go [] = []-    go (ContentRaw x:xs) =-        case dropWhile isSpace x of-            [] -> go xs-            y -> ContentRaw y:xs-    go x = x---eol :: Parser ()-eol = (char '\n' >> return ()) <|> (string "\r\n" >> return ())--parseContent :: Bool -> Parser Content-parseContent allowColon =-    parseHash' <|> parseAt' <|> parseComment' <|> parseChar-  where-    parseHash' = either ContentRaw ContentVar `fmap` parseHash-    parseAt' =-        either ContentRaw go `fmap` parseAt-      where-        go (d, False) = ContentUrl d-        go (d, True) = ContentUrlParam d-    parseChar = (ContentRaw . return) `fmap` noneOf restricted-    restricted = (if allowColon then id else (:) ':') "\r\n"-    parseComment' = do-        _ <- try $ string "/*"-        _ <- manyTill anyChar $ try $ string "*/"-        return $ ContentRaw ""--cassius :: QuasiQuoter-cassius = QuasiQuoter { quoteExp = cassiusFromString }--cassiusFromString :: String -> Q Exp-cassiusFromString s =-    topLevelsToCassius $ map TopBlock-  $ either (error . show) id $ parse parseBlocks s s--cassiusFile :: FilePath -> Q Exp-cassiusFile fp = do-    contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp-    cassiusFromString contents--cassiusFileDebug :: FilePath -> Q Exp-cassiusFileDebug = cssFileDebug [|parseTopLevels|] parseTopLevels--parseTopLevels :: Parser [TopLevel]-parseTopLevels = do-    x <- parseBlocks-    return $ map TopBlock x---- 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"-          _ -> error $ "In mkSize, invalid unit: " ++ unit-        valueE = litE $ rationalL (toRational value)---- | Absolute size units.-data AbsoluteUnit = Centimeter-                  | Inch-                  | Millimeter-                  | Pica-                  | Point-                  deriving (Eq, Show)---- | Not intended for direct use, see 'mkSize'.-data AbsoluteSize = AbsoluteSize-    { absoluteSizeUnit :: AbsoluteUnit -- ^ Units used for text formatting.-    , absoluteSizeValue :: 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 = fromText . TS.pack . show---- | Not intended for direct use, see 'mkSize'.-data PercentageSize = PercentageSize-    { percentageSizeValue :: 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 = fromText . TS.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"

@@ -1,67 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}-module Text.Coffee-    ( ToCoffee (..)-    , Coffee-    , coffee-    , coffeeFile-    , coffeeFileDebug-    , renderCoffee-    ) where--import Language.Haskell.TH.Quote (QuasiQuoter (..))-import Language.Haskell.TH.Syntax-import Data.Text.Lazy.Builder (Builder, fromText, toLazyText, fromLazyText)-import qualified Data.Text as TS-import qualified Data.Text.Lazy as TL-import System.Process (readProcess)-import Data.Monoid-import Text.Romeo--renderCoffee :: (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Coffee url -> IO TL.Text-renderCoffee r s = do-  out <- readProcess "coffee" ["-epb", TL.unpack $ toLazyText $ unCoffee $ s r] []-  return $ TL.pack out-  where unCoffee (Coffeescript c) = c--newtype Coffeescript = Coffeescript { unCoffeescript :: Builder }-    deriving Monoid--type Coffee url = (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Coffeescript---- the types that can be placed in a template-class ToCoffee c where-    toCoffee :: c -> Builder-instance ToCoffee [Char]  where toCoffee = fromLazyText . TL.pack-instance ToCoffee TS.Text where toCoffee = fromText-instance ToCoffee TL.Text where toCoffee = fromLazyText--settings :: Q RomeoSettings-settings = do-  toExp <- [|toCoffee|]-  wrapExp <- [|Coffeescript|]-  unWrapExp <- [|unCoffeescript|]-  return $ defaultRomeoSettings { varChar = '%'-  , toBuilder = toExp-  , wrap = wrapExp-  , unwrap = unWrapExp-  }--coffee :: QuasiQuoter-coffee = QuasiQuoter { quoteExp = \s -> do-    rs <- settings-    quoteExp (romeo rs) s-    }--coffeeFile :: FilePath -> Q Exp-coffeeFile fp = do-    rs <- settings-    romeoFile rs fp--coffeeFileDebug :: FilePath -> Q Exp-coffeeFileDebug fp = do-    rs <- settings-    romeoFileDebug rs fp

@@ -1,214 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE CPP #-}-module Text.Css where--import Data.List (intersperse, intercalate)-import Data.Text.Lazy.Builder (Builder, fromText, singleton, toLazyText, fromLazyText)-import qualified Data.Text.Lazy as TL-import Data.Monoid (mconcat, mappend, mempty)-import Data.Text (Text, pack)-import Language.Haskell.TH.Syntax-import System.IO.Unsafe (unsafePerformIO)-import Text.ParserCombinators.Parsec (Parser, parse)-import Text.Shakespeare-import Language.Haskell.TH--class ToCss a where-    toCss :: a -> Builder--instance ToCss [Char] where toCss = fromLazyText . TL.pack-instance ToCss Text where toCss = fromText-instance ToCss TL.Text where toCss = fromLazyText--data Css' = Css'-    { _cssSelectors :: Builder-    , _cssAttributes :: [(Builder, Builder)]-    }-data CssTop = Media String [Css'] | Css Css'--type Css = [CssTop]--data Content = ContentRaw String-             | ContentVar Deref-             | ContentUrl Deref-             | ContentUrlParam Deref-    deriving (Show, Eq)--type Contents = [Content]-type ContentPair = (Contents, Contents)--data VarType = VTPlain | VTUrl | VTUrlParam--data CDData url = CDPlain Builder-                | CDUrl url-                | CDUrlParam (url, [(Text, Text)])--cssFileDebug :: Q Exp -> Parser [TopLevel] -> FilePath -> Q Exp-cssFileDebug parseBlocks' parseBlocks fp = do-    s <- fmap TL.unpack $ qRunIO $ readUtf8File fp-    let a = either (error . show) id $ parse parseBlocks s s-    c <- mapM vtToExp $ concatMap getVars $ concatMap go a-    cr <- [|cssRuntime|]-    parseBlocks'' <- parseBlocks'-    return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c-  where-    go :: TopLevel -> [Content] -- FIXME use blockToCss-    go (MediaBlock _ blocks) = concatMap (go . TopBlock) blocks-    go (TopBlock (Block x y z)) =-        intercalate [ContentRaw ","] x ++-        concatMap go' y ++-        concatMap (go . TopBlock) z-    go' (k, v) = k ++ v--combineSelectors :: Selector -> Selector -> Selector-combineSelectors a b = do-    a' <- a-    b' <- b-    return $ a' ++ ContentRaw " " : b'--cssRuntime :: Parser [TopLevel]-           -> FilePath-           -> [(Deref, CDData url)]-           -> (url -> [(Text, Text)] -> Text)-           -> Css-cssRuntime parseBlocks fp cd render' = unsafePerformIO $ do-    s <- fmap TL.unpack $ qRunIO $ readUtf8File fp-    let a = either (error . show) id $ parse parseBlocks s s-    return $ foldr ($) [] $ map goTop a-  where-    goTop :: TopLevel -> Css -> Css-    goTop (TopBlock b) x = map Css (go b []) ++ x-    goTop (MediaBlock s b) x = Media s (foldr go [] b) : x-    go :: Block -> [Css'] -> [Css']-    -- FIXME share code with blockToCss-    go (Block x y z) =-        (:) (Css' (mconcat $ map go' $ intercalate [ContentRaw "," ] x) (map go'' y))-        . foldr (.) id (map (subGo x) z)-    subGo :: Selector -> Block -> [Css'] -> [Css']-    subGo x (Block a b c) =-        go (Block a' b c)-      where-        a' = combineSelectors x a-    go' :: Content -> Builder-    go' (ContentRaw s) = fromText $ pack s-    go' (ContentVar d) =-        case lookup d cd of-            Just (CDPlain s) -> s-            _ -> error $ show d ++ ": expected CDPlain"-    go' (ContentUrl d) =-        case lookup d cd of-            Just (CDUrl u) -> fromText $ render' u []-            _ -> error $ show d ++ ": expected CDUrl"-    go' (ContentUrlParam d) =-        case lookup d cd of-            Just (CDUrlParam (u, p)) ->-                fromText $ render' u p-            _ -> error $ show d ++ ": expected CDUrlParam"-    go'' (k, v) = (mconcat $ map go' k, mconcat $ map go' v)--vtToExp :: (Deref, VarType) -> Q Exp-vtToExp (d, vt) = do-    d' <- lift d-    c' <- c vt-    return $ TupE [d', c' `AppE` derefToExp [] d]-  where-    c :: VarType -> Q Exp-    c VTPlain = [|CDPlain . toCss|]-    c VTUrl = [|CDUrl|]-    c VTUrlParam = [|CDUrlParam|]--getVars :: Content -> [(Deref, VarType)]-getVars ContentRaw{} = []-getVars (ContentVar d) = [(d, VTPlain)]-getVars (ContentUrl d) = [(d, VTUrl)]-getVars (ContentUrlParam d) = [(d, VTUrlParam)]--data Block = Block Selector Pairs [Block]--data TopLevel = TopBlock Block | MediaBlock String [Block]--type Pairs = [Pair]--type Pair = (Contents, Contents)--type Selector = [Contents]--compressTopLevel :: TopLevel -> TopLevel-compressTopLevel (TopBlock b) = TopBlock $ compressBlock b-compressTopLevel (MediaBlock s b) = MediaBlock s $ map compressBlock b--compressBlock :: Block -> Block-compressBlock (Block x y blocks) =-    Block (map cc x) (map go y) (map compressBlock blocks)-  where-    go (k, v) = (cc k, cc v)-    cc [] = []-    cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c-    cc (a:b) = a : cc b--blockToCss :: Name -> Block -> Q Exp-blockToCss r (Block sel props subblocks) =-    [|(:) (Css' $(selectorToBuilder r sel) $(listE $ map go props))-      . foldr (.) id $(listE $ map subGo subblocks)-    |]-  where-    go (x, y) = tupE [contentsToBuilder r x, contentsToBuilder r y]-    subGo (Block sel' b c) =-        blockToCss r $ Block sel'' b c-      where-        sel'' = combineSelectors sel sel'--selectorToBuilder :: Name -> Selector -> Q Exp-selectorToBuilder r sels =-    contentsToBuilder r $ intercalate [ContentRaw ","] sels--contentsToBuilder :: Name -> [Content] -> Q Exp-contentsToBuilder r contents =-    appE [|mconcat|] $ listE $ map (contentToBuilder r) contents--contentToBuilder :: Name -> Content -> Q Exp-contentToBuilder _ (ContentRaw x) =-    [|fromText . pack|] `appE` litE (StringL x)-contentToBuilder _ (ContentVar d) =-    [|toCss|] `appE` return (derefToExp [] d)-contentToBuilder r (ContentUrl u) =-    [|fromText|] `appE`-        (varE r `appE` return (derefToExp [] u) `appE` listE [])-contentToBuilder r (ContentUrlParam u) =-    [|fromText|] `appE`-        ([|uncurry|] `appE` varE r `appE` return (derefToExp [] u))--topLevelsToCassius :: [TopLevel] -> Q Exp-topLevelsToCassius a = do-    r <- newName "_render"-    lamE [varP r] $ appE [|foldr ($) []|] $ listE $ map (go r) a-  where-    go r (TopBlock b) = [|(++) $ map Css ($(blockToCss r b) [])|]-    go r (MediaBlock s b) = [|(:) $ Media $(lift s) $(blocksToCassius r b)|]--blocksToCassius :: Name -> [Block] -> Q Exp-blocksToCassius r a = do-    appE [|foldr ($) []|] $ listE $ map (blockToCss r) a--renderCss :: Css -> TL.Text-renderCss =-    toLazyText . mconcat . map go -- FIXME use a foldr-  where-    go (Css x) = renderCss' x-    go (Media s x) =-        fromText (pack "@media ") `mappend`-        fromText (pack s) `mappend`-        singleton '{' `mappend`-        foldr mappend (singleton '}') (map renderCss' x)--renderCss' :: Css' -> Builder-renderCss' (Css' _x []) = mempty-renderCss' (Css' x y) =-    x-    `mappend` singleton '{'-    `mappend` mconcat (intersperse (singleton ';') $ map go' y)-    `mappend` singleton '}'-  where-    go' (k, v) = k `mappend` singleton ':' `mappend` v

@@ -9,18 +9,18 @@ module Text.Hamlet     ( -- * Plain HTML       Html-    , html-    , htmlFile-    , xhtml-    , xhtmlFile+    , shamlet+    , shamletFile+    , xshamlet+    , xshamletFile       -- * Hamlet-    , Hamlet+    , HtmlUrl     , hamlet     , hamletFile     , xhamlet     , xhamletFile       -- * I18N Hamlet-    , IHamlet+    , HtmlUrlI18n     , ihamlet     , ihamletFile       -- * Internal, for making more@@ -32,7 +32,7 @@     , HamletRules (..)     ) where -import Text.Shakespeare+import Text.Shakespeare.Base import Text.Hamlet.Parse import Language.Haskell.TH.Syntax import Language.Haskell.TH.Quote@@ -52,10 +52,10 @@ type Translate msg = msg -> Html  -- | A function generating an 'Html' given a URL-rendering function.-type Hamlet url = Render url -> Html+type HtmlUrl url = Render url -> Html  -- | A function generating an 'Html' given a message translator and a URL rendering function.-type IHamlet msg url = Translate msg -> Render url -> Html+type HtmlUrlI18n msg url = Translate msg -> Render url -> Html  docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp docsToExp env hr scope docs = do@@ -142,11 +142,11 @@         Just wrender -> wrender $ \render ->             return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d) -html :: QuasiQuoter-html = hamletWithSettings htmlRules defaultHamletSettings+shamlet :: QuasiQuoter+shamlet = hamletWithSettings htmlRules defaultHamletSettings -xhtml :: QuasiQuoter-xhtml = hamletWithSettings htmlRules xhtmlHamletSettings+xshamlet :: QuasiQuoter+xshamlet = hamletWithSettings htmlRules xhtmlHamletSettings  htmlRules :: Q HamletRules htmlRules = do@@ -228,11 +228,11 @@ xhamletFile :: FilePath -> Q Exp xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings -htmlFile :: FilePath -> Q Exp-htmlFile = hamletFileWithSettings htmlRules defaultHamletSettings+shamletFile :: FilePath -> Q Exp+shamletFile = hamletFileWithSettings htmlRules defaultHamletSettings -xhtmlFile :: FilePath -> Q Exp-xhtmlFile = hamletFileWithSettings htmlRules xhtmlHamletSettings+xshamletFile :: FilePath -> Q Exp+xshamletFile = hamletFileWithSettings htmlRules xhtmlHamletSettings  ihamletFile :: FilePath -> Q Exp ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings

@@ -13,7 +13,7 @@     )     where -import Text.Shakespeare+import Text.Shakespeare.Base import Control.Applicative ((<$>), Applicative (..)) import Control.Monad import Control.Arrow@@ -68,7 +68,7 @@ parseLine :: HamletSettings -> Parser (Int, Line) parseLine set = do     ss <- fmap sum $ many ((char ' ' >> return 1) <|>-                           (char '\t' >> return 4))+                           (char '\t' >> fail "Tabs are not allowed in Hamlet indentation"))     x <- doctype <|>          comment <|>          htmlComment <|>

@@ -1,64 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}-module Text.Julius-    ( Julius-    , Javascript (..)-    , ToJavascript (..)-    , renderJulius-    , julius-    , juliusFile-    , juliusFileDebug-    ) where--import Language.Haskell.TH.Quote (QuasiQuoter (..))-import Language.Haskell.TH.Syntax-import Data.Text.Lazy.Builder (Builder, fromText, toLazyText, fromLazyText)-import Data.Monoid-import qualified Data.Text as TS-import qualified Data.Text.Lazy as TL-import Text.Romeo--renderJavascript :: Javascript -> TL.Text-renderJavascript (Javascript b) = toLazyText b--renderJulius :: (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Julius url -> TL.Text-renderJulius r s = renderJavascript $ s r--newtype Javascript = Javascript { unJavascript :: Builder }-    deriving Monoid-type Julius url = (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Javascript--class ToJavascript a where-    toJavascript :: a -> Builder-instance ToJavascript [Char] where toJavascript = fromLazyText . TL.pack-instance ToJavascript TS.Text where toJavascript = fromText-instance ToJavascript TL.Text where toJavascript = fromLazyText--settings :: Q RomeoSettings-settings = do-  toJExp <- [|toJavascript|]-  wrapExp <- [|Javascript|]-  unWrapExp <- [|unJavascript|]-  return $ defaultRomeoSettings { toBuilder = toJExp-  , wrap = wrapExp-  , unwrap = unWrapExp-  }--julius :: QuasiQuoter-julius = QuasiQuoter { quoteExp = \s -> do-    rs <- settings-    quoteExp (romeo rs) s-    }--juliusFile :: FilePath -> Q Exp-juliusFile fp = do-    rs <- settings-    romeoFile rs fp--juliusFileDebug :: FilePath -> Q Exp-juliusFileDebug fp = do-    rs <- settings-    romeoFileDebug rs fp

@@ -1,165 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE QuasiQuotes #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}-module Text.Lucius-    ( -- * Datatypes-      Lucius-      -- * Rendering-    , renderLucius-      -- * Parsing-    , lucius-    , luciusFile-    , luciusFileDebug-      -- * Re-export cassius-    , module Text.Cassius-    ) where--import Text.Cassius hiding (Cassius, renderCassius, cassius, cassiusFile, cassiusFileDebug)-import Text.Shakespeare-import Language.Haskell.TH.Quote (QuasiQuoter (..))-import Language.Haskell.TH.Syntax-import qualified Data.Text as TS-import qualified Data.Text.Lazy as TL-import qualified Text.Cassius as C-import Text.ParserCombinators.Parsec hiding (Line)-import Text.Css-import Data.Char (isSpace)-import Control.Applicative ((<$>))-import Data.Either (partitionEithers)--type Lucius a = C.Cassius a--renderLucius :: (url -> [(TS.Text, TS.Text)] -> TS.Text)-             -> Lucius url-             -> TL.Text-renderLucius = C.renderCassius---- |------ >>> renderLucius undefined [lucius|foo{bar:baz}|]--- "foo{bar:baz}"-lucius :: QuasiQuoter-lucius = QuasiQuoter { quoteExp = luciusFromString }--luciusFromString :: String -> Q Exp-luciusFromString s =-    topLevelsToCassius-  $ either (error . show) id $ parse parseTopLevels s s--whiteSpace :: Parser ()-whiteSpace = many-    ((oneOf " \t\n\r" >> return ()) <|> (parseComment >> return ()))-    >> return () -- FIXME comments, don't use many--parseBlock :: Parser Block-parseBlock = do-    sel <- parseSelector-    _ <- char '{'-    whiteSpace-    pairsBlocks <- parsePairsBlocks id-    let (pairs, blocks) = partitionEithers pairsBlocks-    whiteSpace-    return $ Block sel pairs blocks--parseSelector :: Parser Selector-parseSelector =-    go id-  where-    go front = do-        c <- parseContents "{,"-        let front' = front . (:) (trim c)-        (char ',' >> go front') <|> return (front' [])--trim :: Contents -> Contents-trim =-    reverse . trim' False . reverse . trim' True-  where-    trim' _ [] = []-    trim' b (ContentRaw s:rest) =-        let s' = trimS b s-         in if null s' then trim' b rest else ContentRaw s' : rest-    trim' _ x = x-    trimS True = dropWhile isSpace-    trimS False = reverse . dropWhile isSpace . reverse--type PairBlock = Either Pair Block-parsePairsBlocks :: ([PairBlock] -> [PairBlock]) -> Parser [PairBlock]-parsePairsBlocks front = (char '}' >> return (front [])) <|> (do-    isBlock <- lookAhead checkIfBlock-    x <- if isBlock-            then (do-                b <- parseBlock-                whiteSpace-                return $ Right b)-            else Left <$> parsePair-    parsePairsBlocks $ front . (:) x)-  where-    checkIfBlock = do-        skipMany $ noneOf "#@{};"-        (parseHash >> checkIfBlock)-            <|> (parseAt >> checkIfBlock)-            <|> (char '{' >> return True)-            <|> (oneOf ";}" >> return False)-            <|> (anyChar >> checkIfBlock)-            <|> fail "checkIfBlock"--parsePair :: Parser Pair-parsePair = do-    key <- parseContents ":"-    _ <- char ':'-    whiteSpace-    val <- parseContents ";}"-    (char ';' >> return ()) <|> return ()-    whiteSpace-    return (key, val)--parseContents :: String -> Parser Contents-parseContents = many1 . parseContent--parseContent :: String -> Parser Content-parseContent restricted =-    parseHash' <|> parseAt' <|> parseComment <|> parseChar-  where-    parseHash' = either ContentRaw ContentVar `fmap` parseHash-    parseAt' =-        either ContentRaw go `fmap` parseAt-      where-        go (d, False) = ContentUrl d-        go (d, True) = ContentUrlParam d-    parseChar = (ContentRaw . return) `fmap` noneOf restricted--parseComment :: Parser Content-parseComment = do-    _ <- try $ string "/*"-    _ <- manyTill anyChar $ try $ string "*/"-    return $ ContentRaw ""--luciusFile :: FilePath -> Q Exp-luciusFile fp = do-    contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp-    luciusFromString contents--luciusFileDebug :: FilePath -> Q Exp-luciusFileDebug = cssFileDebug [|parseTopLevels|] parseTopLevels--parseTopLevels :: Parser [TopLevel]-parseTopLevels =-    go id-  where-    go front = do-        whiteSpace-        ((media <|> fmap TopBlock parseBlock) >>= \x -> go (front . (:) x))-            <|> (return $ map compressTopLevel $ front [])-    media = do-        try $ string "@media "-        name <- many1 $ noneOf "{"-        _ <- char '{'-        b <- parseBlocks id-        return $ MediaBlock name b-    parseBlocks front = do-        whiteSpace-        (char '}' >> return (map compressBlock $ front []))-            <|> (parseBlock >>= \x -> parseBlocks (front . (:) x))

@@ -1,73 +0,0 @@--- | 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 dot from) `AppE` ((AppE dot pack) `AppE` show')-        -- FIXME this whole section makes me a little nervous-        from = VarE (mkName "fromLazyText")-        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"

@@ -1,205 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}--- | For lack of a better name... a parameterized version of Julius.-module Text.Romeo-    ( RomeoSettings (..)-    , defaultRomeoSettings-    , romeo-    , romeoFile-    , romeoFileDebug-    ) where--import Text.ParserCombinators.Parsec hiding (Line)-import Language.Haskell.TH.Quote (QuasiQuoter (..))-import Language.Haskell.TH.Syntax-import Language.Haskell.TH.Syntax.Internals-import Data.Text.Lazy.Builder (Builder, fromText)-import Data.Monoid-import System.IO.Unsafe (unsafePerformIO)-import qualified Data.Text as TS-import qualified Data.Text.Lazy as TL-import Text.Shakespeare---- move to Shakespeare?-readFileQ :: FilePath -> Q [Char]-readFileQ fp = do-    qRunIO $ readFileUtf8 fp---- move to Shakespeare?-readFileUtf8 :: FilePath -> IO String-readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp--data RomeoSettings = RomeoSettings-    { varChar :: Char-    , urlChar :: Char-    , intChar :: Char-    , toBuilder :: Exp-    , wrap :: Exp-    , unwrap :: Exp-    }-defaultRomeoSettings :: RomeoSettings-defaultRomeoSettings = RomeoSettings {-    varChar = '#'-  , urlChar = '@'-  , intChar = '^'-}---instance Lift RomeoSettings where-    lift (RomeoSettings x1 x2 x3 x4 x5 x6) =-        [|RomeoSettings-            $(lift x1) $(lift x2) $(lift x3)-            $(liftExp x4) $(liftExp x5) $(liftExp x6)|]-      where-        liftExp (VarE n) = [|VarE $(liftName n)|]-        liftExp (ConE n) = [|ConE $(liftName n)|]-        liftExp _ = error "liftExp only supports VarE and ConE"-        liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]-        liftFlavour NameS = [|NameS|]-        liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|]-        liftFlavour (NameU _) = error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|]-        liftFlavour (NameL _) = error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|]-        liftFlavour (NameG ns (PkgName p) (ModName m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|]-        liftNS VarName = [|VarName|]-        liftNS DataName = [|DataName|]--type Romeo url = (url -> [(TS.Text, TS.Text)] -> TS.Text) -> Builder--data Content = ContentRaw String-             | ContentVar Deref-             | ContentUrl Deref-             | ContentUrlParam Deref-             | ContentMix Deref-    deriving (Show, Eq)-type Contents = [Content]--contentFromString :: RomeoSettings -> (String -> [Content])-contentFromString rs s = do-    compressContents $ either (error . show) id $ parse (parseContents rs) s s-  where-    compressContents :: Contents -> Contents-    compressContents [] = []-    compressContents (ContentRaw x:ContentRaw y:z) =-        compressContents $ ContentRaw (x ++ y) : z-    compressContents (x:y) = x : compressContents y--parseContents :: RomeoSettings -> Parser Contents-parseContents = many1 . parseContent-  where-    parseContent :: RomeoSettings -> Parser Content-    parseContent RomeoSettings {..} =-        parseHash' <|> parseAt' <|> parseCaret' <|> parseChar-      where-        parseHash' = either ContentRaw ContentVar `fmap` parseVar varChar-        parseAt' =-            either ContentRaw go `fmap` parseUrl urlChar '?'-          where-            go (d, False) = ContentUrl d-            go (d, True) = ContentUrlParam d-        parseCaret' = either ContentRaw ContentMix `fmap` parseInt intChar-        parseChar = ContentRaw `fmap` (many1 $ noneOf [varChar, urlChar, intChar])--contentsToRomeo :: RomeoSettings -> [Content] -> Q Exp-contentsToRomeo rs a = do-    r <- newName "_render"-    c <- mapM (contentToBuilder r) a-    d <- case c of-            [] -> [|mempty|]-            [x] -> return x-            _ -> do-                mc <- [|mconcat|]-                return $ mc `AppE` ListE c-    return $ LamE [VarP r] d-      where-        contentToBuilder :: Name -> Content -> Q Exp-        contentToBuilder _ (ContentRaw s') = do-            ts <- [|fromText . TS.pack|]-            return $ (wrap rs) `AppE` (ts `AppE` LitE (StringL s'))-        contentToBuilder _ (ContentVar d) = do-            return $ (wrap rs) `AppE` ((toBuilder rs) `AppE` derefToExp [] d)-        contentToBuilder r (ContentUrl d) = do-            ts <- [|fromText|]-            return $ (wrap rs) `AppE` (ts `AppE` (VarE r `AppE` derefToExp [] d `AppE` ListE []))-        contentToBuilder r (ContentUrlParam d) = do-            ts <- [|fromText|]-            up <- [|\r' (u, p) -> r' u p|]-            return $ (wrap rs) `AppE` (ts `AppE` (up `AppE` VarE r `AppE` derefToExp [] d))-        contentToBuilder r (ContentMix d) = do-            return $ derefToExp [] d `AppE` VarE r--romeo :: RomeoSettings -> QuasiQuoter-romeo r = QuasiQuoter { quoteExp = romeoFromString r }--romeoFromString :: RomeoSettings -> String -> Q Exp-romeoFromString r s = do-    contentsToRomeo r $ contentFromString r s--romeoFile :: RomeoSettings -> FilePath -> Q Exp-romeoFile r fp = readFileQ fp >>= romeoFromString r--data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin--getVars :: Content -> [(Deref, VarType)]-getVars ContentRaw{} = []-getVars (ContentVar d) = [(d, VTPlain)]-getVars (ContentUrl d) = [(d, VTUrl)]-getVars (ContentUrlParam d) = [(d, VTUrlParam)]-getVars (ContentMix d) = [(d, VTMixin)]--data VarExp url = EPlain Builder-                | EUrl url-                | EUrlParam (url, [(TS.Text, TS.Text)])-                | EMixin (Romeo url)--romeoFileDebug :: RomeoSettings -> FilePath -> Q Exp-romeoFileDebug rs fp = do-    s <- readFileQ fp-    let b = concatMap getVars $ contentFromString rs s-    c <- mapM vtToExp b-    rt <- [|romeoRuntime|]-    wrap' <- [|\x -> $(return $ wrap rs) . x|]-    r' <- lift rs-    return $ wrap' `AppE` (rt `AppE` r' `AppE` (LitE $ StringL fp) `AppE` ListE c)-  where-    vtToExp :: (Deref, VarType) -> Q Exp-    vtToExp (d, vt) = do-        d' <- lift d-        c' <- c vt-        return $ TupE [d', c' `AppE` derefToExp [] d]-      where-        c :: VarType -> Q Exp-        c VTPlain = [|EPlain . $(return $ toBuilder rs)|]-        c VTUrl = [|EUrl|]-        c VTUrlParam = [|EUrlParam|]-        c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap rs) $ x r|]---romeoRuntime :: RomeoSettings -> FilePath -> [(Deref, VarExp url)] -> Romeo url-romeoRuntime rs fp cd render' = unsafePerformIO $ do-    s <- readFileUtf8 fp-    return $ mconcat $ map go $ contentFromString rs s-  where-    go :: Content -> Builder-    go (ContentRaw s) = fromText $ TS.pack s-    go (ContentVar d) =-        case lookup d cd of-            Just (EPlain s) -> s-            _ -> error $ show d ++ ": expected EPlain"-    go (ContentUrl d) =-        case lookup d cd of-            Just (EUrl u) -> fromText $ render' u []-            _ -> error $ show d ++ ": expected EUrl"-    go (ContentUrlParam d) =-        case lookup d cd of-            Just (EUrlParam (u, p)) ->-                fromText $ render' u p-            _ -> error $ show d ++ ": expected EUrlParam"-    go (ContentMix d) =-        case lookup d cd of-            Just (EMixin m) -> m render'-            _ -> error $ show d ++ ": expected EMixin"

@@ -1,225 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE CPP #-}--- | General parsers, functions and datatypes for all three languages.-module Text.Shakespeare-    ( Deref (..)-    , Ident (..)-    , Scope-    , parseDeref-    , parseHash-    , parseVar-    , parseAt-    , parseUrl-    , parseCaret-    , parseUnder-    , parseInt-    , derefToExp-    , flattenDeref-    , readUtf8File-    ) where--import Language.Haskell.TH.Syntax-import Language.Haskell.TH (appE)-import Data.Char (isUpper)-import Text.ParserCombinators.Parsec-import Data.List (intercalate)-import Data.Ratio (Ratio, numerator, denominator, (%))-import Data.Data (Data)-import Data.Typeable (Typeable)-import qualified Data.Text.Lazy as TL-import qualified System.IO as SIO-import qualified Data.Text.Lazy.IO as TIO--newtype Ident = Ident String-    deriving (Show, Eq, Read, Data, Typeable)--type Scope = [(Ident, Exp)]--data Deref = DerefModulesIdent [String] Ident-           | DerefIdent Ident-           | DerefIntegral Integer-           | DerefRational Rational-           | DerefString String-           | DerefBranch Deref Deref-    deriving (Show, Eq, Read, Data, Typeable)--instance Lift Ident where-    lift (Ident s) = [|Ident|] `appE` lift s-instance Lift Deref where-    lift (DerefModulesIdent v s) = do-        dl <- [|DerefModulesIdent|]-        v' <- lift v-        s' <- lift s-        return $ dl `AppE` v' `AppE` s'-    lift (DerefIdent s) = do-        dl <- [|DerefIdent|]-        s' <- lift s-        return $ dl `AppE` s'-    lift (DerefBranch x y) = do-        x' <- lift x-        y' <- lift y-        db <- [|DerefBranch|]-        return $ db `AppE` x' `AppE` y'-    lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i-    lift (DerefRational r) = do-        n <- lift $ numerator r-        d <- lift $ denominator r-        per <- [|(%) :: Int -> Int -> Ratio Int|]-        dr <- [|DerefRational|]-        return $ dr `AppE` (InfixE (Just n) per (Just d))-    lift (DerefString s) = [|DerefString|] `appE` lift s--parseDeref :: Parser Deref-parseDeref = do-    skipMany $ oneOf " \t"-    x <- derefSingle-    res <- deref' $ (:) x-    skipMany $ oneOf " \t"-    return res-  where-    delim = (many1 (char ' ') >> return())-            <|> lookAhead (char '(' >> return ())-    derefOp = try $ do-        _ <- char '('-        x <- many1 $ noneOf " \t\n\r()"-        _ <- char ')'-        return $ DerefIdent $ Ident x-    derefParens = between (char '(') (char ')') parseDeref-    derefSingle = derefOp <|> derefParens <|> numeric <|> strLit<|> ident-    deref' lhs =-        dollar <|> derefSingle'-               <|> return (foldl1 DerefBranch $ lhs [])-      where-        dollar = do-            _ <- try $ delim >> char '$'-            rhs <- parseDeref-            let lhs' = foldl1 DerefBranch $ lhs []-            return $ DerefBranch lhs' rhs-        derefSingle' = do-            x <- try $ delim >> derefSingle-            deref' $ lhs . (:) x-    numeric = do-        n <- (char '-' >> return "-") <|> return ""-        x <- many1 digit-        y <- (char '.' >> fmap Just (many1 digit)) <|> return Nothing-        return $ case y of-            Nothing -> DerefIntegral $ read' "Integral" $ n ++ x-            Just z -> DerefRational $ toRational-                       (read' "Rational" $ n ++ x ++ '.' : z :: Double)-    strLit = do-        _ <- char '"'-        chars <- many quotedChar-        _ <- char '"'-        return $ DerefString chars-    quotedChar = (char '\\' >> escapedChar) <|> noneOf "\""-    escapedChar =-        (char 'n' >> return '\n') <|>-        (char 'r' >> return '\r') <|>-        (char 'b' >> return '\b') <|>-        (char 't' >> return '\t') <|>-        (char '\\' >> return '\\') <|>-        (char '"' >> return '"') <|>-        (char '\'' >> return '\'')-    ident = do-        mods <- many modul-        func <- many1 (alphaNum <|> char '_' <|> char '\'')-        let func' = Ident func-        return $-            if null mods-                then DerefIdent func'-                else DerefModulesIdent mods func'-    modul = try $ do-        c <- upper-        cs <- many (alphaNum <|> char '_')-        _ <- char '.'-        return $ c : cs--read' :: Read a => String -> String -> a-read' t s =-    case reads s of-        (x, _):_ -> x-        [] -> error $ t ++ " read failed: " ++ s--expType :: Ident -> Name -> Exp-expType (Ident (c:_)) = if isUpper c || c == ':' then ConE else VarE-expType (Ident "") = error "Bad Ident"--derefToExp :: Scope -> Deref -> Exp-derefToExp s (DerefBranch x y) = derefToExp s x `AppE` derefToExp s y-derefToExp _ (DerefModulesIdent mods i@(Ident s)) =-    expType i $ Name (mkOccName s) (NameQ $ mkModName $ intercalate "." mods)-derefToExp scope (DerefIdent i@(Ident s)) =-    case lookup i scope of-        Just e -> e-        Nothing -> expType i $ mkName s-derefToExp _ (DerefIntegral i) = LitE $ IntegerL i-derefToExp _ (DerefRational r) = LitE $ RationalL r-derefToExp _ (DerefString s) = LitE $ StringL s---- FIXME shouldn't we use something besides a list here?-flattenDeref :: Deref -> Maybe [String]-flattenDeref (DerefIdent (Ident x)) = Just [x]-flattenDeref (DerefBranch (DerefIdent (Ident x)) y) = do-    y' <- flattenDeref y-    Just $ y' ++ [x]-flattenDeref _ = Nothing--parseHash :: Parser (Either String Deref)-parseHash = parseVar '#'--parseVar :: Char -> Parser (Either String Deref)-parseVar c = do-    _ <- char c-    (char '\\' >> return (Left [c])) <|> (do-        _ <- char '{'-        deref <- parseDeref-        _ <- char '}'-        return $ Right deref) <|> (do-            -- Check for hash just before newline-            _ <- lookAhead (oneOf "\r\n" >> return ()) <|> eof-            return $ Left ""-            ) <|> return (Left [c])--parseAt :: Parser (Either String (Deref, Bool))-parseAt = parseUrl '@' '?'--parseUrl :: Char -> Char -> Parser (Either String (Deref, Bool))-parseUrl c d = do-    _ <- char c-    (char '\\' >> return (Left [c])) <|> (do-        x <- (char d >> return True) <|> return False-        (do-            _ <- char '{'-            deref <- parseDeref-            _ <- char '}'-            return $ Right (deref, x))-                <|> return (Left $ if x then [c, d] else [c]))--parseCaret :: Parser (Either String Deref)-parseCaret = parseInt '^'--parseInt :: Char -> Parser (Either String Deref)-parseInt c = do-    _ <- char c-    (char '\\' >> return (Left [c])) <|> (do-        _ <- char '{'-        deref <- parseDeref-        _ <- char '}'-        return $ Right deref) <|> return (Left [c])--parseUnder :: Parser (Either String Deref)-parseUnder = do-    _ <- char '_'-    (char '\\' >> return (Left "_")) <|> (do-        _ <- char '{'-        deref <- parseDeref-        _ <- char '}'-        return $ Right deref) <|> return (Left "_")--readUtf8File :: FilePath -> IO TL.Text-readUtf8File fp = do-    h <- SIO.openFile fp SIO.ReadMode-    SIO.hSetEncoding h SIO.utf8_bom-    TIO.hGetContents h

@@ -1,5 +1,5 @@ name:            hamlet-version:         0.9.0+version:         0.10.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -29,6 +29,7 @@  library     build-depends:   base             >= 4       && < 5+                   , shakespeare      >= 0.10    && < 0.11                    , bytestring       >= 0.9     && < 0.10                    , template-haskell                    , blaze-html       >= 0.4     && < 0.5@@ -37,32 +38,24 @@                    , text             >= 0.7     && < 0.12                    , containers       >= 0.2     && < 0.5                    , blaze-builder    >= 0.2     && < 0.4-                   , process          >= 1.0     && < 1.1+                   , process          >= 1.0     && < 1.2     exposed-modules: Text.Hamlet-                     Text.Cassius-                     Text.Lucius-                     Text.Julius-                     Text.Coffee-                     Text.Romeo-                     Text.Shakespeare     other-modules:   Text.Hamlet.Parse-                     Text.MkSizeType-                     Text.Css     ghc-options:     -Wall -test-suite runtests-    hs-source-dirs: tests-    main-is: runtests.hs+test-suite test+    hs-source-dirs: test+    main-is: main.hs     type: exitcode-stdio-1.0      ghc-options:   -Wall-    build-depends: hamlet           >= 0.9     && < 0.10+    build-depends: hamlet           >= 0.10    && < 0.11                  , base             >= 4       && < 5                  , parsec           >= 2       && < 4                  , containers       >= 0.2     && < 0.5                  , text             >= 0.7     && < 1                  , HUnit-                 , hspec+                 , hspec >= 0.6.1 && < 0.7                  , blaze-html       >= 0.4     && < 0.5