F# monad challenges https://mightybyte.github.io/monad-challenges/ https://github.com/scott-fleischman/fsharp-monad-challenges

Set1.fs

module Set1

open MCPrelude

let fiveRands =
    let s0 = mkSeed 1I
    let (r1, s1) = rand s0
    let (r2, s2) = rand s1
    let (r3, s3) = rand s2
    let (r4, s4) = rand s3
    let (r5, s5) = rand s4
    [r1; r2; r3; r4; r5]

let randLetter s =
    let (n, s') = rand s
    (toLetter n, s')

let randString3 =
    let s0 = mkSeed 1I
    let (c1, s1) = randLetter s0
    let (c2, s2) = randLetter s1
    let (c3, s3) = randLetter s2
    [c1; c2; c3]

let generalA f g s =
    let (n, s') = f s
    (g n, s')

let randEven = generalA rand (fun x -> x * 2I)
let randOdd = generalA randEven (fun x -> x + 1I)
let randTen = generalA rand (fun x -> x * 10I)

let randPair s =
    let (c, s1) = generalA randLetter id s
    let (n, s2) = generalA rand id s1
    ((c, n), s2)

let generalPair ga gb s =
    let (a, s1) = ga s
    let (b, s2) = gb s1
    ((a, b), s2)

let generalB f ga gb s =
    let (a, s1) = ga s
    let (b, s2) = gb s1
    (f a b, s2)

let generalPair2 ga gb s = generalB (fun x y -> x, y) ga gb s

let rec repRandom gs s =
    match gs with
    | [] -> ([], s)
    | (g :: gs) ->
        let (x, s1) = g s
        let (xs, s2) = repRandom gs s1
        (x :: xs, s2)

let genTwo gen f s =
    let (v, s1) = gen s
    f v s1

let mkGen x s = (x, s)

Set2.fs

module Set2

type 'a Maybe =
    | Just of 'a
    | Nothing

let headMay (list : 'a List) : 'a Maybe =
    match list with
    | [] -> Nothing
    | x :: xs -> Just x

// tailMay :: [a] -> Maybe [a]
let tailMay (list : 'a List) : 'a List Maybe =
    match list with
    | [] -> Nothing
    | x :: xs -> Just xs

//lookupMay :: Eq a => a -> [(a, b)] -> Maybe b
let rec lookupMay item list =
    match list with
    | [] -> Nothing
    | (a, b) :: _ when item = a -> Just b
    | _ :: tail -> lookupMay item tail

//divMay :: (Eq a, Fractional a) => a -> a -> Maybe a
let divMay top bottom = if bottom = 0I then Nothing else Just (double top / double bottom)

//maximumMay :: Ord a => [a] -> Maybe a
let rec findMay f list =
    match list with
    | [] -> Nothing
    | x :: xs ->
        match findMay f xs with
        | Nothing -> Just x
        | Just y -> Just (f x y)

let maximumMay list = findMay max list
let minimumMay list = findMay min list

//queryGreek :: GreekData -> String -> Maybe Double
let queryGreek data key =
    match lookupMay key data with
    | Nothing -> Nothing
    | Just xs ->
        match tailMay xs with
        | Nothing -> Nothing
        | Just t ->
            match maximumMay t with
            | Nothing -> Nothing
            | Just m ->
                match headMay xs with
                | Nothing -> Nothing
                | Just h -> divMay m h

// ...


//addSalaries :: [(String, Integer)] -> String -> String -> Maybe Integer
let addSalaries (salaries : (string * bigint) list) (name1 : string) (name2 : string) : bigint Maybe =
    let salary1Maybe = lookupMay name1 salaries
    let salary2Maybe = lookupMay name2 salaries
    match salary1Maybe, salary2Maybe with
    | (Some salary1), (Some salary2) -> Some (salary1 + salary2)
    | _, _ -> None

let yLink f xm ym =
    match xm, ym with
    | Some x, Some y -> Some (f x y)
    | _, _ -> None

let addSalaries2 salaries name1 name2 = yLink (+) (lookupMay name1 salaries) (lookupMay name2 salaries)

// tailProd :: Num a => [a] -> Maybe a
let tailProd (xs : bigint list) : bigint Maybe =
    let tailMaybe = tailMay xs
    match tailMaybe with
    | Some tail -> Some (List.fold (fun a x -> a * x) 1I tail)
    | None -> None

let tailSum (xs : bigint list) : bigint Maybe =
    let tailMaybe = tailMay xs
    match tailMaybe with
    | Some tail -> Some (List.fold (fun a x -> a + x) 0I tail)
    | None -> None

let transMaybe f mx =
    match mx with
    | Some x -> Some (f x)
    | None -> None