~alcinnz/haskell-stylist

haskell-stylist/src/Data/CSS/Preprocessor/Assets.hs -rw-r--r-- 2.1 KiB
8880b129 — Adrian Cochrane Minor fix to repair the testsuite! 11 months ago
                                                                                
70713fc6 Adrian Cochrane
277f756c Adrian Cochrane
dc780976 Adrian Cochrane
a4dfabc2 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
{-# LANGUAGE OverloadedStrings #-}
-- | Utilities for rewriting URLs referenced via CSS properties.
module Data.CSS.Preprocessor.Assets(StyleAssets(..), URIRewriter(..)) where

-- TODO Unit test!
import           Data.Text as Txt hiding (elem)
import           Network.URI
import qualified Data.CSS.Syntax.StyleSheet as CSS
import qualified Data.CSS.Syntax.Tokens as CSSTok
import           Data.List (nub, elem)

-- | Extracts referenced URLs from specified properties.
data StyleAssets = StyleAssets {
    -- | The properties from which to extract URLs.
    filterProps :: [Txt.Text],
    -- | The extracted URLs.
    assets :: [URI]
}

instance CSS.StyleSheet StyleAssets where
    addRule self (CSS.StyleRule _ props _) =
        StyleAssets (filterProps self) $ nub (
            assets self ++ [uri | (prop, val) <- props,
                    prop `elem` filterProps self,
                    CSSTok.Url text <- val,
                    Just uri <- [parseAbsoluteURI $ Txt.unpack text]]
            )


-- | Substitutes in given URLs into a property value.
rewritePropertyVal :: [(URI, URI)] -> [CSSTok.Token] -> [CSSTok.Token] 
rewritePropertyVal rewrites (CSSTok.Url text:vals)
    | Just uri <- parseURIReference $ Txt.unpack text, Just rewrite <- uri `lookup` rewrites =
        CSSTok.Url (Txt.pack $ uriToString id rewrite "") : rewritePropertyVal rewrites vals
    | otherwise = CSSTok.Url "" : rewritePropertyVal rewrites vals
rewritePropertyVal rewrites (val:vals) = val:rewritePropertyVal rewrites vals
rewritePropertyVal _ [] = []

-- | Substitutes in given URLs into the inner stylesheet being parsed.
data URIRewriter s = URIRewriter [(URI, URI)] s
instance CSS.StyleSheet s => CSS.StyleSheet (URIRewriter s) where
    setPriority p (URIRewriter r s) = URIRewriter r $ CSS.setPriority p s
    addRule (URIRewriter r s) (CSS.StyleRule sel props psuedo) =
        URIRewriter r $ CSS.addRule s $ CSS.StyleRule sel [
            (prop, rewritePropertyVal r val) | (prop, val) <- props
        ] psuedo
    addAtRule (URIRewriter r s) name toks =
        let (self', toks') = CSS.addAtRule s name toks in (URIRewriter r self', toks')