Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Rewrite template file parsing #660

Merged
merged 1 commit into from
Feb 26, 2015
Merged

Rewrite template file parsing #660

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion src/Paket.Core/PackageProcess.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,7 @@ let Pack(dependencies : DependenciesFile, packageOutputPath, buildConfig, versio
let missing =
[ if merged.Id = None then yield "Id"
if merged.Version = None then yield "Version"
if merged.Authors = None then yield "Authors"
if merged.Authors = None || merged.Authors = Some [] then yield "Authors"
if merged.Description = None then yield "Description" ]
|> fun xs -> String.Join(", ",xs)

Expand Down
221 changes: 130 additions & 91 deletions src/Paket.Core/TemplateFile.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,80 @@ open System.IO
open System.Text.RegularExpressions
open Paket.Rop
open Paket.Domain

module private TemplateParser =
type private ParserState =
{
Remaining : string list
Map : Map<string, string>
Line : int
}

let private single = Regex("^(\S+)\s*$", RegexOptions.Compiled)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

the module is already private. So I think we don't need the private here

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Different levels of private. Just stops namespace pollution when you're in the rest of TemplateFile.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Out of curiosity, why isn't the regex pattern a verbatim string? Shouldn't the backslashes be escaped? I'm no F# expert, so I could be totally wrong here.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think normal quotes work like in C#, so yes that might be a bug!?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In C#, it should definitely be Regex(@"^(\S+)\s*$") because \S should be passed to the regex engine, therefore you'd need "\\S" — or @"\S", of course.

(That's probably also why GitHub highlights \S and \s with a red background, since they're not control characters.)

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

care to send a fix?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's not a bug - it works correctly. It is pretty bad practice though :) . The @"..." version would be a much better idea, my bad.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I can tidy that up.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm surprised that it actually does work like this, but you're right, it's likely cleaner to properly escape the backslashes. Anyway, you got it covered. ;)

let private multi = Regex("^(\S+)\s+(\S.*)", RegexOptions.Compiled)

let private (!!) (i : int) (m : Match) =
m.Groups.[i].Value.Trim().ToLowerInvariant()

let private (|SingleToken|_|) line =
let m = single.Match line
match m.Success with
| true -> Some (!! 1 m)
| false -> None

let private (|MultiToken|_|) line =
let m = multi.Match line
match m.Success with
| true ->
Some (!! 1 m, m.Groups.[2].Value.Trim())
| false -> None

let private indented = Regex("^\s+(.*)", RegexOptions.Compiled)
let private (|Indented|_|) line =
let i = indented.Match line
match i.Success with
| true -> i.Groups.[1].Value.Trim() |> Some
| false -> None

let rec private indentedBlock acc i lines =
match lines with
| (Indented h)::t ->
indentedBlock (h::acc) (i + 1) t
| _ -> acc |> List.rev |> String.concat "\n", i, lines

let rec private inner state =
match state with
| { Remaining = [] } -> Choice1Of2 state.Map
| { Remaining = h::t } ->
match h with
| Indented _ -> Choice2Of2 <| sprintf "Indented block with no name line %d" state.Line
| MultiToken (key, value) ->
inner { state with
Remaining = t
Map = Map.add key value state.Map
Line = state.Line + 1 }
| SingleToken key ->
let value, line, remaining = indentedBlock [] state.Line t
if value = "" then
Choice2Of2 <| sprintf "No indented block following name '%s' line %d" key line
else
inner { state with
Remaining = remaining
Map = Map.add key value state.Map
Line = line }
| "" ->
inner { state with Line = state.Line + 1; Remaining = t }
| _ ->
Choice2Of2 <| sprintf "Invalid syntax line %d" state.Line

let parse (contents : string) =
inner {
Remaining =
contents.Split('\n')
|> Array.toList
Line = 1
Map = Map.empty
}

type internal CompleteCoreInfo =
{ Id : string
Expand Down Expand Up @@ -86,74 +160,43 @@ module internal TemplateFile =
| ProjectInfo(core, optional) -> ProjectInfo(core, { optional with ReleaseNotes = Some releaseNotes })
{ templateFile with Contents = contents }

let private (!<) prefix lines =
let singleLine str =
let regex = sprintf "^%s (?<%s>.*)" prefix prefix
let reg = Regex(regex, RegexOptions.Compiled ||| RegexOptions.CultureInvariant ||| RegexOptions.IgnoreCase)
if reg.IsMatch str then Some <| (reg.Match str).Groups.[prefix].Value
else None

let multiLine lines =
let rec findBody acc (lines : string list) =
match lines with
| h :: t when h.StartsWith " " -> findBody (h.Trim() :: acc) t
| _ ->
Some(acc
|> List.rev
|> String.concat Environment.NewLine)

let rec findStart lines =
match (lines : String list) with
| h :: t when h.ToLowerInvariant() = prefix.ToLowerInvariant() -> findBody [] t
| h :: t -> findStart t
| [] -> None

findStart lines

[ lines |> List.tryPick singleLine
multiLine lines ]
|> List.tryPick id

let private failP str = fail <| PackagingConfigParseError str

type private PackageConfigType =
| FileType
| ProjectType

let private parsePackageConfigType map =
let t' = Map.tryFind "type" map
t' |> function
| Some s ->
match s with
| "file" -> succeed FileType
| "project" -> succeed ProjectType
| s -> failP (sprintf "Unknown package config type.")
| None -> failP (sprintf "First line of paket.package file had no 'type' declaration.")

let private parsePackageConfigType contents =
match contents with
| firstLine :: _ ->
let t' = (!<) "type" [ firstLine ]
t' |> function
| Some s ->
match s with
| "file" -> succeed FileType
| "project" -> succeed ProjectType
| s -> failP (sprintf "Unknown package config type.")
| None -> failP (sprintf "First line of paket.package file had no 'type' declaration.")
| [] -> failP "Empty paket.template file."

let private getId lines =
(!<) "id" lines |> function
let private getId map =
Map.tryFind "id" map |> function
| Some m -> succeed <| m
| None -> failP "No id line in paket.template file."

let private getAuthors lines =
(!<) "authors" lines |> function
let private getAuthors (map : Map<string, string>) =
Map.tryFind "authors" map |> function
| Some m ->
m.Split ','
|> Array.map (fun s -> s.Trim())
|> List.ofArray
|> succeed
| None -> failP "No authors line in paket.template file."

let private getDescription lines =
(!<) "description" lines |> function
let private getDescription map =
Map.tryFind "description" map |> function
| Some m -> succeed m
| None -> failP "No description line in paket.template file."

let private getDependencies lines =
(!<) "dependencies" lines
let private getDependencies (map : Map<string, string>) =
Map.tryFind "dependencies" map
|> Option.map (fun d -> d.Split '\n')
|> Option.map (Array.map (fun d ->
let reg = Regex(@"(?<id>\S+)(?<version>.*)").Match d
Expand All @@ -167,8 +210,8 @@ module internal TemplateFile =
let private fromReg = Regex("from (?<from>.*)", RegexOptions.Compiled)
let private toReg = Regex("to (?<to>.*)", RegexOptions.Compiled)

let private getFiles lines =
(!<) "files" lines
let private getFiles (map : Map<string, string>) =
Map.tryFind "files" map
|> Option.map (fun d -> d.Split '\n')
|> Option.map
(Seq.map
Expand All @@ -181,39 +224,39 @@ module internal TemplateFile =
|> Option.map List.ofSeq
|> fun x -> defaultArg x []

let private getOptionalInfo configLines =
let title = (!<) "title" configLines
let private getOptionalInfo (map : Map<string, string>) =
let title = Map.tryFind "title" map

let owners =
(!<) "owners" configLines
Map.tryFind "owners" map
|> Option.map (fun o ->
o.Split(',')
|> Array.map (fun o -> o.Trim())
|> Array.toList)
|> fun x -> defaultArg x []

let releaseNotes = (!<) "releaseNotes" configLines
let summary = (!<) "summary" configLines
let language = (!<) "language" configLines
let projectUrl = (!<) "projectUrl" configLines
let iconUrl = (!<) "iconUrl" configLines
let licenseUrl = (!<) "licenseUrl" configLines
let copyright = (!<) "copyright" configLines
let releaseNotes = Map.tryFind "releaseNotes" map
let summary = Map.tryFind "summary" map
let language = Map.tryFind "language" map
let projectUrl = Map.tryFind "projectUrl" map
let iconUrl = Map.tryFind "iconUrl" map
let licenseUrl = Map.tryFind "licenseUrl" map
let copyright = Map.tryFind "copyright" map
let requireLicenseAcceptance =
match (!<) "requireLicenseAcceptance" configLines with
match Map.tryFind "requireLicenseAcceptance" map with
| Some x when x.ToLower() = "true" -> true
| _ -> false

let tags =
(!<) "tags" configLines
Map.tryFind "tags" map
|> Option.map (fun t ->
t.Split ' '
|> Array.map (fun t -> t.Trim())
|> Array.toList)
|> fun x -> defaultArg x []

let developmentDependency =
match (!<) "developmentDependency" configLines with
match Map.tryFind "developmentDependency" map with
| Some x when x.ToLower() = "true" -> true
| _ -> false

Expand All @@ -229,48 +272,44 @@ module internal TemplateFile =
RequireLicenseAcceptance = requireLicenseAcceptance
Tags = tags
DevelopmentDependency = developmentDependency
Dependencies = getDependencies configLines
Files = getFiles configLines }
Dependencies = getDependencies map
Files = getFiles map }

let Parse(contentStream : Stream) =
rop {
let configLines =
use sr = new StreamReader(contentStream, System.Text.Encoding.UTF8)

let rec inner (s : StreamReader) =
seq {
let line = s.ReadLine()
if line <> null then
yield line
yield! inner s
}
inner sr |> Seq.toList
let! type' = parsePackageConfigType configLines
let sr = new StreamReader(contentStream)
let! map =
match TemplateParser.parse (sr.ReadToEnd()) with
| Choice1Of2 m -> succeed m
| Choice2Of2 f -> failP f
sr.Dispose()
let! type' = parsePackageConfigType map
match type' with
| ProjectType ->
let core : ProjectCoreInfo =
{ Id = (!<) "id" configLines
Version = (!<) "version" configLines |> Option.map SemVer.Parse
{ Id = Map.tryFind "id" map
Version = Map.tryFind "version" map |> Option.map SemVer.Parse
Authors =
(!<) "authors" configLines |> Option.map (fun s ->
s.Split(',')
|> Array.map (fun s -> s.Trim())
|> Array.toList)
Description = (!<) "description" configLines }
Map.tryFind "authors" map
|> Option.map (fun s ->
s.Split(',')
|> Array.map (fun s -> s.Trim())
|> Array.toList)
Description = Map.tryFind "description" map }

let optionalInfo = getOptionalInfo configLines
let optionalInfo = getOptionalInfo map
return ProjectInfo(core, optionalInfo)
| FileType ->
let! id' = getId configLines
let! authors = getAuthors configLines
let! description = getDescription configLines
let! id' = getId map
let! authors = getAuthors map
let! description = getDescription map
let core : CompleteCoreInfo =
{ Id = id'
Version = (!<) "version" configLines |> Option.map SemVer.Parse
Version = Map.tryFind "version" map |> Option.map SemVer.Parse
Authors = authors
Description = description }

let optionalInfo = getOptionalInfo configLines
let optionalInfo = getOptionalInfo map
return CompleteInfo(core, optionalInfo)
}

Expand Down
4 changes: 2 additions & 2 deletions src/Paket/Paket.fsproj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,10 +27,10 @@
<WarningLevel>3</WarningLevel>
<DocumentationFile>
</DocumentationFile>
<StartArguments>update</StartArguments>
<StartArguments>pack output temp version 1.0.0.0</StartArguments>
<StartAction>Project</StartAction>
<StartProgram>paket.exe</StartProgram>
<StartWorkingDirectory>d:\code\Paket09x</StartWorkingDirectory>
<StartWorkingDirectory>c:\rip\FSharpx.Async</StartWorkingDirectory>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
Expand Down
32 changes: 17 additions & 15 deletions tests/Paket.Tests/TemplateFileParsing.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ let FileBasedLongDesc = """type file
id My.Thing
version 1.0
authors Bob McBob
description
description
A longer description
on two lines.
"""
Expand Down Expand Up @@ -115,24 +115,26 @@ description A short description

[<Literal>]
let DescriptionTest = """type project
id
15below.TravelStatus.CommonMessages
title
15below.TravelStatus.CommonMessages
authors
15below
owners
15below
requireLicenseAcceptance
false
description
Common messages for Travel Status
Thomas Petricek, David Thomas, Ryan Riley, Steffen Forkmann
authors
Thomas Petricek, David Thomas, Ryan Riley, Steffen Forkmann
projectUrl
https://github.com/15below/Pasngr.TravelStatus/tree/master/src/15below.TravelStatus.CommonMessages
http://fsprojects.github.io/FSharpx.Async/
iconUrl
https://si0.twimg.com/profile_images/3046082295/a10bd2175096bd5faebbd8285e319d54_bigger.png
http://fsprojects.github.io/FSharpx.Async/img/logo.png
licenseUrl
http://fsprojects.github.io/FSharpx.Async/license.html
requireLicenseAcceptance
false
copyright
Copyright 2013
Copyright 2015
tags
F#, async, fsharpx
summary
Async extensions for F#
description
Async extensions for F#

"""

Expand Down