~alcinnz/haskell-stylist

ref: 67f348bb09a6bff991c3089b0aa68b2a8f8ff6a0 haskell-stylist/src/Data/CSS/Preprocessor/Assets.hs -rw-r--r-- 2.1 KiB
67f348bb — Adrian Cochrane Add priority method to VarParser decorator. 1 year, 6 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')