Usecase of Variants in Purescript/Haskell - functional-programming

Can someone tell me what is the use case of purescript-variants or variants in general
The documentation is very well written but I can't find any real use case scenario for it. Can someone tell how we could use Variants in real world?

Variants are duals of records. While records are sort of extensible ad-hoc product types (consider data T = T Int String vs. type T = { i :: Int, s :: String }), variants can be seen as extensible ad-hoc sum types - e.g. data T = A Int | B String vs. Variant (a :: Int, b :: String)
For example, just as you can write a function that handles a partial record:
fullName :: forall r. { first :: String, last :: String | r } -> String
fullName r = r.first <> " " <> r.last
myFullName = fullName { first: "Fyodor", last: "Soikin", weight: "Too much" }
so too, you can write a function that handles a partial variant:
weight :: forall r. Variant (kilos :: Int, vague :: String | r) -> String
weight =
default "Unknown"
# on _kilos (\n -> show n <> " kg.")
# on _vague (\s -> "Kind of a " <> s)
myWeight = weight (inj _kilos 100) -- "100 kg."
alsoMyWeight = weight (inj _vague "buttload") -- "Kind of a buttload"
But these are, of course, toy examples. For a less toy example, I would imagine something that handles alternatives, but needs to be extensible. Perhaps something like a file parser:
data FileType a = Json | Xml
basicParser :: forall a. FileType a -> String -> Maybe a
basicParser t contents = case t of
Json -> parseJson contents
Xml -> parseXml contents
Say I'm ok using this parser in most case, but in some cases I'd also like to be able to parse YAML. What do I do? I can't "extend" the FileType sum type post-factum, the best I can do is aggregate it in a larger type:
data BetterFileType a = BasicType (FileType a) | Yaml
betterParser :: forall a. BetterFileType a -> String -> Maybe a
betterParser t contents = case t of
BasicType bt -> basicParser bt contents
Yaml -> parseYaml contents
And now whenever I call the "better parser", I have to wrap the file type awkwardly:
result = betterParser (BasicType Json) "[1,2,3]"
Worse: now every consumer has to know the hierarchy of BetterFileType -> FileType, they can't just say "json", they have to know to wrap it in BasicType. Awkward.
But if I used extensible variants for the file type, I could have flattened them nicely:
type FileType r = (json :: String, xml :: String | r)
basicParser :: forall a r. Variant (FileType r) -> Maybe a
basicParser = onMatch { json: parseJson, xml: parseXml } $ default Nothing
----
type BetterFileType r = (yaml :: String | FileType r)
betterParser :: forall a r. Variant (BetterFileType r) -> Maybe a
betterParser = onMatch { yaml: parseYaml } basicParser
Now I can use the naked variant names with either basicParser or betterParser, without knowing to wrap them or not:
r1 = betterParser $ inj _json "[1,2,3]"
r2 = betterParser $ inj _yaml "foo: [1,2,3]"

Related

How to convert a string to integer list in ocaml?

I need to pass two list as command line arguments in ocaml.
I used the following code to access it in the program.
let list1=Sys.argv.(1);;
let list2=Sys.argv.(2);;
I need to have the list1 and list2 as list of integers.
I am getting the error
This expression has type string but an expression was expected of type
int list
while processing.
How can I convert that arguments to a list of integers.
The arguments are passed in this format [1;2;3;4] [1;5;6;7]
Sys.argv.(n) will always be a string. You need to parse the string into a list of integers. You could try something like this:
$ ocaml
OCaml version 4.01.0
# #load "str.cma";;
# List.map int_of_string (Str.split (Str.regexp "[^0-9]+") "[1;5;6;7]");;
- : int list = [1; 5; 6; 7]
Of course this doesn't check the input for correct form. It just pulls out sequences of digits by brute force. To do better you need to do some real lexical analysis and simple parsing.
(Maybe this is obvious, but you could also test your function in the toplevel (the OCaml read-eval-print loop). The toplevel will handle the work of making a list from what you type in.)
As Sys.argv is a string array, you need to write your own transcription function.
I guess the simplest way to do this is to use the Genlex module provided by the standard library.
let lexer = Genlex.make_lexer ["["; ";"; "]"; ]
let list_of_string s =
let open Genlex in
let open Stream in
let stream = lexer (of_string s) in
let fail () = failwith "Malformed string" in
let rec aux acc =
match next stream with
| Int i ->
( match next stream with
| Kwd ";" -> aux (i::acc)
| Kwd "]" -> i::acc
| _ -> fail () )
| Kwd "]" -> acc
| _ -> fail ()
in
try
match next stream with
| Kwd "[" -> List.rev (aux [])
| _ -> fail ()
with Stream.Failure -> fail ()
let list1 = list_of_string Sys.argv.(1)
let list2 = list_of_string Sys.argv.(2)
Depending on the OCaml flavor you want to use, some other library may look more interesting. If you like yacc, Menhir may solve your problem in a few lines of code.

F#, FParsec, and Calling a Stream Parser Recursively, Second Take

Thank you for the replies to my first post and my second post on this project. This question is basically the same question as the first, but with my code updated according to the feedback received on those two questions. How do I call my parser recursively?
I'm scratching my head and staring blankly at the code. I've no idea where to go from here. That's when I turn to stackoverflow.
I've included in code comments the compile-time errors I'm receiving. One stumbling block may be my discriminated union. I've not worked with discriminated unions much, so I may be using mine incorrectly.
The example POST I'm working with, bits of which I've included in my previous two questions, consists of one boundary that includes a second post with a new boundary. That second post includes several additional parts separated by the second boundary. Each of those several additional parts is a new post consisting of headers and XML.
My goal in this project is to build a library to be used in our C# solution, with the library taking a stream and returning the POST parsed into headers and parts recursively. I really want F# to shine here.
namespace MultipartMIMEParser
open FParsec
open System.IO
type Header = { name : string
; value : string
; addl : (string * string) list option }
type Content = Content of string
| Post of Post list
and Post = { headers : Header list
; content : Content }
type UserState = { Boundary : string }
with static member Default = { Boundary="" }
module internal P =
let ($) f x = f x
let undefined = failwith "Undefined."
let ascii = System.Text.Encoding.ASCII
let str cs = System.String.Concat (cs:char list)
let makeHeader ((n,v),nvps) = { name=n; value=v; addl=nvps}
let runP p s = match runParserOnStream p UserState.Default "" s ascii with
| Success (r,_,_) -> r
| Failure (e,_,_) -> failwith (sprintf "%A" e)
let blankField = parray 2 newline
let delimited d e =
let pEnd = preturn () .>> e
let part = spaces
>>. (manyTill
$ noneOf d
$ (attempt (preturn () .>> pstring d)
<|> pEnd)) |>> str
in part .>>. part
let delimited3 firstDelimiter secondDelimiter thirdDelimiter endMarker =
delimited firstDelimiter endMarker
.>>. opt (many (delimited secondDelimiter endMarker
>>. delimited thirdDelimiter endMarker))
let isBoundary ((n:string),_) = n.ToLower() = "boundary"
let pHeader =
let includesBoundary (h:Header) = match h.addl with
| Some xs -> xs |> List.exists isBoundary
| None -> false
let setBoundary b = { Boundary=b }
in delimited3 ":" ";" "=" blankField
|>> makeHeader
>>= fun header stream -> if includesBoundary header
then
stream.UserState <- setBoundary (header.addl.Value
|> List.find isBoundary
|> snd)
Reply ()
else Reply ()
let pHeaders = manyTill pHeader $ attempt (preturn () .>> blankField)
let rec pContent (stream:CharStream<UserState>) =
match stream.UserState.Boundary with
| "" -> // Content is text.
let nl = System.Environment.NewLine
let unlines (ss:string list) = System.String.Join (nl,ss)
let line = restOfLine false
let lines = manyTill line $ attempt (preturn () .>> blankField)
in pipe2 pHeaders lines
$ fun h c -> { headers=h
; content=Content $ unlines c }
| _ -> // Content contains boundaries.
let b = "--" + stream.UserState.Boundary
// VS complains about pContent in the following line:
// Type mismatch. Expecting a
// Parser<'a,UserState>
// but given a
// CharStream<UserState> -> Parser<Post,UserState>
// The type 'Reply<'a>' does not match the type 'Parser<Post,UserState>'
let p = pipe2 pHeaders pContent $ fun h c -> { headers=h; content=c }
in skipString b
>>. manyTill p (attempt (preturn () .>> blankField))
// VS complains about Content.Post in the following line:
// Type mismatch. Expecting a
// Post list -> Post
// but given a
// Post list -> Content
// The type 'Post' does not match the type 'Content'
|>> Content.Post
// VS complains about pContent in the following line:
// Type mismatch. Expecting a
// Parser<'a,UserState>
// but given a
// CharStream<UserState> -> Parser<Post,UserState>
// The type 'Reply<'a>' does not match the type 'Parser<Post,UserState>'
let pStream = runP (pipe2 pHeaders pContent $ fun h c -> { headers=h; content=c })
type MParser (s:Stream) =
let r = P.pStream s
let findHeader name =
match r.headers |> List.tryFind (fun h -> h.name.ToLower() = name) with
| Some h -> h.value
| None -> ""
member p.Boundary =
let header = r.headers
|> List.tryFind (fun h -> match h.addl with
| Some xs -> xs |> List.exists P.isBoundary
| None -> false)
in match header with
| Some h -> h.addl.Value |> List.find P.isBoundary |> snd
| None -> ""
member p.ContentID = findHeader "content-id"
member p.ContentLocation = findHeader "content-location"
member p.ContentSubtype = findHeader "type"
member p.ContentTransferEncoding = findHeader "content-transfer-encoding"
member p.ContentType = findHeader "content-type"
member p.Content = r.content
member p.Headers = r.headers
member p.MessageID = findHeader "message-id"
member p.MimeVersion = findHeader "mime-version"
EDIT
In response to the feedback I've received thus far (thank you!), I made the following adjustments, receiving the errors annotated:
let rec pContent (stream:CharStream<UserState>) =
match stream.UserState.Boundary with
| "" -> // Content is text.
let nl = System.Environment.NewLine
let unlines (ss:string list) = System.String.Join (nl,ss)
let line = restOfLine false
let lines = manyTill line $ attempt (preturn () .>> blankField)
in pipe2 pHeaders lines
$ fun h c -> { headers=h
; content=Content $ unlines c }
| _ -> // Content contains boundaries.
let b = "--" + stream.UserState.Boundary
// The following complaint is about `pContent stream`:
// This expression was expected to have type
// Reply<'a>
// but here has type
// Parser<Post,UserState>
let p = pipe2 pHeaders (fun stream -> pContent stream) $ fun h c -> { headers=h; content=c }
in skipString b
>>. manyTill p (attempt (preturn () .>> blankField))
// VS complains about the line above:
// Type mismatch. Expecting a
// Parser<Post,UserState>
// but given a
// Parser<'a list,UserState>
// The type 'Post' does not match the type ''a list'
// See above complaint about `pContent stream`. Same complaint here.
let pStream = runP (pipe2 pHeaders (fun stream -> pContent stream) $ fun h c -> { headers=h; content=c })
I tried throwing in Reply ()s, but they just returned parsers, meaning c above became a Parser<...> rather than Content. That seemed to have been a step backwards, or at least in the wrong direction. I admit my ignorance, though, and welcome correction!
I can help with one of the errors.
F# generally binds arguments left to right, so you need to use either parentheses around the recursive calls to pContent or a pipe-backward operator <| to show that you want to evaluate the recursive call and bind the return value.
It's also worth noting that <| is the same as your $ operator.
Content.Post is not a constructor for a Post object. You need a function to accept a Post list and return a Post. (Does something from the List module do what you need?)
My first answer was completely wrong, but I'd thought I'd leave it up.
The types Post and Content are defined as:
type Content =
| Content of string
| Post of Post list
and Post =
{ headers : Header list
; content : Content }
Post is a Record, and Content is a Discriminated Union.
F# treats the cases for Discriminated Unions as a separate namespace from types. So Content is different from Content.Content, and Post is different from Content.Post. Because they are different, having the same identifier is confusing.
What is pContent supposed to be returning? If it's supposed to be returning the Discriminated Union Content, you need to wrap the Post record you are returning in the first case in the Content.Post case i.e.
$ fun h c -> Post [ { headers=h
; content=Content $ unlines c } ]
(F# is able to infer that 'Post' refers to Content.Post case, instead of the Post record type here.)

Eff monad demands row with Debug.Trace.Trace

I am writing bindings from History.js into PureScript and still struggling to understand the Eff monad, what a row of effects are and why they are valuable. Right now I have the following written with EasyFFI
type Title = String
type Url = String
type State = forall a. {title :: Title, url :: Url | a}
type Data = forall a. { | a}
type StateUpdater = Data -> Title -> Url -> Unit
-- this function is a work around for 'data' as a reserved word.
foreign import getData
"function getData(state){ return state['data']; }"
:: forall a b. { | a} -> b
unwrapState :: StateUpdater -> State -> Unit
unwrapState f s = f (getData s) s.title s.url
replaceState' :: StateUpdater
replaceState' = unsafeForeignProcedure ["data","title","url"] "History.replaceState(data,title,url)"
replaceState :: State -> Unit
replaceState = unwrapState replaceState'
foreign import data BeforeEach :: !
beforeEach :: forall e a. Eff e a -> Eff (beforeEach :: BeforeEach | e) Unit
beforeEach = unsafeForeignProcedure ["fn",""] "window.beforeEach(fn);"
Later in the code I have the following:
beforeEach $ do
replaceState {title = "wowzers!", url = "/foos"}
and get the following error
Cannot unify Prelude.Unit with Control.Monad.Eff.Eff u2518 u2517.
I've tried manipulating the type signatures in various ways to try and make it all line up, but I don't really understand what is going wrong. So its just guessing at this point.
My modified version of your code is at the end of this post, but I had to make a few modifications in order to make it compile:
I assume the intention was for your StateUpdater to have an effect on the browser history, so I changed its type to use the Eff monad with a new History effect type. This was the main problem, since your last line used replaceState whose result type is not in the Eff monad. This resulted in the type error you saw.
I moved some of the universally quantified type variables in your type synonyms into function types. I also removed your Data type synonym and moved the data content into a new data field in the State type.
This is important, because your previous Data type had no inhabitants. There is a common misconception (for reasons I do not understand) that forall a. { | a} is a type of records "where I don't care about the fields". That is incorrect - this type represents the type of records which contains all fields which could possibly exist, and such a type is clearly uninhabited. There is an important difference between forall a. {| a} -> r and (forall a. {| a}) -> r from the point of view of the caller.
In answer to your original question: "what is a row of effects, and why are they useful?" - rows were originally added to PureScript to deal with polymorphism on record types without having to resort to subtyping. Rows allow us to give polymorphic types to functions which use records, in such a way that we can capture "the rest of the record" as a concept in the type system.
Rows also turned out to be a useful concept when dealing with effects. Just like we don't care what the rest of a record is, we usually don't care what the rest of a set of effects looks like, so long as all effects get propagated correctly in the type system.
To give an example, there are two effects involved in my modified code: History, and your BeforeEach. The actions beforeEach and replaceState each only use one of these effects, but their return types are polymorphic. This allows the combination of the two functions in main to have both effects, and type correctly. main has type forall eff. Eff (history :: History, beforeEach :: BeforeEach | eff) {} which is the most general type, inferred by the type checker.
In short, rows in the effect system provide a neat way to handle the interleaving of various "native" effects, so that the developer does not have to worry about things like the order of effects or lifting computations à la mtl.
module Main where
import EasyFFI
import Control.Monad.Eff
type Title = String
type Url = String
type State d = { title :: Title, url :: Url, "data" :: { | d } }
type StateUpdater d = forall eff. { | d } -> Title -> Url -> Eff (history :: History | eff) {}
foreign import data History :: !
unwrapState :: forall eff d. StateUpdater d -> State d -> Eff (history :: History | eff) {}
unwrapState f s = f s."data" s.title s.url
replaceState' :: forall d. StateUpdater d
replaceState' = unsafeForeignProcedure ["d","title","url"] "History.replaceState(d,title,url)"
replaceState :: forall eff d. State d -> Eff (history :: History | eff) {}
replaceState = unwrapState replaceState'
foreign import data BeforeEach :: !
beforeEach :: forall e a. Eff e a -> Eff (beforeEach :: BeforeEach | e) {}
beforeEach = unsafeForeignProcedure ["fn",""] "window.beforeEach(fn);"
main = beforeEach $ do
replaceState { title: "wowzers!", url: "/foos", "data": {} }

Unicode text from SQLite database seems to be broken

I'm using http://hackage.haskell.org/package/sqlite-0.5.2.2 for binding to SQLite database. Inside *.db file there is text in UTF-8 encoding, I can assure this in text editor and sqlite CLI tool.
When connecting to database and retrieving data - the text content is broken. The simple test goes below:
import qualified Database.SQLite as SQL
import Control.Applicative ((<$>))
import System.IO
buildSkypeMessages dbh =
(go <$> (SQL.execStatement dbh "select chatname,author,timestamp,body_xml from messages order by chatname, timestamp")) >>=
writeIt
where
writeIt content = withFile "test.txt" WriteMode (\handle -> mapM_ (\(c:a:t:[]) -> hPutStrLn handle c) content)
go (Left msg) = fail msg
go (Right rows) = map f $ concat rows
where
f' (("chatname",SQL.Text chatname):
("author",SQL.Text author):
("timestamp",SQL.Int timestamp):
r) = ([chatname, author], r)
f xs = let (partEntry, (item:_)) = f' xs
in case item of
("body_xml",SQL.Text v) -> v:partEntry
("body_xml",SQL.Null) -> "":partEntry
escape (_,SQL.Text v) = v
escape (_,SQL.Null) = ""
escape (_,SQL.Int v) = show v
What may be wrong there? Am I missing something with Sqlite or with Haskell I/O and encodings?
Actually the problem was not related to SQLite bindings but to String handling in Haskell. What solved the problem - invoking hSetBinaryMode on handle before putting data on it:
writeIt content = withFile "test.txt" WriteMode (\handle -> hSetBinaryMode handle True >> mapM_ (\(c:a:t:[]) -> hPutStrLn handle c) content)

