CssParsingExample.fsx

(**
Depends of https://gist.github.com/rflechner/60fc8a1074fb21cb5ff5
------------------------------------------------------------------------
Example where we can parse a CSS file in a non-seekable stream.
*)

#load "ParsingBase.fs"

module Css =
    type CssBlock = 
        { Selector:string
          Properties:CssProperty list }
        member x.Property p =
            x.Properties
            |> List.tryFind (fun i -> i.Name = p)
            |> function
                | Some v -> Some v.Value
                | None -> None
    and CssProperty = 
        { Name:string
          Value:string }

    type StyleSheet = 
        { Blocks:CssBlock list }
        static member From blocks =
            { Blocks=blocks }
        member x.Block s =
            x.Blocks
            |> List.tryFind (fun b -> b.Selector = s)

    module Parser =
        open System
        open ParsingBase

        type Token = 
            | Selector of string
            | OpenBlock
            | CloseBlock
            | PropertyName of string
            | PropertyValue of string
            | Comment of string
            | Unmanaged of string

        type ReadContext =
            | InSelector
            | InPropertyName
            | InPropertyValue
        
        type State(txt) =
            inherit StateBase<Token,ReadContext>(txt, InSelector)
            member x.EmitSelector() = x.Contents |> Selector |> x.Emit
            member x.EmitOpenBlock() = x.Emit OpenBlock
            member x.EmitCloseBlock() = x.Emit CloseBlock
            member x.EmitPropertyName() = x.Contents |> PropertyName |> x.Emit
            member x.EmitPropertyValue() = x.Contents |> PropertyValue |> x.Emit
            member x.EmitComment() = 
                x.EmitWith (fun _ -> Comment(x.Contents.Substring(0, x.Contents.Length-2)))

        type public Tokenizer(stream) =
            inherit TokenizerBase<Token,ReadContext,State>(stream)
            override x.CreateState(reader) = State reader
            override x.StopParsing(_:State) = 
                // sometimes we want to stop a parsing after find a char or token.
                // but not here ...
                false
            override x.Accumulate(state:State) =
                let (|StartsWith|_|) (state:State,str:string) (c:char) =
                    match str.Length with
                    | 0 -> None
                    | 1 when c = str.Chars(0) -> Some()
                    | len -> 
                        let chars = state.Reader.PeekNChar len
                        let s = chars |> String
                        if s = str then Some() else None
                let toPattern f c = if f c then Some c else None
                let (|Whitespace|_|) = toPattern Char.IsWhiteSpace
                let (|LetterDigit|_|) = toPattern Char.IsLetterOrDigit
                let (|Letter|_|) = toPattern Char.IsLetter
                let (|SelectorChar|_|) (c:char) = 
                    if Char.IsLetterOrDigit c || (".>-_:()[=],#@".ToCharArray() |> Array.exists (fun i -> i = c) )
                    then Some c
                    else None

                let parseComment (state:State) =
                    state.Pop 2
                    while state.Contents.EndsWith "*/" |> not 
                        do state.Acc()
                    state.EmitComment()
                match (state.Peek(), state.Context) with
                | ':', InPropertyName ->
                    state.Pop(); state.EmitPropertyName()
                    state.SwithContext InPropertyValue
                | ';', InPropertyValue ->
                    state.Pop(); state.EmitPropertyValue()
                    state.SwithContext InPropertyName
                | StartsWith (state,"/*"), _ -> parseComment state
                | SelectorChar _, _ -> state.Acc()
                | Whitespace _, InSelector -> state.Acc()
                | '{', InSelector -> 
                    state.Pop(); state.EmitSelector()
                    state.EmitOpenBlock()
                    state.SwithContext InPropertyName
                | '}', InPropertyName
                | '}', InPropertyValue ->
                    state.Pop(); state.EmitCloseBlock()
                    state.SwithContext InSelector
                | _, InPropertyName -> state.Acc()
                | _, InPropertyValue -> state.Acc()
                | _ -> state.Pop(); state.ClearContent()
            
        let buildModel (tokens:Token list) =
            let (|CssProps|_|) (tail:Token list) = 
                let rec iterate (items:Token list) acc =
                    match items with
                    | PropertyName n :: PropertyValue v :: t ->
                        iterate t ((n,v) :: acc)
                    | CloseBlock :: t when acc.Length <= 0 -> None
                    | _ :: t -> Some (acc, t)
                    | _ -> None
                iterate tail []
            let rec loop (tail:Token list) acc = 
                match tail with
                | Selector s :: OpenBlock :: CssProps (props, t) ->
                    {Selector=s; Properties=(props |> List.map(fun (k,v) -> {Name=k;Value=v}))} :: acc
                    |> loop t
                | _ :: t -> loop t acc
                | [] -> acc |> List.rev
            loop tokens [] |> StyleSheet.From

        let tokenize stream =
            (Tokenizer stream).Parse()

        let parse stream = 
            let r = tokenize stream
            if r.Errors.Length > 0
            then Failure (r.Errors |> List.map (fun e -> e.Message))
            else Success <| buildModel r.Tokens

(**
Now we can try :)
*)
open System.IO
open System.Text
let css1 = 
    """
#smartbanner { position:absolute; left:0; top:-82px; 
    border-bottom:1px solid #e8e8e8; width:100%; height:78px; }
#smartbanner .sb-container { margin: 0 auto; }
#smartbanner .sb-close { position:absolute; left:5px; top:5px; 
    display:block; border:2px solid #fff; width:14px; 
    height:14px; font-family:'ArialRoundedMTBold',Arial; 
    font-size:15px; line-height:15px; text-align:center; color:#fff; 
    background:#070707; text-decoration:none; text-shadow:none; 
    border-radius:14px; box-shadow:0 2px 3px rgba(0,0,0,0.4); 
    -webkit-font-smoothing:subpixel-antialiased; }
#smartbanner .sb-close:active { font-size:13px; color:#aaa; }
#smartbanner .sb-icon { position:absolute; left:30px; top:10px; display:block; 
    width:57px; height:57px; background-color:white; background-size:cover; 
    border-radius:10px; box-shadow:0 1px 3px rgba(0,0,0,0.3); }
#smartbanner.no-icon .sb-icon { display:none; }
div.block1 {
    background-color: #661133;
    color: black;
}
    """
let stream = new MemoryStream(Encoding.UTF8.GetBytes css1)
let result = Css.Parser.parse stream