path: root/Source/Jennisys/Utils.fs

//  ####################################################################
///   Various utility functions
///
///   author: Aleksandar Milicevic (t-alekm@microsoft.com)
//  ####################################################################

module Utils

// -------------------------------------------
// ----------- collection util funcs ---------
// -------------------------------------------

//  =====================================
/// ensures: ret = b ? Some(b) : None
//  =====================================
let BoolToOption b =
  if b then
    Some(b)
  else
    None

//  =====================================
/// ensures: ret = (opt == Some(_))
//  =====================================
let OptionToBool opt = 
  match opt with
  | Some(_) -> true
  | None -> false

//  =====================================
/// ensures: ret = (opt == Some(_))
//  =====================================
let IsSomeOption opt = 
  match opt with
  | Some(_) -> true
  | None -> false

//  =====================================
/// ensures: ret = (opt == None)
//  =====================================
let IsNoneOption opt = IsSomeOption opt |> not

//  =====================================
/// requres: x = Some(a) or failswith msg
/// ensures: ret = a
//  =====================================
let ExtractOptionMsg msg x = 
  match x with
  | Some(a) -> a
  | None -> failwith msg

//  ====================
/// requres: x = Some(a)
/// ensures: ret = a
//  ====================
let ExtractOption x = 
  ExtractOptionMsg "can't extract anything from a None" x

//  ====================================
/// ensures: res = Some(a) ==> ret = a
/// ensures: res = None ==> ret = defVal
//  ====================================
let ExtractOptionOr defVal opt = 
  match opt with 
  | Some(a) -> a
  | None -> defVal

//  ==========================================================
/// requres: List.length lst <= 1, otherwise fails with errMsg
/// ensures: if |lst| = 0 then
///            ret = None
///          else
///            ret = Some(lst[0])
//  ==========================================================
let ListToOptionMsg  lst errMsg = 
  if List.length lst > 1 then
    failwith errMsg
  if List.isEmpty lst then
    None
  else
    Some(lst.[0])

let ListToOption lst = ListToOptionMsg lst "given list contains more than one element"

let ListDeduplicate lst = 
  let rec __Dedup lst (visitedSet: System.Collections.Generic.HashSet<_>) acc = 
    match lst with
    | fs :: rest ->  
        let newAcc = 
          if visitedSet.Add(fs) then
            acc @ [fs]
          else
            acc
        __Dedup rest visitedSet newAcc
    | _ -> acc
  __Dedup lst (new System.Collections.Generic.HashSet<_>()) []

let rec ListCombine combinerFunc lst1 lst2 = 
  match lst1 with
  | e1 :: rest ->
      let resLst1 = lst2 |> List.fold (fun acc e2 -> acc @ [combinerFunc e1 e2]) []
      List.concat [resLst1; ListCombine combinerFunc rest lst2]
  | [] -> []

let rec ListCombineMult combinerFunc lst1 lst2 = 
  match lst1 with
  | e1 :: rest ->
      let resLst1 = lst2 |> List.fold (fun acc e2 -> acc @ combinerFunc e1 e2) []
      List.concat [resLst1; ListCombineMult combinerFunc rest lst2]
  | [] -> []
        
//  =============================================================
/// ensures: forall i :: 0 <= i < |lst| ==> ret[i] = Some(lst[i])
//  =============================================================
let rec ConvertToOptionList lst = 
  match lst with
  | fs :: rest -> Some(fs) :: ConvertToOptionList rest
  | [] -> []

//  =========================================================
/// requres: Seq.length seq <= 1, otherwise fails with errMsg
/// ensures: if |seq| = 0 then
///            ret = None
///          else
///            ret = Some(seq[0])
//  =========================================================
let SeqToOptionMsg seq errMsg = 
  if Seq.length seq > 1 then
    failwith errMsg
  if Seq.isEmpty seq then
    None
  else
    Some(Seq.nth 0 seq)

let SeqToOption seq = SeqToOptionMsg seq "given seq contains more than one element"

//  =========================================================
/// requires: Set.count set <= 1, otherwise fails with errMsg
/// ensures: if |set| = 0 then
///            ret = None
///          else
///            ret = Some(set[0])
//  =========================================================
let SetToOptionMsg set errMsg = 
  if Set.count set > 1 then
    failwith errMsg
  if (Set.isEmpty set) then
    None
  else 
    Some(set |> Set.toList |> List.head)

let SetToOption set = SetToOptionMsg set "give set contains more than one value"

//  ============================================================
/// requires: n >= 0
/// ensures:  |ret| = n && forall i :: 0 <= i < n ==> ret[i] = e
//  ============================================================
let rec GenList n e =
  if n < 0 then 
    failwith "n must be positive"
  if n = 0 then
    []
  else
    e :: (GenList (n-1) e)

//  =======================================
/// ensures: forall i :: 0 <= i < |lst| ==> 
///            if lst[i] = oldElem then
///              ret[i] = newElem
///            else
///              ret[i] = lst[i]
//  =======================================
let ListReplace oldElem newElem lst = 
  lst |> List.map (fun e -> if e = oldElem then newElem else e)

//  =================================================
/// if (exists (k,v) :: (k,v) in lst && k = key) then
///   ret = Some(v)
/// else
///   ret = None
//  =================================================
let ListMapTryFind key lst = 
  let filtered = lst |> List.filter (fun (k,v) -> k = key)
  match filtered with
  | fs :: rest -> Some(snd fs)
  | [] -> None

