Skip to content

Instantly share code, notes, and snippets.

@nightroman
Last active December 19, 2016 20:25
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save nightroman/0cb236256bb4089d60cc185db93560c0 to your computer and use it in GitHub Desktop.
Save nightroman/0cb236256bb4089d60cc185db93560c0 to your computer and use it in GitHub Desktop.
<#
.Synopsis
Build script (https://github.com/nightroman/Invoke-Build)
#>
[CmdletBinding()] param()
task Init {
exec {paket.exe install --only-referenced}
}
task Kill Clean, {
Remove-Item -Force -Recurse -ErrorAction 0 @(
'packages'
'paket.lock'
)
}
task Clean {
Remove-Item -Force -Recurse -ErrorAction 0 -Path bin, obj
}
*.ini
*.nupkg
*.sln
.vs
AssemblyInfo.fs
bin
obj
packages
paket.lock
z*
Turtle
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="14.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>ffcbd9e5-2549-4a4c-bc07-d7edd3fca6d9</ProjectGuid>
<OutputType>Exe</OutputType>
<RootNamespace>fsExtras</RootNamespace>
<AssemblyName>fsExtras</AssemblyName>
<TargetFrameworkVersion>v4.5</TargetFrameworkVersion>
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
<TargetFSharpCoreVersion>4.4.0.0</TargetFSharpCoreVersion>
<Name>fsExtras</Name>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<Optimize>false</Optimize>
<Tailcalls>false</Tailcalls>
<OutputPath>bin\Debug\</OutputPath>
<DefineConstants>DEBUG;TRACE</DefineConstants>
<WarningLevel>3</WarningLevel>
<PlatformTarget>AnyCPU</PlatformTarget>
<DocumentationFile>bin\Debug\fsExtras.XML</DocumentationFile>
<Prefer32Bit>true</Prefer32Bit>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<Optimize>true</Optimize>
<Tailcalls>true</Tailcalls>
<OutputPath>bin\Release\</OutputPath>
<DefineConstants>TRACE</DefineConstants>
<WarningLevel>3</WarningLevel>
<PlatformTarget>AnyCPU</PlatformTarget>
<DocumentationFile>bin\Release\fsExtras.XML</DocumentationFile>
<Prefer32Bit>true</Prefer32Bit>
</PropertyGroup>
<ItemGroup>
<Reference Include="mscorlib" />
<Reference Include="FSharp.Core, Version=$(TargetFSharpCoreVersion), Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<Private>True</Private>
</Reference>
<Reference Include="System" />
<Reference Include="System.Core" />
<Reference Include="System.Numerics" />
</ItemGroup>
<ItemGroup>
<Compile Include="ReaderStack.fs" />
<Compile Include="StateQueue.fs" />
<Compile Include="StringBuilder.fs" />
<Compile Include="InterfaceState.fs" />
<Compile Include="InterfaceReader.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
<PropertyGroup>
<MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
</PropertyGroup>
<Choose>
<When Condition="'$(VisualStudioVersion)' == '11.0'">
<PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')">
<FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
</PropertyGroup>
</When>
<Otherwise>
<PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets')">
<FSharpTargetsPath>$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets</FSharpTargetsPath>
</PropertyGroup>
</Otherwise>
</Choose>
<Import Project="$(FSharpTargetsPath)" />
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
Other similar extension points exist, see Microsoft.Common.targets.
<Target Name="BeforeBuild">
</Target>
<Target Name="AfterBuild">
</Target>
-->
<Choose>
<When Condition="$(TargetFrameworkIdentifier) == '.NETFramework' And $(TargetFrameworkVersion) == 'v4.5'">
<ItemGroup>
<Reference Include="FSharpx.Extras">
<HintPath>packages\FSharpx.Extras\lib\net45\FSharpx.Extras.dll</HintPath>
<Private>True</Private>
<Paket>True</Paket>
</Reference>
</ItemGroup>
</When>
</Choose>
</Project>

module InterfaceReader
open FSharpx.Reader
type It =
abstract Do1 : unit -> unit
abstract Inc : int -> int
let do1 (it:It) =
it.Do1 ()
let inc i (it:It) =
it.Inc i
let get (it:It) =
it
type Imp() =
interface It with
member x.Do1 () = printfn "Do1"
member x.Inc i = i + 1
let test1 () =
let work = reader {
do! do1
// get the reader
let! it = get
printfn "%A" it
// get the reader v2
let! it2 = fun x -> x
printfn "%A" it2
// get the reader v3, best
let! it3 = id
printfn "%A" it3
return! inc 42
}
printfn "%A" (ask work (Imp()))

module InterfaceState
open FSharpx.State
type It =
abstract Do1 : unit -> unit
abstract Inc : int -> int
let do1 (it:It) =
it.Do1 ()
(), it
let inc i (it:It) =
(it.Inc i), it
type Imp() =
interface It with
member x.Do1 () = printfn "Do1"
member x.Inc i = i + 1
let test1 () =
let work = state {
do! do1
return! inc 42
}
printfn "%A" (eval work (Imp()))
framework: net45
references: strict
source https://www.nuget.org/api/v2
nuget FSharpx.Extras

module Main
[<EntryPoint>]
let main argv =
//do StateQueue.test1()
//do ReaderStack.test1()
//do StringBuilder.test1()
//InterfaceState.test1()
InterfaceReader.test1()
0

// http://codebetter.com/matthewpodwysocki/2010/01/07/much-ado-about-monads-reader-edition/
module ReaderStack
open FSharpx.Reader
open System.Threading
open System.Collections.Generic
let tryRunLock lock m =
let lock = box lock
let lockTaken = ref false
Monitor.Enter (lock, lockTaken)
if lockTaken.Value then
try Some (m lock) // runReader m lock ~ m lock
finally Monitor.Exit lock
else
None
let pulseAll = Monitor.PulseAll
let wait = fun o -> Monitor.Wait o |> ignore
let pop (stack:Stack<_>) = reader {
while stack.Count = 0 do return! wait
return stack.Pop() }
let push (stack:Stack<_>) x = reader {
if stack.Count = 0 then return! pulseAll
do stack.Push(x) }
// Our lock object
let lockObj = new obj()
let move s1 s2 =
reader {
let! x = pop s1
do! push s2 x
return x }
|> tryRunLock lockObj
let test1() =
let s1 = Stack<int> [1..3]
let s2 = Stack<int> ()
let moved = move s1 s2
printfn "%A" s1
printfn "%A" s2
printfn "%A" moved
module StateQueue
open FSharpx.State
let enqueue a lst = ((), lst @ [a])
let dequeue = function
| hd::tl -> (hd, tl)
| _ -> invalidOp ""
let test1 () =
let workflow = state {
//let! queue = getState
do! enqueue 4
let! hd = dequeue
do! enqueue (hd * 3)
return hd
}
printfn "%A" (workflow [3..6])
printfn "%A" (eval workflow [3..6])
printfn "%A" (exec workflow [3..6])
// http://www.fssnip.net/d5/title/A-Computation-Expression-wrapper-for-StringBuilder
module StringBuilder
open System
type StringBuilder = B of (Text.StringBuilder -> unit)
let build (B f) =
let b = new Text.StringBuilder()
do f b
b.ToString ()
(*
member __.Yield (o : obj) = B(fun b -> b.Append o |> ignore)
- add object, sloppy
member __.YieldFrom (txt : string seq) = B(fun b -> for t in txt do b.Append t |> ignore)
- add seq of strings, sloppy
*)
type StringBuilderM () =
let (!) = function B f -> f
member __.Yield (txt : string) = B (fun b -> b.Append txt |> ignore)
member __.Yield (c : char) = B (fun b -> b.Append c |> ignore)
member __.YieldFrom f = f
member __.Combine (f, g) = B (fun b -> !f b; !g b)
member __.Delay f = B (fun b -> !(f ()) b)
member __.Zero () = B (fun _ -> ())
member __.For (xs : 'a seq, f : 'a -> StringBuilder) =
B (fun b ->
let e = xs.GetEnumerator ()
while e.MoveNext () do
!(f e.Current) b
)
member __.While (p : unit -> bool, f : StringBuilder) =
B (fun b -> while p () do !f b)
let string = new StringBuilderM ()
// example
let test1 () =
let r =
string {
for x in [1] do
yield sprintf "%d " x
let mutable x = true
while x do
yield sprintf "%A " x
x <- false
yield "s1"
yield ' '
yield "s2"
yield ' '
yield! string {
yield "nested"
}
}
let r = r |> build
printfn "%s" r
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment