I have a basic append function
let append item list = item :: list
And i have a' list option and option Some("something")
let listOption = Some []
I want to add the value "something" to listOption. How can I do it without using pattern matching and Option.get but by lifting append function?
Any help would be appreciated
You can use maybe computation expression
type MaybeBuilder() =
member this.Bind(m, f) = Option.bind f m
member this.Return(x) = Some x
let maybe = new MaybeBuilder()
let append item list = item :: list
let appendLifted item list =
maybe {
let! l = list
let! i = item
return append i l
}
[<EntryPoint>]
let main argv =
appendLifted (Some "abc") (Some [])
0
It looks like a home work...
If you want to add a value (not an option) at the head of a list option, you can simply do this which will return None if the list option is None:
let liftedAppend item optList =
optList |> Option.bind (fun list -> Some (item :: list))
liftedAppend signature is:
'a -> 'a list option -> 'a list option
But talking about lifting stricto sensu, as the signature of your append function is:
'a -> 'a list -> 'a list
the signature of the lifted function should be:
'a option -> 'a list option -> 'a list option
That means the first argument have to be an option and I guess you want to check if it's Some or None. If so attentively read other's replies.
You can use something like this, which the de-sugared Lanayx's computation expression.
let liftedAppend optItem optList =
optList |> Option.bind (fun list ->
optItem |> Option.bind (fun item -> Some (item :: list)))
This works:
listOption
|> Option.map (append 11)
|> printfn "%A" // Some [11]
but to create a lifted append:
let liftedAppend v = Option.map (append v)
listOption
|> liftedAppend 11
|> printfn "%A" // Some [11]
The signature of the functions are:
val append : 'a -> 'a list > 'a list
val liftedAppend: 'a -> 'a list option -> 'a list option
To pass both parameters as options you can use Option.map2:
let liftedAppend2 vO = vO |> Option.map2 append
listOption
|> liftedAppend2 (Some 11)
|> printfn "%A" // Some [11]
Which has signature:
val liftedAppend2: a option -> 'a list option -> 'a list option
Related
Is there an easy way to make Json.Decode case insensitive in elm (0.18)?
decodeDepartmentDate : Json.Decode.Decoder DepartmentDate
decodeDepartmentDate =
Json.Decode.map6 DepartmentDate
(field "nameOfDay" Json.Decode.string)
(field "orderDate" Convert.datePart)
(field "mealTimeID" Json.Decode.string)
(field "mealTime" Json.Decode.string)
(field "departmentID" Json.Decode.string)
(field "department" Json.Decode.string)
I want to be able to use the same elm SPA against multiple back ends and avoid issues like this by default:
BadPayload "Expecting an object with a field named `nameOfDay` at _[11]
but instead got: {\"NameOfDay\":\"Wednesday\",\"OrderDate\":\"2018-09-05T00:00:00\",
\"MealTimeID\":\"546ccee0-e070-403e-a15b-63f4e1366054\",\"MealTime\":\"All Day\",
\"StartTime\":\"2018/06/05 05:04:38\",\"DepartmentID\":\"066a1c9f-97da-487e-b82f-f933b159c042\",
\"Department\":\"Side walk\"}"
Thanks
As far as I'm aware, there's no ready-made solution for doing so. But you can make your own!
The easiest way is probably to just generate the different casings and make your own field decoder using oneOf:
myField name decoder =
Decode.oneOf
[ Decode.field name decoder
, Decode.field (String.toLower) decoder
]
Another approach would be to decode the object as key/value pairs without decoding the values, transforming the keys and then re-encoding it to be able to use the existing JSON decoders on it:
lowerCaseKeys =
Decode.keyValuePairs Decode.value
|> Decode.map (List.map (\(key, value) -> (String.toLower key, value)))
|> Decode.map (Encode.object)
But since the value is now wrapped in a Decoder you'd have to use decodeValue on that and ultimately end up with a double-wrapped Result, which isn't very nice. I might be missing some elegant way of making this work though.
Instead it seems better to not re-encode it, but just make your own field decoder to work on the dict. This will also allow you to ignore casing on the keys you specify.
lowerCaseKeys : Decode.Decoder (Dict.Dict String Decode.Value)
lowerCaseKeys =
Decode.keyValuePairs Decode.value
|> Decode.map (List.map (\( key, value ) -> ( String.toLower key, value )))
|> Decode.map Dict.fromList
myField : String -> Decode.Decoder a -> Dict.Dict String Decode.Value -> Decode.Decoder a
myField name decode dict =
case Dict.get (String.toLower name) dict of
Just value ->
case Decode.decodeValue decode value of
Ok v ->
Decode.succeed v
Err e ->
e |> Decode.errorToString |> Decode.fail
Nothing ->
Decode.fail "missing key"
result =
Decode.decodeString (lowerCaseKeys |> Decode.andThen (myField "fOO" Decode.int)) """{ "Foo": 42 }"""
You can define a variant of field that disregards case.
fieldInsensitive : String -> Decode.Decoder a -> Decode.Decoder a
fieldInsensitive f d =
let
flow = String.toLower f
in
Decode.keyValuePairs Decode.value |> Decode.andThen
(\ l -> l |> List.filter (\(k, v) -> String.toLower k == flow)
|> List.map (\(k, v) -> v)
|> List.head
|> Maybe.map Decode.succeed
|> Maybe.withDefault (Decode.fail "field not found")
) |> Decode.andThen
(\ v -> case Decode.decodeValue d v of
Ok w -> Decode.succeed w
Err e -> Decode.fail (Decode.errorToString e)
)
This is more or less the same code as #glennsl's answer, but wrapped up in a self-contained function. The advantage is a simpler interface, the disadvantage is that if you lookup multiple fields in the same object you will be repeating work.
Note that this code makes a rather arbitrary decision if there are multiple fields with the same key up to case! For more reliable code, it might be a better idea to fail if a key exists more than once.
I am trying to create a lazy list with list elements which together represent all the combinations of zeros and ones.
Example: [[], [0], [1], [0,0], [0,1], [1,0]...]
Is this even possible in ML? I can't seem to find a way to change the pattern of the list elements once I have defined it. It seems that there is also a need to define a change in the binary pattern, which is not really possible in a functional language (I've never encountered binary representations in functional language)?
There seem to be two different issues at hand here:
How do we generate this particular infinite data structure?
In ML, how do we implement call-by-need?
Let's begin by considering the first point. I would generate this particular data structure in steps where the input to the nth step is a list of all bit patterns of length n. We can generate all bit patterns of length n+1 by prepending 0s and 1s onto each pattern of length n. In code:
fun generate patterns =
let
val withZeros = List.map (fn pat => 0 :: pat) patterns
val withOnes = List.map (fn pat => 1 :: pat) patterns
val nextPatterns = withZeros # withOnes
in
current # generate nextPatterns
end
val allPatterns = generate [[]]
If you were to implement this approach in a call-by-need language such as Haskell, it will perform well out of the box. However, if you run this code in ML it will not terminate. That brings us to the second problem: how do we do call-by-need in ML?
To do call-by-need in ML, we'll need to work with suspensions. Intuitively, a suspension is a piece of computation which may or may not have been run yet. A suitable interface and implementation are shown below. We can suspend a computation with delay, preventing it from running immediately. Later, when we need the result of a suspended computation, we can force it. This implementation uses references to remember the result of a previously forced suspension, guaranteeing that any particular suspension will be evaluated at most once.
structure Susp :>
sig
type 'a susp
val delay : (unit -> 'a) -> 'a susp
val force : 'a susp -> 'a
end =
struct
type 'a susp = 'a option ref * (unit -> 'a)
fun delay f = (ref NONE, f)
fun force (r, f) =
case !r of
SOME x => x
| NONE => let val x = f ()
in (r := SOME x; x)
end
end
Next, we can define a lazy list type in terms of suspensions, where the tail of the list is delayed. This allows us to create seemingly infinite data structures; for example, fun zeros () = delay (fn _ => Cons (0, zeros ())) defines an infinite list of zeros.
structure LazyList :>
sig
datatype 'a t = Nil | Cons of 'a * 'a t susp
val singleton : 'a -> 'a t susp
val append : 'a t susp * 'a t susp -> 'a t susp
val map : ('a -> 'b) -> 'a t susp -> 'b t susp
val take : 'a t susp * int -> 'a list
end =
struct
datatype 'a t = Nil | Cons of 'a * 'a t susp
fun singleton x =
delay (fn _ => Cons (x, delay (fn _ => Nil)))
fun append (xs, ys) =
delay (fn _ =>
case force xs of
Nil => force ys
| Cons (x, xs') => Cons (x, append (xs', ys)))
fun map f xs =
delay (fn _ =>
case force xs of
Nil => Nil
| Cons (x, xs') => Cons (f x, map f xs'))
fun take (xs, n) =
case force xs of
Nil => []
| Cons (x, xs') =>
if n = 0 then []
else x :: take (xs', n-1)
end
With this machinery in hand, we can adapt the original code to use lazy lists and suspensions in the right places:
fun generate patterns =
delay (fn _ =>
let
val withZeros = LazyList.map (fn pat => 0 :: pat) patterns
val withOnes = LazyList.map (fn pat => 1 :: pat) patterns
val nextPatterns = LazyList.append (withZeros, withOnes)
in
force (LazyList.append (patterns, generate nextPatterns))
end)
val allPatterns = generate (LazyList.singleton [])
We can force a piece of this list with LazyList.take:
- LazyList.take (allPatterns, 10);
val it = [[],[0],[1],[0,0],[0,1],[1,0],[1,1],[0,0,0],[0,0,1],[0,1,0]]
: int list list
let rec n_cartesian_product = function
| [] -> [[]]
| x :: xs ->
let rest = n_cartesian_product xs
List.concat (List.map (fun i -> List.map (fun rs -> i :: rs) rest) x)
Hello! I wrote this function but I need to write it without using any List.* built-in functions. Since there's an inner function that calls an outer function, I assume I must define two mutually recursive functions.
Defining a concat function seemed easy:
let rec list_concat ( lst : 'a list list ) : 'a list =
match lst with
[] -> []
|x::xs -> x # (list_concat xs)
The problem is, I'm stuck at the definition of the functions which yield the argument for concat:
let rec fun_i rest =
match rest with
[] -> []
|x::xs -> fun_rs
and fun_rs =
fun_i :: fun_rs
I can't seem to devise a proper solution. Can you help me?
edit: for instance, given this input
[["A";"a"];["B";"b"];["C";"c"]]
I want this output:
[["A"; "B"; "C"]; ["A"; "B"; "c"]; ["A"; "b"; "C"]; ["A"; "b"; "c"];
["a"; "B"; "C"]; ["a"; "B"; "c"]; ["a"; "b"; "C"]; ["a"; "b"; "c"]]
N-Cartesian Product
To define the n cartesian product recursively, the easiest method is just to make recursive definitions of the functions used in your original (non-recursive) example:
let rec list_concat lst =
match lst with
|[] -> []
|x::xs -> x # (list_concat xs)
let rec list_map f lst =
match lst with
|[] -> []
|x::xs -> (f x) :: list_map f xs
let rec n_cartesian_product =
function
| [] -> [[]]
| x :: xs ->
let rest = n_cartesian_product xs
list_concat (list_map (fun head -> list_map (fun tail -> head :: tail) rest) x)
In terms of writing idiomatically in F#, it's best to write using more general functions (like fold), rather than making a lot of custom functions with explicit recursion. So, you could define some additional functions:
let list_collect f = list_concat << list_map f
let rec list_fold f acc lst =
match lst with
|[] -> acc
|hd::tl -> list_fold f (f acc hd) tl
let n_cartesian_product_folder rest first =
list_collect (fun head -> list_map (fun tail -> head :: tail) rest) first
Then we can redefine n_cartesian_product simply as:
let n_cartesian_product2 lst = list_fold (n_cartesian_product_folder) [[]] lst
If we were using F# core library functions (rather than custom recursive implementations) this approach would involve more standard code with less to go wrong.
Cartesian Product
(I'll leave this part here since apparently it was useful)
Define a function that takes a list of 'a and make a list of 'b * 'a where all of the things of type 'b are some supplied element y.
/// take a list of 'a and make a list of (y, 'a)
let rec tuplify y lst =
match lst with
|[] -> []
|x::xs -> (y, x) :: (tuplify y xs)
Then define a function that recurses through both my lists, calling tuplify on the current element of the first list and the entire second list and concat that with the recursive call to cartesian product.
/// cartesian product of two lists
let rec cartesianProduct lst1 lst2 =
match lst1 with
|[] -> []
|x::xs -> tuplify x lst2 # (cartesianProduct xs lst2)
I'm trying to read a bunch of csv files in SQL Server using SQL Bulk Insert and DataContext.ExecuteCommand. (Maybe this isn't the best way to do it, but it does allow me stay in the Type Provider context--as opposed to with SqlBulkCopy I think.) Now the upload is glitchy with intermittent success. Some files read in, some fail with "Data conversion error (truncation)". I think this has to do with the row terminators not always working.
When the upload works, it seems to be with the '0x0A' terminator. But when that fails, I want to try repeatedly again with other row terminators. So I want to go into a Try statement, and on failure go into another Try statement, and another if that one fails, ... . This may not be the best way to upload, but I am still curious about the Try logic for it's own state.
Here's what I've come up with so far and it's not too pretty (but it works). Cutting out a few nested layers:
let FileRead path =
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='0x0A')") |> ignore
true
with
| exn ->
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='\r')") |> ignore
true
with
| exn ->
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='\n')") |> ignore
true
with
| exn ->
false
This doens't feel right but I haven't figured out any other syntax.
EDIT: What I ended up doing, just for the record. Appreciate being put on a productive path. There's plenty to improve in this. With one of the more significant things being to use Async's and run it Parallel (which I have gotten experience with in other sections).
type dbSchema = SqlDataConnection<dbConnection>
let db = dbSchema.GetDataContext()
let TryUpLd table pathFile rowTerm =
try
db.DataContext.ExecuteCommand( #"BULK INSERT " + table + " FROM '" + pathFile +
#"' WITH (FIELDTERMINATOR=',', FIRSTROW = 2, ROWTERMINATOR='"
+ rowTerm + "')" ) |> ignore
File.Delete (pathFile) |> Some
with
| exn -> None
let NxtUpLd UL intOpt =
match intOpt with
| None -> UL
| _ -> intOpt
let MoveTable ID table1 table2 =
//...
()
let NxtMoveTable MT intOpt =
match intOpt with
| Some i -> MT
| _ -> ()
let UpLdFile path (file:string) =
let (table1, table2) =
match path with
| p when p = dlXPath -> ("Data.dbo.ImportXs", "Data.dbo.Xs")
| p when p = dlYPath -> ("Data.dbo.ImportYs", "Data.dbo.Ys")
| _ -> ("ERROR path to tables", "")
let ID = file.Replace(fileExt, "")
let TryRowTerm = TryUpLd table1 (path + file)
TryRowTerm "0x0A"
|> NxtUpLd (TryRowTerm "\r")
|> NxtUpLd (TryRowTerm "\n")
|> NxtUpLd (TryRowTerm "\r\n")
|> NxtUpLd (TryRowTerm "\n\r")
|> NxtUpLd (TryRowTerm "\0")
|> NxtMoveTable (MoveTable ID table1 table2)
let UpLdData path =
let dir = new DirectoryInfo(path)
let fileList = dir.GetFiles()
fileList |> Array.iter (fun file -> UpLdFile path file.Name ) |> ignore
Here's one way to do it, using monadic composition.
First, define a function that takes another function as input, but converts any exception to a None value:
let attempt f =
try f () |> Some
with | _ -> None
This function has the type (unit -> 'a) -> 'a option; that is: f is inferred to be any function that takes unit as input, and returns a value. As you can see, if no exception happens, the return value from invoking f is wrapped in a Some case. The attempt function suppresses all exceptions, which you shouldn't normally do.
Next, define this attemptNext function:
let attemptNext f = function
| Some x -> Some x
| None -> attempt f
This function has the type (unit -> 'a) -> 'a option -> 'a option. If the input 'a option is Some then it's simply returned. In other words, the value is interpreted as already successful, so there's no reason to try the next function.
Otherwise, if the input 'a option is None, this is interpreted as though the previous step resulted in a failure. In that case, the input function f is attempted, using the attempt function.
This means that you can now compose functions together, and get the first successful result.
Here are some functions to test with:
let throwyFunction () = raise (new System.InvalidOperationException("Boo"))
let throwyFunction' x y = raise (new System.InvalidOperationException("Hiss"))
let goodFunction () = "Hooray"
let goodFunction' x y = "Yeah"
Try them out in F# Interactive:
> let res1 =
attempt throwyFunction
|> attemptNext (fun () -> throwyFunction' 42 "foo")
|> attemptNext goodFunction
|> attemptNext (fun () -> goodFunction' true 13.37);;
val res1 : string option = Some "Hooray"
> let res2 =
attempt goodFunction
|> attemptNext throwyFunction
|> attemptNext (fun () -> throwyFunction' 42 "foo")
|> attemptNext (fun () -> goodFunction' true 13.37);;
val res2 : string option = Some "Hooray"
> let res3 =
attempt (fun () -> throwyFunction' 42 "foo")
|> attemptNext throwyFunction
|> attemptNext (fun () -> goodFunction' true 13.37)
|> attemptNext goodFunction;;
val res3 : string option = Some "Yeah"
> let res4 =
attempt (fun () -> throwyFunction' 42 "foo")
|> attemptNext (fun () -> goodFunction' true 13.37)
|> attemptNext throwyFunction
|> attemptNext goodFunction;;
val res4 : string option = Some "Yeah"
Lets say I define a data type as follows:
data OP = Plus | Minus | Num Int deriving (Show, Eq)
Then I take a list of strings, and get a list of their respective OP values like this:
getOp :: [String] -> [OP]
getOp [] = []
getOp (x:rest)
| x == "+" = Plus:(getOp rest)
| isInfixOf "Num" x == True = Num (read (drop 4 x) :: Int):(getOp rest)
| otherwise = "-" = Minus:(getOp rest)
I then want to show the [OP] list, separated by new lines. I've done it with list of Strings easily, but not sure what to do with a list of data types.
I have the following structure as a starting point:
showOp :: [OP] -> String
showOp [] = []
showOp (o:os) = (putStr o):'\n':(showOp os)
I know the last line is wrong. I'm trying to return a [Char] in the first section, then a Char, then a recursive call. I tried some other variations for the last line (see below) with no luck.
showOp o = show o (works but not what I need. It shows the whole list, not each element on a new line
showOp o = putStrLn (show o) (epic fail)
showOp o
| o == "+" = "Plus\n":(showOp os)
| more of the same. Trying to return a [Char] instead of a Char, plus other issues.
Also, i'm not sure how the output will need to be different for the Num Int type, since I'll need to show the type name and the value.
An example i/o for this would be something like:
in:
getOp ["7","+","4","-","10"]
out:
Num 7
Plus
Num 4
Minus
Num 10
You need to look at the types of the functions and objects you are using. Hoogle is a great resource for getting function signatures.
For starters, the signature of putStr is
putStr :: String -> IO ()
but your code has putStr o, where o is not a string, and the result should not be an IO (). Do you really want showOp to print the Op, or just make a multi-line string for it?
If the former, you need the signature of showOp to reflect that:
showOp :: [Op] -> IO ()
Then you can use some do-notation to finish the function.
I'll write a solution for your given type signature. Since showOp should return a String and putStr returns an IO (), we won't be using putStr anywhere. Note that String is simply a type synonym for [Char], which is why we can treat Strings as a list.
showOp :: [Op] -> String
showOp [] = [] -- the empty list is a String
showOp (o:os) = showo ++ ('\n' : showos)
where showo = (show o) -- this is a String, i.e. [Char]
showos = showOp os -- this is also a String
Both showo and showos are Strings: both show and showOp return Strings.
We can add a single character to a list of characters using the cons operation :. We can append two lists of strings using append operator ++.
Now you might want another function
printOp :: [Op] -> IO ()
printOp xs = putStr $ showOp xs
How about:
showOp = putStrLn . unlines . map show
Note that your data constructor OP is already an instance of Show. Hence, you can actually map show into your array which contains members of type OP. After that, things become very somple.
A quick couple of notes ...
You might have wanted:
getOp :: [String] -> [OP]
getOp [] = []
getOp (x:rest)
| x == "+" = Plus:(getOp rest)
| x == "-" = Minus:(getOp rest)
| isInfixOf "Num" x == True = Num (read (drop 4 x) :: Int):(getOp rest)
| otherwise = (getOp rest)
Instead of what you have. Your program has a syntax error ...
Next, the input that you wanted to provide was probably
["Num 7","+","Num 4","-","Num 10"]
?. I guess that was a typo.