//  ==================================================
/// Replaces the first occurence of the given key in 
/// the given list with the given value, or appends 
/// (key,value) if key does not exist in the list
//  ==================================================
let rec ListMapAdd key value lst = 
  match lst with
  | (k,v) :: rest -> if k = key then (k, value) :: rest else (k,v) :: (ListMapAdd key value rest)
  | [] -> [(key,value)]                                           

//  ==========================
/// ensures: ret = elem in lst
//  ==========================
let ListContains elem lst = 
  lst |> List.exists (fun e -> e = elem)

//  ====================================================
/// Removes all elements in lst that are equal to "elem"
//  ====================================================
let ListRemove elem lst = 
  lst |> List.choose (fun e -> if e = elem then None else Some(e))

let rec ListRemoveIdx idx lst = 
  if idx = 0 then
    List.tail lst
  else 
    List.head lst :: ListRemoveIdx (idx - 1) (List.tail lst)  

//  ===============================================================
/// ensures: |ret| = max(|lst| - cnt, 0)
/// ensures: forall i :: cnt <= i < |lst| ==> ret[i] = lst[i-cnt]
//  ===============================================================
let rec ListSkip cnt lst = 
  if cnt = 0 then
    lst    
  else
    match lst with
    | fs :: rest -> ListSkip (cnt-1) rest
    | [] -> []

//  ===============================================================
/// ensures: forall i :: 0 <= i < max(|srcList|, |dstList|) ==> 
///            if i = idx then
///              ret[i] = v
///            elif i < |srcList| then
///              ret[i] = srcList[i]
///            else
///              ret[i] = dstList[i] 
//  ===============================================================
let rec ListBuild srcList idx v dstList =
  match srcList, dstList with
  | fs1 :: rest1, fs2 :: rest2 -> if idx = 0 then
                                    v :: List.concat [rest1 ; ListSkip (List.length rest1) rest2]
                                  else 
                                    fs1 :: ListBuild rest1 (idx-1) v rest2
  | [],           fs2 :: rest2 -> if idx = 0 then
                                    v :: rest2
                                  else 
                                    fs2 :: ListBuild [] (idx-1) v rest2
  | _,            []           -> failwith "index out of range"

//  =======================================
/// ensures: forall i :: 0 <= i < |lst| ==>
///            if i = idx then
///              ret[i] = v
///            else
///              ret[i] = lst[i]
//  =======================================
let rec ListSet idx v lst =
  match lst with
  | fs :: rest -> if idx = 0 then 
                    v :: rest
                  else
                    fs :: ListSet (idx-1) v rest
  | [] -> failwith "index out of range"

exception KeyAlreadyExists

//  =======================================
/// requires (key |--> value) !in map
///
/// ensures ret = map ++ (key |--> value)
//  =======================================
let MapAddNew key value map = 
  match Map.tryFind key map with
  | Some(existingValue) -> 
      if existingValue = value then
        map
      else 
        raise KeyAlreadyExists
  | None -> 
      map |> Map.add key value

//  =======================================
/// ensures: forall k,v :: 
///            if k,v in map2 then
//               k,v in ret
///            elif k,v in map1 then
///              k,v in ret
///            else
///              k,v !in ret
//  =======================================
let rec MapAddAll map1 map2 = 
  map2 |> Map.fold (fun acc k v -> acc |> Map.add k v) map1

//  =======================================
/// ensures: |ret| = 1
/// ensures: (key -> value) in ret
//  =======================================
let MapSingleton key value = 
  Map.empty |> Map.add key value

let MapKeys map = 
  map |> Map.toList |> List.map (fun (k,v) -> k)

let MapReplaceKey oldKey newKey newVal map = 
  map |> Map.toList |> List.fold (fun acc (k,v) -> if k = oldKey then acc |> Map.add newKey newVal else acc |> Map.add k v) Map.empty

// -------------------------------------------
// ------------ algorithms -------------------
// -------------------------------------------

//  =======================================================================
/// Topologically sorts a given list
///
/// ensures: |ret| = |lst|
/// ensures: forall e in lst :: e in ret
/// ensures: forall i,j :: 0 <= i < j < ==> not (followsFunc ret[j] ret[i])
//  =======================================================================
let rec TopSort followsFunc lst = 
  match lst with
  | [] -> []
  | fs :: [] -> [fs]
  | fs :: rest -> 
      let min = rest |> List.fold (fun acc elem -> if followsFunc acc elem then elem else acc) fs
      min :: TopSort followsFunc (ListRemove min lst)
                                                 
// -------------------------------------------
// ------ string active patterns -------------
// -------------------------------------------

let (|Prefix|_|) (p:string) (s:string) =
  if s.StartsWith(p) then
    Some(s.Substring(p.Length))
  else
    None
                 
// -------------------------------------------
// --------------- workflow ------------------
// -------------------------------------------

let IfDo1 cond func1 a =
  if cond then
    func1 a
  else 
    a

let IfDo2 cond func2 (a1,a2) =
  if cond then
    func2 a1 a2
  else
    a1,a2 

let Ite cond f1 f2 =
  if cond then
    f1
  else
    f2

type CascadingBuilder<'a>(failVal: 'a) = 
  member this.Bind(v, f) =
    match v with
    | Some(x) -> f x
    | None -> failVal
  member this.Return(v) = v

// -------------------------------------------
// --------------- random --------------------
// -------------------------------------------

let Iden x = x