f# types' properties in inconsistent order and of slightly differing types

I'm trying to iterate through an array of objects and recursively print out each objects properties.
Here is my object model:
type firmIdentifier = {
firmId: int ;
firmName: string ;
}
type authorIdentifier = {
authorId: int ;
authorName: string ;
firm: firmIdentifier ;
}
type denormalizedSuggestedTradeRecommendations = {
id: int ;
ticker: string ;
direction: string ;
author: authorIdentifier ;
}
Here is how I am instantiating my objects:
let getMyIdeasIdeas = [|
{id=1; ticker="msfqt"; direction="buy";
author={authorId=0; authorName="john Smith"; firm={firmId=12; firmName="Firm1"}};};
{id=2; ticker="goog"; direction="sell";
author={authorId=1; authorName="Bill Jones"; firm={firmId=13; firmName="ABC Financial"}};};
{id=3; ticker="DFHF"; direction="buy";
author={authorId=2; authorName="Ron James"; firm={firmId=2; firmName="DEFFirm"}};}|]
And here is my algorithm to iterate, recurse and print:
let rec recurseObj (sb : StringBuilder) o=
let props : PropertyInfo [] = o.GetType().GetProperties()
sb.Append( o.GetType().ToString()) |> ignore
for x in props do
let getMethod = x.GetGetMethod()
let value = getMethod.Invoke(o, Array.empty)
ignore <|
match value with
| :? float | :? int | :? string | :? bool as f -> sb.Append(x.Name + ": " + f.ToString() + "," ) |> ignore
| _ -> recurseObj sb value
for x in getMyIdeas do
recurseObj sb x
sb.Append("\r\n") |> ignore
If you couldnt tell, I'm trying to create a csv file and am printing out the types for debugging purposes. The problem is, the first element comes through in the order you'd expect, but all subsequent elements come through with a slightly different (and confusing) ordering of the "child" properties like so:
RpcMethods+denormalizedSuggestedTradeRecommendationsid:
1,ticker: msfqt,direction:
buy,RpcMethods+authorIdentifierauthorId:
0,authorName: john
Smith,RpcMethods+firmIdentifierfirmId:
12,firmName: Firm1,
RpcMethods+denormalizedSuggestedTradeRecommendationsid:
2,ticker: goog,direction:
sell,RpcMethods+authorIdentifierauthorName:
Bill
Jones,RpcMethods+firmIdentifierfirmName:
ABC Financial,firmId: 13,authorId: 1,
RpcMethods+denormalizedSuggestedTradeRecommendationsid:
3,ticker: DFHF,direction:
buy,RpcMethods+authorIdentifierauthorName:
Ron
James,RpcMethods+firmIdentifierfirmName:
DEFFirm,firmId: 2,authorId: 2,
Any idea what is going on here?
Does adding this help?
for x in props |> Array.sortBy (fun p -> p.Name) do
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
In general, I think reflection returns entities (like attributes, methods, properties) in an unspecified order. So just pick a fixed sort order?
(Or did I misunderstand the issue?)
This is a reflection thing. You can't rely on the order of the properties using reflection. I need to sort using MetaTokens. I will post this solution when I get around to implementing it.

Resources