As ever, neat ideas coded in Haskell can be almost but not quite ported to F#, foiled at the last moment by the fact that the .net type system cannot represent constructs that are expressed as Haskell type classes : there's always a run-time type coercion and some leakage of abstractions that have to be coded around.
One such is this idea of type-safe strings for representing structured data like XML -- which would require a little more mutually recursive and self-encapsulating type definitions than I think F# can manage. It gets close, though, and could probably be embellished a little further:
I got to this from PlanetF# and decided to play with it a little.
ReplyDeleteI was able to get rid of the SafeStringBase and the # types by making the ILanguage interface generic, adding some type constraints to SafeString.
Instead, the Xml type has to inherit from SafeString and has to define a constructor explicitly. However, I think this solution is a little close to Haskell type classes.
Sorry I don't know how to paste it as code so will put it here just as plain text.
#light
open System
module TypeStrings =
let rec foldr f z l =
match l with
| [] -> z
| x::xs -> f x (foldr f z xs)
type ILanguage<'T when 'T :> ILanguage<'T>> =
abstract member LiteralFragment : String -> 'T // String is a literal language fragment
abstract member LiteralText : String -> 'T // String is literal text
abstract member NativeRepresentation : 'T -> String // Gets the native-language representation
abstract member Language : unit -> String // Gets the name of the language
abstract member Empty : unit -> 'T // creates an empty SafeString in the Language
abstract member Add : 'T -> 'T -> 'T
type SafeString<'TLanguage when 'TLanguage :> ILanguage<'TLanguage> and 'TLanguage :> SafeString<'TLanguage> and 'TLanguage : (new : unit -> 'TLanguage) > (content: String) =
static let language : 'TLanguage = new 'TLanguage()
static member Empty : SafeString<'TLanguage> =
language.Empty() :> SafeString<'TLanguage>
static member Fragment fragment =
language.LiteralFragment fragment :> SafeString<'TLanguage>
static member Text text =
language.LiteralText text :> SafeString<'TLanguage>
static member Join (strings : seq<'TLanguage>) =
let l = Seq.toList strings
(foldr language.Add (language.Empty()) l) :> SafeString<'TLanguage>
static member Lang with get() = language
static member (+) ((self: SafeString<'TLanguage>), (other: SafeString<'TLanguage>)) : SafeString<'TLanguage> =
// don't think you can get rid of the down cast here
(language.Add (self :?> 'TLanguage) (other :?> 'TLanguage)) :> SafeString<'TLanguage>
member this.AsString with get() = content
type Xml (content: String) =
inherit SafeString(content)
// this is a required hack
new () = Xml("")
interface ILanguage with
member self.LiteralFragment s = new Xml(s)
member self.LiteralText s = new Xml(System.Security.SecurityElement.Escape(s))
member self.NativeRepresentation s =
s.AsString.Replace("'", "'").
Replace(""", "\"").Replace(">", ">").
Replace("<", "<").Replace("&", "&")
member self.Language () = "XML"
member self.Empty () = new Xml(String.Empty)
member self.Add x y = (new Xml(x.AsString + y.AsString))
[]
let main a =
let frag = SafeString.Fragment "wow!"
printfn "%s" frag.AsString
let text = SafeString.Text "ham & eggs"
printfn "%s" text.AsString
let sum = frag + text
printfn "%s" sum.AsString
0