diff --git a/.gitattributes b/.gitattributes index 1ff0c42..7ff73f4 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,63 +1,26 @@ -############################################################################### -# Set default behavior to automatically normalize line endings. -############################################################################### +# Auto detect text files * text=auto -############################################################################### -# Set default behavior for command prompt diff. -# -# This is need for earlier builds of msysgit that does not have it on by -# default for csharp files. -# Note: This is only used by command line -############################################################################### -#*.cs diff=csharp +# Custom for Visual Studio +*.cs diff=csharp text=auto eol=lf +*.vb diff=csharp text=auto eol=lf +*.fs diff=csharp text=auto eol=lf +*.fsi diff=csharp text=auto eol=lf +*.fsx diff=csharp text=auto eol=lf +*.sln text eol=crlf merge=union +*.csproj merge=union +*.vbproj merge=union +*.fsproj merge=union +*.dbproj merge=union -############################################################################### -# Set the merge driver for project and solution files -# -# Merging from the command prompt will add diff markers to the files if there -# are conflicts (Merging from VS is not affected by the settings below, in VS -# the diff markers are never inserted). Diff markers may cause the following -# file extensions to fail to load in VS. An alternative would be to treat -# these files as binary and thus will always conflict and require user -# intervention with every merge. To do so, just uncomment the entries below -############################################################################### -#*.sln merge=binary -#*.csproj merge=binary -#*.vbproj merge=binary -#*.vcxproj merge=binary -#*.vcproj merge=binary -#*.dbproj merge=binary -#*.fsproj merge=binary -#*.lsproj merge=binary -#*.wixproj merge=binary -#*.modelproj merge=binary -#*.sqlproj merge=binary -#*.wwaproj merge=binary - -############################################################################### -# behavior for image files -# -# image files are treated as binary by default. -############################################################################### -#*.jpg binary -#*.png binary -#*.gif binary - -############################################################################### -# diff behavior for common document formats -# -# Convert binary document formats to text before diffing them. This feature -# is only available from the command line. Turn it on by uncommenting the -# entries below. -############################################################################### -#*.doc diff=astextplain -#*.DOC diff=astextplain -#*.docx diff=astextplain -#*.DOCX diff=astextplain -#*.dot diff=astextplain -#*.DOT diff=astextplain -#*.pdf diff=astextplain -#*.PDF diff=astextplain -#*.rtf diff=astextplain -#*.RTF diff=astextplain +# Standard to msysgit +*.doc diff=astextplain +*.DOC diff=astextplain +*.docx diff=astextplain +*.DOCX diff=astextplain +*.dot diff=astextplain +*.DOT diff=astextplain +*.pdf diff=astextplain +*.PDF diff=astextplain +*.rtf diff=astextplain +*.RTF diff=astextplain diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md new file mode 100644 index 0000000..86eed43 --- /dev/null +++ b/.github/ISSUE_TEMPLATE.md @@ -0,0 +1,30 @@ +### Description + +Please provide a succinct description of your issue. + +### Repro steps + +Please provide the steps required to reproduce the problem + +1. Step A + +2. Step B + +### Expected behavior + +Please provide a description of the behavior you expect. + +### Actual behavior + +Please provide a description of the actual behavior you observe. + +### Known workarounds + +Please provide a description of any known workarounds. + +### Related information + +* Operating system +* Branch +* .NET Runtime, CoreCLR or Mono Version +* Performance information, links to performance testing scripts diff --git a/.gitignore b/.gitignore index f2b1147..27bcb45 100644 --- a/.gitignore +++ b/.gitignore @@ -6,6 +6,11 @@ *.user *.sln.docstates +# Xamarin Studio / monodevelop user-specific +*.userprefs +*.dll.mdb +*.exe.mdb + # Build results [Dd]ebug/ @@ -15,12 +20,6 @@ build/ [Bb]in/ [Oo]bj/ -# Enable "build/" folder in the NuGet Packages folder since NuGet packages use it for MSBuild targets -!packages/*/build/ - -#NuGet -packages/ - # MSTest test Results [Tt]est[Rr]esult*/ [Bb]uild[Ll]og.* @@ -62,6 +61,9 @@ ipch/ *.vsp *.vspx +# Other Visual Studio data +.vs/ + # Guidance Automation Toolkit *.gpState @@ -98,9 +100,8 @@ publish/ # Publish Web Output *.Publish.xml -# NuGet Packages Directory -## TODO: If you have NuGet Package Restore enabled, uncomment the next line -#packages/ +# Enable nuget.exe in the .nuget folder (though normally executables are not tracked) +!.nuget/NuGet.exe # Windows Azure Build Output csx @@ -109,6 +110,9 @@ csx # Windows Store app package directory AppPackages/ +# VSCode +.vscode/ + # Others sql/ *.Cache @@ -157,3 +161,34 @@ $RECYCLE.BIN/ # Mac desktop service store files .DS_Store + +# =================================================== +# Exclude F# project specific directories and files +# =================================================== + +# NuGet Packages Directory +packages/ + +# Generated documentation folder +docs/output/ + +# Temp folder used for publishing docs +temp/ + +# Test results produced by build +TestResults.xml + +# Nuget outputs +nuget/*.nupkg +release.cmd +release.sh +localpackages/ +paket-files +*.orig +.paket/paket.exe +docs/content/license.md +docs/content/release-notes.md +.fake +docs/tools/FSharp.Formatting.svclog +AssemblyInfo.fs + diff --git a/.paket/paket.bootstrapper.exe b/.paket/paket.bootstrapper.exe new file mode 100755 index 0000000..84cfeb9 Binary files /dev/null and b/.paket/paket.bootstrapper.exe differ diff --git a/.paket/paket.targets b/.paket/paket.targets new file mode 100644 index 0000000..2557fb9 --- /dev/null +++ b/.paket/paket.targets @@ -0,0 +1,36 @@ + + + + + true + + true + $(MSBuildThisFileDirectory) + $(MSBuildThisFileDirectory)..\ + + + + $(PaketToolsPath)paket.exe + $(PaketToolsPath)paket.bootstrapper.exe + "$(PaketExePath)" + mono --runtime=v4.0.30319 "$(PaketExePath)" + "$(PaketBootStrapperExePath)" + mono --runtime=v4.0.30319 $(PaketBootStrapperExePath) + + $(PaketCommand) restore + $(PaketBootStrapperCommand) + + RestorePackages; $(BuildDependsOn); + + + + + + + + + + + + + diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..5152d90 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,9 @@ +language: csharp + +sudo: false # use the new container-based Travis infrastructure + +before_install: + - chmod +x build.sh + +script: + - ./build.sh All diff --git a/Higher.sln b/Higher.sln index ac59fec..7dc093f 100644 --- a/Higher.sln +++ b/Higher.sln @@ -1,13 +1,38 @@ - + Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 2013 -VisualStudioVersion = 12.0.21005.1 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Higher.Core", "src\Higher.Core\Higher.Core.fsproj", "{C979A279-D345-469C-84B9-DACCFDE18FFD}" +# Visual Studio 2012 +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = ".paket", ".paket", "{63297B98-5CED-492C-A5B7-A5B4F73CF142}" + ProjectSection(SolutionItems) = preProject + paket.dependencies = paket.dependencies + paket.lock = paket.lock + EndProjectSection EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Higher.Tests", "tests\Higher.Tests\Higher.Tests.fsproj", "{79CEA165-5660-4635-9854-FA3433E8CA86}" +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "docs", "docs", "{A6A6AF7D-D6E3-442D-9B1E-58CC91879BE1}" EndProject -Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "tests", "tests", "{BF71DC5C-2815-4B55-A3F2-4636DD267EB0}" +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Higher", "src\Higher\Higher.fsproj", "{A76FEEB6-CF93-465D-8F57-D729C1FFFE76}" +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "project", "project", "{BF60BC93-E09B-4E5F-9D85-95A519479D54}" + ProjectSection(SolutionItems) = preProject + build.fsx = build.fsx + README.md = README.md + RELEASE_NOTES.md = RELEASE_NOTES.md + EndProjectSection +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "tools", "tools", "{83F16175-43B1-4C90-A1EE-8E351C33435D}" + ProjectSection(SolutionItems) = preProject + docs\tools\generate.fsx = docs\tools\generate.fsx + docs\tools\templates\template.cshtml = docs\tools\templates\template.cshtml + EndProjectSection +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "content", "content", "{8E6D5255-776D-4B61-85F9-73C37AA1FB9A}" + ProjectSection(SolutionItems) = preProject + docs\content\index.fsx = docs\content\index.fsx + docs\content\tutorial.fsx = docs\content\tutorial.fsx + EndProjectSection +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "tests", "tests", "{ED8079DD-2B06-4030-9F0F-DC548F98E1C4}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Higher.Tests", "tests\Higher.Tests\Higher.Tests.fsproj", "{5BFF3686-D94A-438B-84EE-6390FA1E82EB}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution @@ -15,19 +40,21 @@ Global Release|Any CPU = Release|Any CPU EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution - {C979A279-D345-469C-84B9-DACCFDE18FFD}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {C979A279-D345-469C-84B9-DACCFDE18FFD}.Debug|Any CPU.Build.0 = Debug|Any CPU - {C979A279-D345-469C-84B9-DACCFDE18FFD}.Release|Any CPU.ActiveCfg = Release|Any CPU - {C979A279-D345-469C-84B9-DACCFDE18FFD}.Release|Any CPU.Build.0 = Release|Any CPU - {79CEA165-5660-4635-9854-FA3433E8CA86}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {79CEA165-5660-4635-9854-FA3433E8CA86}.Debug|Any CPU.Build.0 = Debug|Any CPU - {79CEA165-5660-4635-9854-FA3433E8CA86}.Release|Any CPU.ActiveCfg = Release|Any CPU - {79CEA165-5660-4635-9854-FA3433E8CA86}.Release|Any CPU.Build.0 = Release|Any CPU + {A76FEEB6-CF93-465D-8F57-D729C1FFFE76}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {A76FEEB6-CF93-465D-8F57-D729C1FFFE76}.Debug|Any CPU.Build.0 = Debug|Any CPU + {A76FEEB6-CF93-465D-8F57-D729C1FFFE76}.Release|Any CPU.ActiveCfg = Release|Any CPU + {A76FEEB6-CF93-465D-8F57-D729C1FFFE76}.Release|Any CPU.Build.0 = Release|Any CPU + {5BFF3686-D94A-438B-84EE-6390FA1E82EB}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {5BFF3686-D94A-438B-84EE-6390FA1E82EB}.Debug|Any CPU.Build.0 = Debug|Any CPU + {5BFF3686-D94A-438B-84EE-6390FA1E82EB}.Release|Any CPU.ActiveCfg = Release|Any CPU + {5BFF3686-D94A-438B-84EE-6390FA1E82EB}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection GlobalSection(NestedProjects) = preSolution - {79CEA165-5660-4635-9854-FA3433E8CA86} = {BF71DC5C-2815-4B55-A3F2-4636DD267EB0} + {83F16175-43B1-4C90-A1EE-8E351C33435D} = {A6A6AF7D-D6E3-442D-9B1E-58CC91879BE1} + {8E6D5255-776D-4B61-85F9-73C37AA1FB9A} = {A6A6AF7D-D6E3-442D-9B1E-58CC91879BE1} + {5BFF3686-D94A-438B-84EE-6390FA1E82EB} = {ED8079DD-2B06-4030-9F0F-DC548F98E1C4} EndGlobalSection EndGlobal diff --git a/LICENSE.md b/LICENSE.txt similarity index 100% rename from LICENSE.md rename to LICENSE.txt diff --git a/README.md b/README.md index 6facfbf..8f1165e 100644 --- a/README.md +++ b/README.md @@ -3,10 +3,19 @@ Higher A lightweight library of abstractions for Higher-kinded programming in F#, based on -      [Lightweight Higher-Kinded Polymorphism][flops-2014-paper]
-      Jeremy Yallop and Leo White
-      Functional and Logic Programming 2014
-      [OCaml implementation][ocaml-implementation]
+> [Lightweight Higher-Kinded Polymorphism][flops-2014-paper] +> +> Jeremy Yallop and Leo White +> +> Functional and Logic Programming 2014 +> +> [OCaml implementation][ocaml-implementation] [flops-2014-paper]: https://ocamllabs.github.io/higher/lightweight-higher-kinded-polymorphism.pdf [ocaml-implementation]: https://github.com/ocamllabs/higher + +## Build Status + +Mono | .NET +---- | ---- +[![Mono CI Build Status](https://img.shields.io/travis/palladin/Higher/master.svg)](https://travis-ci.org/palladin/Higher) | [![.NET Build Status](https://img.shields.io/appveyor/ci/palladin/Higher/master.svg)](https://ci.appveyor.com/project/palladin/Higher) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md new file mode 100644 index 0000000..b23e80f --- /dev/null +++ b/RELEASE_NOTES.md @@ -0,0 +1,2 @@ +#### 1.0 - October 17 2016 +* Initial release diff --git a/appveyor.yml b/appveyor.yml new file mode 100644 index 0000000..413e403 --- /dev/null +++ b/appveyor.yml @@ -0,0 +1,9 @@ +init: + - git config --global core.autocrlf input +build_script: + - cmd: build.cmd All +test: off +version: 0.0.1.{build} +artifacts: + - path: bin + name: bin diff --git a/build.cmd b/build.cmd new file mode 100644 index 0000000..09b44ff --- /dev/null +++ b/build.cmd @@ -0,0 +1,18 @@ +@echo off +cls + +.paket\paket.bootstrapper.exe +if errorlevel 1 ( + exit /b %errorlevel% +) + +.paket\paket.exe restore +if errorlevel 1 ( + exit /b %errorlevel% +) + +IF NOT EXIST build.fsx ( + .paket\paket.exe update + packages\build\FAKE\tools\FAKE.exe init.fsx +) +packages\build\FAKE\tools\FAKE.exe build.fsx %* diff --git a/build.fsx b/build.fsx new file mode 100644 index 0000000..beb7a63 --- /dev/null +++ b/build.fsx @@ -0,0 +1,404 @@ +// -------------------------------------------------------------------------------------- +// FAKE build script +// -------------------------------------------------------------------------------------- + +#r @"packages/build/FAKE/tools/FakeLib.dll" +open Fake +open Fake.Git +open Fake.AssemblyInfoFile +open Fake.ReleaseNotesHelper +open Fake.UserInputHelper +open System +open System.IO +#if MONO +#else +#load "packages/build/SourceLink.Fake/tools/Fake.fsx" +open SourceLink +#endif + +// -------------------------------------------------------------------------------------- +// START TODO: Provide project-specific details below +// -------------------------------------------------------------------------------------- + +// Information about the project are used +// - for version and project name in generated AssemblyInfo file +// - by the generated NuGet package +// - to run tests and to publish documentation on GitHub gh-pages +// - for documentation, you also need to edit info in "docs/tools/generate.fsx" + +// The name of the project +// (used by attributes in AssemblyInfo, name of a NuGet package and directory in 'src') +let project = "Higher" + +// Short summary of the project +// (used as description in AssemblyInfo and as a short summary for NuGet package) +let summary = "Lightweight Higher-Kinded Polymorphism" + +// Longer description of the project +// (used as a description for NuGet package; line breaks are automatically cleaned up) +let description = "A lightweight library of abstractions for Higher-kinded programming in F#, based on Lightweight Higher-Kinded Polymorphism" + +// List of author names (for NuGet package) +let authors = [ "palladin" ] + +// Tags for your project (for NuGet package) +let tags = "kind kinds Higher-kinded functor applicative monad algebra" + +// File system information +let solutionFile = "Higher.sln" + +// Pattern specifying assemblies to be tested using NUnit +let testAssemblies = "tests/**/bin/Release/*Tests*.dll" + +// Git configuration (used for publishing documentation in gh-pages branch) +// The profile where the project is posted +let gitOwner = "palladin" +let gitHome = sprintf "%s/%s" "https://github.com" gitOwner + +// The name of the project on GitHub +let gitName = "Higher" + +// The url for the raw files hosted +let gitRaw = environVarOrDefault "gitRaw" "https://raw.githubusercontent.com/palladin" + +// -------------------------------------------------------------------------------------- +// END TODO: The rest of the file includes standard build steps +// -------------------------------------------------------------------------------------- + +// Read additional information from the release notes document +let release = LoadReleaseNotes "RELEASE_NOTES.md" + +// Helper active pattern for project types +let (|Fsproj|Csproj|Vbproj|Shproj|) (projFileName:string) = + match projFileName with + | f when f.EndsWith("fsproj") -> Fsproj + | f when f.EndsWith("csproj") -> Csproj + | f when f.EndsWith("vbproj") -> Vbproj + | f when f.EndsWith("shproj") -> Shproj + | _ -> failwith (sprintf "Project file %s not supported. Unknown project type." projFileName) + +// Generate assembly info files with the right version & up-to-date information +Target "AssemblyInfo" (fun _ -> + let getAssemblyInfoAttributes projectName = + [ Attribute.Title (projectName) + Attribute.Product project + Attribute.Description summary + Attribute.Version release.AssemblyVersion + Attribute.FileVersion release.AssemblyVersion ] + + let getProjectDetails projectPath = + let projectName = System.IO.Path.GetFileNameWithoutExtension(projectPath) + ( projectPath, + projectName, + System.IO.Path.GetDirectoryName(projectPath), + (getAssemblyInfoAttributes projectName) + ) + + !! "src/**/*.??proj" + |> Seq.map getProjectDetails + |> Seq.iter (fun (projFileName, projectName, folderName, attributes) -> + match projFileName with + | Fsproj -> CreateFSharpAssemblyInfo (folderName "AssemblyInfo.fs") attributes + | Csproj -> CreateCSharpAssemblyInfo ((folderName "Properties") "AssemblyInfo.cs") attributes + | Vbproj -> CreateVisualBasicAssemblyInfo ((folderName "My Project") "AssemblyInfo.vb") attributes + | Shproj -> () + ) +) + +// Copies binaries from default VS location to expected bin folder +// But keeps a subdirectory structure for each project in the +// src folder to support multiple project outputs +Target "CopyBinaries" (fun _ -> + !! "src/**/*.??proj" + -- "src/**/*.shproj" + |> Seq.map (fun f -> ((System.IO.Path.GetDirectoryName f) "bin/Release", "bin" (System.IO.Path.GetFileNameWithoutExtension f))) + |> Seq.iter (fun (fromDir, toDir) -> CopyDir toDir fromDir (fun _ -> true)) +) + +// -------------------------------------------------------------------------------------- +// Clean build results + +Target "Clean" (fun _ -> + !! solutionFile |> MSBuildRelease "" "Clean" |> ignore + CleanDirs ["bin"; "temp"; "docs/output"] +) + +// -------------------------------------------------------------------------------------- +// Build library & test project + +Target "Build" (fun _ -> + !! solutionFile +#if MONO + |> MSBuildReleaseExt "" [ ("DefineConstants","MONO") ] "Build" +#else + |> MSBuildRelease "" "Build" +#endif + |> ignore +) + +// -------------------------------------------------------------------------------------- +// Run the unit tests using test runner + +Target "RunTests" (fun _ -> + !! testAssemblies + |> NUnit (fun p -> + { p with + DisableShadowCopy = true + TimeOut = TimeSpan.FromMinutes 20. + OutputFile = "TestResults.xml" }) +) + +#if MONO +#else +// -------------------------------------------------------------------------------------- +// SourceLink allows Source Indexing on the PDB generated by the compiler, this allows +// the ability to step through the source code of external libraries http://ctaggart.github.io/SourceLink/ + +Target "SourceLink" (fun _ -> + let baseUrl = sprintf "%s/%s/{0}/%%var2%%" gitRaw project + !! "src/**/*.??proj" + -- "src/**/*.shproj" + |> Seq.iter (fun projFile -> + let proj = VsProj.LoadRelease projFile + SourceLink.Index proj.CompilesNotLinked proj.OutputFilePdb __SOURCE_DIRECTORY__ baseUrl + ) +) + +#endif + +// -------------------------------------------------------------------------------------- +// Build a NuGet package + +Target "NuGet" (fun _ -> + Paket.Pack(fun p -> + { p with + OutputPath = "bin" + Version = release.NugetVersion + ReleaseNotes = toLines release.Notes}) +) + +Target "PublishNuget" (fun _ -> + Paket.Push(fun p -> + { p with + WorkingDir = "bin" }) +) + + +// -------------------------------------------------------------------------------------- +// Generate the documentation + + +let fakePath = "packages" "build" "FAKE" "tools" "FAKE.exe" +let fakeStartInfo script workingDirectory args fsiargs environmentVars = + (fun (info: System.Diagnostics.ProcessStartInfo) -> + info.FileName <- System.IO.Path.GetFullPath fakePath + info.Arguments <- sprintf "%s --fsiargs -d:FAKE %s \"%s\"" args fsiargs script + info.WorkingDirectory <- workingDirectory + let setVar k v = + info.EnvironmentVariables.[k] <- v + for (k, v) in environmentVars do + setVar k v + setVar "MSBuild" msBuildExe + setVar "GIT" Git.CommandHelper.gitPath + setVar "FSI" fsiPath) + +/// Run the given buildscript with FAKE.exe +let executeFAKEWithOutput workingDirectory script fsiargs envArgs = + let exitCode = + ExecProcessWithLambdas + (fakeStartInfo script workingDirectory "" fsiargs envArgs) + TimeSpan.MaxValue false ignore ignore + System.Threading.Thread.Sleep 1000 + exitCode + +// Documentation +let buildDocumentationTarget fsiargs target = + trace (sprintf "Building documentation (%s), this could take some time, please wait..." target) + let exit = executeFAKEWithOutput "docs/tools" "generate.fsx" fsiargs ["target", target] + if exit <> 0 then + failwith "generating reference documentation failed" + () + +Target "GenerateReferenceDocs" (fun _ -> + buildDocumentationTarget "-d:RELEASE -d:REFERENCE" "Default" +) + +let generateHelp' fail debug = + let args = + if debug then "--define:HELP" + else "--define:RELEASE --define:HELP" + try + buildDocumentationTarget args "Default" + traceImportant "Help generated" + with + | e when not fail -> + traceImportant "generating help documentation failed" + +let generateHelp fail = + generateHelp' fail false + +Target "GenerateHelp" (fun _ -> + DeleteFile "docs/content/release-notes.md" + CopyFile "docs/content/" "RELEASE_NOTES.md" + Rename "docs/content/release-notes.md" "docs/content/RELEASE_NOTES.md" + + DeleteFile "docs/content/license.md" + CopyFile "docs/content/" "LICENSE.txt" + Rename "docs/content/license.md" "docs/content/LICENSE.txt" + + generateHelp true +) + +Target "GenerateHelpDebug" (fun _ -> + DeleteFile "docs/content/release-notes.md" + CopyFile "docs/content/" "RELEASE_NOTES.md" + Rename "docs/content/release-notes.md" "docs/content/RELEASE_NOTES.md" + + DeleteFile "docs/content/license.md" + CopyFile "docs/content/" "LICENSE.txt" + Rename "docs/content/license.md" "docs/content/LICENSE.txt" + + generateHelp' true true +) + +Target "KeepRunning" (fun _ -> + use watcher = !! "docs/content/**/*.*" |> WatchChanges (fun changes -> + generateHelp' true true + ) + + traceImportant "Waiting for help edits. Press any key to stop." + + System.Console.ReadKey() |> ignore + + watcher.Dispose() +) + +Target "GenerateDocs" DoNothing + +let createIndexFsx lang = + let content = """(*** hide ***) +// This block of code is omitted in the generated HTML documentation. Use +// it to define helpers that you do not want to show in the documentation. +#I "../../../bin" + +(** +F# Project Scaffold ({0}) +========================= +*) +""" + let targetDir = "docs/content" lang + let targetFile = targetDir "index.fsx" + ensureDirectory targetDir + System.IO.File.WriteAllText(targetFile, System.String.Format(content, lang)) + +Target "AddLangDocs" (fun _ -> + let args = System.Environment.GetCommandLineArgs() + if args.Length < 4 then + failwith "Language not specified." + + args.[3..] + |> Seq.iter (fun lang -> + if lang.Length <> 2 && lang.Length <> 3 then + failwithf "Language must be 2 or 3 characters (ex. 'de', 'fr', 'ja', 'gsw', etc.): %s" lang + + let templateFileName = "template.cshtml" + let templateDir = "docs/tools/templates" + let langTemplateDir = templateDir lang + let langTemplateFileName = langTemplateDir templateFileName + + if System.IO.File.Exists(langTemplateFileName) then + failwithf "Documents for specified language '%s' have already been added." lang + + ensureDirectory langTemplateDir + Copy langTemplateDir [ templateDir templateFileName ] + + createIndexFsx lang) +) + +// -------------------------------------------------------------------------------------- +// Release Scripts + +Target "ReleaseDocs" (fun _ -> + let tempDocsDir = "temp/gh-pages" + CleanDir tempDocsDir + Repository.cloneSingleBranch "" (gitHome + "/" + gitName + ".git") "gh-pages" tempDocsDir + + CopyRecursive "docs/output" tempDocsDir true |> tracefn "%A" + StageAll tempDocsDir + Git.Commit.Commit tempDocsDir (sprintf "Update generated documentation for version %s" release.NugetVersion) + Branches.push tempDocsDir +) + +#load "paket-files/build/fsharp/FAKE/modules/Octokit/Octokit.fsx" +open Octokit + +Target "Release" (fun _ -> + let user = + match getBuildParam "github-user" with + | s when not (String.IsNullOrWhiteSpace s) -> s + | _ -> getUserInput "Username: " + let pw = + match getBuildParam "github-pw" with + | s when not (String.IsNullOrWhiteSpace s) -> s + | _ -> getUserPassword "Password: " + let remote = + Git.CommandHelper.getGitResult "" "remote -v" + |> Seq.filter (fun (s: string) -> s.EndsWith("(push)")) + |> Seq.tryFind (fun (s: string) -> s.Contains(gitOwner + "/" + gitName)) + |> function None -> gitHome + "/" + gitName | Some (s: string) -> s.Split().[0] + + StageAll "" + Git.Commit.Commit "" (sprintf "Bump version to %s" release.NugetVersion) + Branches.pushBranch "" remote (Information.getBranchName "") + + Branches.tag "" release.NugetVersion + Branches.pushTag "" remote release.NugetVersion + + // release on github + createClient user pw + |> createDraft gitOwner gitName release.NugetVersion (release.SemVer.PreRelease <> None) release.Notes + // TODO: |> uploadFile "PATH_TO_FILE" + |> releaseDraft + |> Async.RunSynchronously +) + +Target "BuildPackage" DoNothing + +// -------------------------------------------------------------------------------------- +// Run all targets by default. Invoke 'build ' to override + +Target "All" DoNothing + +"AssemblyInfo" + ==> "Build" + ==> "CopyBinaries" + ==> "RunTests" + ==> "GenerateReferenceDocs" + ==> "GenerateDocs" +#if MONO +#else + =?> ("SourceLink", Pdbstr.tryFind().IsSome ) +#endif + ==> "NuGet" + ==> "BuildPackage" + ==> "All" + =?> ("ReleaseDocs",isLocalBuild) + +"GenerateHelp" + ==> "GenerateReferenceDocs" + ==> "GenerateDocs" + +"GenerateHelpDebug" + ==> "KeepRunning" + +"Clean" + ==> "Release" + +"BuildPackage" + ==> "PublishNuget" + ==> "Release" + +"ReleaseDocs" + ==> "Release" + +RunTargetOrDefault "All" diff --git a/build.sh b/build.sh new file mode 100755 index 0000000..c5de482 --- /dev/null +++ b/build.sh @@ -0,0 +1,77 @@ +#!/usr/bin/env bash + +set -eu + +cd "$(dirname "$0")" + +PAKET_BOOTSTRAPPER_EXE=.paket/paket.bootstrapper.exe +PAKET_EXE=.paket/paket.exe +FAKE_EXE=packages/build/FAKE/tools/FAKE.exe + +FSIARGS="" +FSIARGS2="" +OS=${OS:-"unknown"} +if [ "$OS" != "Windows_NT" ] +then + # Can't use FSIARGS="--fsiargs -d:MONO" in zsh, so split it up + # (Can't use arrays since dash can't handle them) + FSIARGS="--fsiargs" + FSIARGS2="-d:MONO" +fi + +run() { + if [ "$OS" != "Windows_NT" ] + then + mono "$@" + else + "$@" + fi +} + +yesno() { + # NOTE: Defaults to NO + read -p "$1 [y/N] " ynresult + case "$ynresult" in + [yY]*) true ;; + *) false ;; + esac +} + +set +e +run $PAKET_BOOTSTRAPPER_EXE +bootstrapper_exitcode=$? +set -e + +if [ "$OS" != "Windows_NT" ] && + [ $bootstrapper_exitcode -ne 0 ] && + [ $(certmgr -list -c Trust | grep X.509 | wc -l) -le 1 ] && + [ $(certmgr -list -c -m Trust | grep X.509 | wc -l) -le 1 ] +then + echo "Your Mono installation has no trusted SSL root certificates set up." + echo "This may result in the Paket bootstrapper failing to download Paket" + echo "because Github's SSL certificate can't be verified. One way to fix" + echo "this issue would be to download the list of SSL root certificates" + echo "from the Mozilla project by running the following command:" + echo "" + echo " mozroots --import --sync" + echo "" + echo "This will import over 100 SSL root certificates into your Mono" + echo "certificate repository." + echo "" + if yesno "Run 'mozroots --import --sync' now?" + then + mozroots --import --sync + else + echo "Attempting to continue without running mozroots. This might fail." + fi + # Re-run bootstrapper whether or not the user ran mozroots, because maybe + # they fixed the problem in a separate terminal window. + run $PAKET_BOOTSTRAPPER_EXE +fi + +run $PAKET_EXE restore + +[ ! -e build.fsx ] && run $PAKET_EXE update +[ ! -e build.fsx ] && run $FAKE_EXE init.fsx +run $FAKE_EXE "$@" $FSIARGS $FSIARGS2 build.fsx + diff --git a/docs/content/index.fsx b/docs/content/index.fsx new file mode 100644 index 0000000..495f14e --- /dev/null +++ b/docs/content/index.fsx @@ -0,0 +1,67 @@ +(*** hide ***) +// This block of code is omitted in the generated HTML documentation. Use +// it to define helpers that you do not want to show in the documentation. +#I "../../bin" + +(** +Higher +====================== + +Documentation + +
+
+
+
+ The Higher library can be installed from NuGet: +
PM> Install-Package Higher
+
+
+
+
+ +Example +------- + +This example demonstrates using a function defined in this sample library. + +*) +#r "Higher.dll" +open Higher + +printfn "hello = %i" <| Library.hello 0 + +(** +Some more info + +Samples & documentation +----------------------- + +The library comes with comprehensible documentation. +It can include tutorials automatically generated from `*.fsx` files in [the content folder][content]. +The API reference is automatically generated from Markdown comments in the library implementation. + + * [Tutorial](tutorial.html) contains a further explanation of this sample library. + + * [API Reference](reference/index.html) contains automatically generated documentation for all types, modules + and functions in the library. This includes additional brief samples on using most of the + functions. + +Contributing and copyright +-------------------------- + +The project is hosted on [GitHub][gh] where you can [report issues][issues], fork +the project and submit pull requests. If you're adding a new public API, please also +consider adding [samples][content] that can be turned into a documentation. You might +also want to read the [library design notes][readme] to understand how it works. + +The library is available under Public Domain license, which allows modification and +redistribution for both commercial and non-commercial purposes. For more information see the +[License file][license] in the GitHub repository. + + [content]: https://github.com/fsprojects/Higher/tree/master/docs/content + [gh]: https://github.com/fsprojects/Higher + [issues]: https://github.com/fsprojects/Higher/issues + [readme]: https://github.com/fsprojects/Higher/blob/master/README.md + [license]: https://github.com/fsprojects/Higher/blob/master/LICENSE.txt +*) diff --git a/docs/content/tutorial.fsx b/docs/content/tutorial.fsx new file mode 100644 index 0000000..2501c0e --- /dev/null +++ b/docs/content/tutorial.fsx @@ -0,0 +1,19 @@ +(*** hide ***) +// This block of code is omitted in the generated HTML documentation. Use +// it to define helpers that you do not want to show in the documentation. +#I "../../bin" + +(** +Introducing your project +======================== + +Say more + +*) +#r "Higher.dll" +open Higher + +Library.hello 0 +(** +Some more info +*) diff --git a/docs/files/img/logo-template.pdn b/docs/files/img/logo-template.pdn new file mode 100644 index 0000000..52606f5 Binary files /dev/null and b/docs/files/img/logo-template.pdn differ diff --git a/docs/files/img/logo.png b/docs/files/img/logo.png new file mode 100644 index 0000000..8a2b81b Binary files /dev/null and b/docs/files/img/logo.png differ diff --git a/docs/tools/generate.fsx b/docs/tools/generate.fsx new file mode 100644 index 0000000..db6f3bb --- /dev/null +++ b/docs/tools/generate.fsx @@ -0,0 +1,145 @@ +// -------------------------------------------------------------------------------------- +// Builds the documentation from `.fsx` and `.md` files in the 'docs/content' directory +// (the generated documentation is stored in the 'docs/output' directory) +// -------------------------------------------------------------------------------------- + +// Binaries that have XML documentation (in a corresponding generated XML file) +// Any binary output / copied to bin/projectName/projectName.dll will +// automatically be added as a binary to generate API docs for. +// for binaries output to root bin folder please add the filename only to the +// referenceBinaries list below in order to generate documentation for the binaries. +// (This is the original behaviour of ProjectScaffold prior to multi project support) +let referenceBinaries = [] +// Web site location for the generated documentation +let website = "/Higher" + +let githubLink = "https://github.com/palladin/Higher" + +// Specify more information about your project +let info = + [ "project-name", "Higher" + "project-author", "palladin" + "project-summary", "Lightweight Higher-Kinded Polymorphism" + "project-github", githubLink + "project-nuget", "http://nuget.org/packages/Higher" ] + +// -------------------------------------------------------------------------------------- +// For typical project, no changes are needed below +// -------------------------------------------------------------------------------------- + +#load "../../packages/build/FSharp.Formatting/FSharp.Formatting.fsx" +#I "../../packages/build/FAKE/tools/" +#r "FakeLib.dll" +open Fake +open System.IO +open Fake.FileHelper +open FSharp.Literate +open FSharp.MetadataFormat + +// When called from 'build.fsx', use the public project URL as +// otherwise, use the current 'output' directory. +#if RELEASE +let root = website +#else +let root = "file://" + (__SOURCE_DIRECTORY__ @@ "../output") +#endif + +// Paths with template/source/output locations +let bin = __SOURCE_DIRECTORY__ @@ "../../bin" +let content = __SOURCE_DIRECTORY__ @@ "../content" +let output = __SOURCE_DIRECTORY__ @@ "../output" +let files = __SOURCE_DIRECTORY__ @@ "../files" +let templates = __SOURCE_DIRECTORY__ @@ "templates" +let formatting = __SOURCE_DIRECTORY__ @@ "../../packages/build/FSharp.Formatting/" +let docTemplate = "docpage.cshtml" + +// Where to look for *.csproj templates (in this order) +let layoutRootsAll = new System.Collections.Generic.Dictionary() +layoutRootsAll.Add("en",[ templates; formatting @@ "templates" + formatting @@ "templates/reference" ]) +subDirectories (directoryInfo templates) +|> Seq.iter (fun d -> + let name = d.Name + if name.Length = 2 || name.Length = 3 then + layoutRootsAll.Add( + name, [templates @@ name + formatting @@ "templates" + formatting @@ "templates/reference" ])) + +// Copy static files and CSS + JS from F# Formatting +let copyFiles () = + CopyRecursive files output true |> Log "Copying file: " + ensureDirectory (output @@ "content") + CopyRecursive (formatting @@ "styles") (output @@ "content") true + |> Log "Copying styles and scripts: " + +let binaries = + let manuallyAdded = + referenceBinaries + |> List.map (fun b -> bin @@ b) + + let conventionBased = + directoryInfo bin + |> subDirectories + |> Array.map (fun d -> d.FullName @@ (sprintf "%s.dll" d.Name)) + |> List.ofArray + + conventionBased @ manuallyAdded + +let libDirs = + let conventionBasedbinDirs = + directoryInfo bin + |> subDirectories + |> Array.map (fun d -> d.FullName) + |> List.ofArray + + conventionBasedbinDirs @ [bin] + +// Build API reference from XML comments +let buildReference () = + CleanDir (output @@ "reference") + MetadataFormat.Generate + ( binaries, output @@ "reference", layoutRootsAll.["en"], + parameters = ("root", root)::info, + sourceRepo = githubLink @@ "tree/master", + sourceFolder = __SOURCE_DIRECTORY__ @@ ".." @@ "..", + publicOnly = true,libDirs = libDirs ) + +// Build documentation from `fsx` and `md` files in `docs/content` +let buildDocumentation () = + + // First, process files which are placed in the content root directory. + + Literate.ProcessDirectory + ( content, docTemplate, output, replacements = ("root", root)::info, + layoutRoots = layoutRootsAll.["en"], + generateAnchors = true, + processRecursive = false) + + // And then process files which are placed in the sub directories + // (some sub directories might be for specific language). + + let subdirs = Directory.EnumerateDirectories(content, "*", SearchOption.TopDirectoryOnly) + for dir in subdirs do + let dirname = (new DirectoryInfo(dir)).Name + let layoutRoots = + // Check whether this directory name is for specific language + let key = layoutRootsAll.Keys + |> Seq.tryFind (fun i -> i = dirname) + match key with + | Some lang -> layoutRootsAll.[lang] + | None -> layoutRootsAll.["en"] // "en" is the default language + + Literate.ProcessDirectory + ( dir, docTemplate, output @@ dirname, replacements = ("root", root)::info, + layoutRoots = layoutRoots, + generateAnchors = true ) + +// Generate +copyFiles() +#if HELP +buildDocumentation() +#endif +#if REFERENCE +buildReference() +#endif diff --git a/docs/tools/templates/template.cshtml b/docs/tools/templates/template.cshtml new file mode 100644 index 0000000..1ae4a1b --- /dev/null +++ b/docs/tools/templates/template.cshtml @@ -0,0 +1,58 @@ + + + + + @Title + + + + + + + + + + + + + + + +
+ +
+
+
+ @RenderBody() +
+
+ F# Project + +
+
+
+ Fork me on GitHub + + diff --git a/lib/README.md b/lib/README.md new file mode 100644 index 0000000..11cdd7a --- /dev/null +++ b/lib/README.md @@ -0,0 +1,11 @@ +This file is in the `lib` directory. + +Any **libraries** on which your project depends and which are **NOT managed via NuGet** should be kept **in this directory**. +This typically includes custom builds of third-party software, private (i.e. to a company) codebases, and native libraries. + +--- +NOTE: + +This file is a placeholder, used to preserve directory structure in Git. + +This file does not need to be edited. diff --git a/paket.dependencies b/paket.dependencies new file mode 100644 index 0000000..c0c79d7 --- /dev/null +++ b/paket.dependencies @@ -0,0 +1,18 @@ +source https://nuget.org/api/v2 + +nuget FSharp.Core redirects: force + +group Build + source https://nuget.org/api/v2 + + nuget SourceLink.Fake + nuget FAKE + nuget FSharp.Formatting + + github fsharp/FAKE modules/Octokit/Octokit.fsx + +group Test + source https://nuget.org/api/v2 + + nuget NUnit ~> 2 + nuget NUnit.Runners ~> 2 \ No newline at end of file diff --git a/paket.lock b/paket.lock new file mode 100644 index 0000000..cb29758 --- /dev/null +++ b/paket.lock @@ -0,0 +1,32 @@ +NUGET + remote: https://www.nuget.org/api/v2 + FSharp.Core (4.0.0.1) - redirects: force + +GROUP Build +NUGET + remote: https://www.nuget.org/api/v2 + FAKE (4.41.6) + FSharp.Compiler.Service (2.0.0.6) + FSharp.Formatting (2.14.4) + FSharp.Compiler.Service (2.0.0.6) + FSharpVSPowerTools.Core (>= 2.3 < 2.4) + FSharpVSPowerTools.Core (2.3) + FSharp.Compiler.Service (>= 2.0.0.3) + Microsoft.Bcl (1.1.10) - framework: net10, net11, net20, net30, net35, net40, net40-full + Microsoft.Bcl.Build (>= 1.0.14) + Microsoft.Bcl.Build (1.0.21) - import_targets: false, framework: net10, net11, net20, net30, net35, net40, net40-full + Microsoft.Net.Http (2.2.29) - framework: net10, net11, net20, net30, net35, net40, net40-full + Microsoft.Bcl (>= 1.1.10) + Microsoft.Bcl.Build (>= 1.0.14) + Octokit (0.23) + Microsoft.Net.Http - framework: net10, net11, net20, net30, net35, net40, net40-full + SourceLink.Fake (1.1) +GITHUB + remote: fsharp/FAKE + modules/Octokit/Octokit.fsx (889bda9367dfb24f9abb524165a0dbe2cdd86252) + Octokit (>= 0.20) +GROUP Test +NUGET + remote: https://www.nuget.org/api/v2 + NUnit (2.6.4) + NUnit.Runners (2.6.4) diff --git a/src/Higher.Core/Algebra.fs b/src/Higher.Core/Algebra.fs deleted file mode 100644 index 6e7cc58..0000000 --- a/src/Higher.Core/Algebra.fs +++ /dev/null @@ -1,5 +0,0 @@ -namespace Higher.Core - -type Algebra<'F, 'A> = App<'F, 'A> -> 'A - -type CoAlgebra<'F, 'A> = 'A -> App<'F, 'A> \ No newline at end of file diff --git a/src/Higher.Core/Higher.Core.fsproj b/src/Higher.Core/Higher.Core.fsproj deleted file mode 100644 index 5374b54..0000000 --- a/src/Higher.Core/Higher.Core.fsproj +++ /dev/null @@ -1,116 +0,0 @@ - - - - - Debug - AnyCPU - {C979A279-D345-469C-84B9-DACCFDE18FFD} - Library - Higher.Core - Higher.Core - v4.5 - 4.3.1.0 - Higher.Core - - - true - full - false - false - bin\Debug\ - DEBUG;TRACE - 3 - bin\Debug\Higher.Core.XML - - - pdbonly - true - true - bin\Release\ - TRACE - 3 - bin\Release\Higher.Core.XML - - - 11 - - - - - $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets - - - - - $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - True - - - - \ No newline at end of file diff --git a/src/Higher.Core/Adjunction.fs b/src/Higher/Adjunction.fs similarity index 68% rename from src/Higher.Core/Adjunction.fs rename to src/Higher/Adjunction.fs index 013c5d4..c42fef1 100644 --- a/src/Higher.Core/Adjunction.fs +++ b/src/Higher/Adjunction.fs @@ -1,28 +1,28 @@ -namespace Higher.Core +namespace Higher [] -type Adjunction<'F, 'G>(func : Functor<'F>, g : Functor<'G>) = +type Adjunction<'F, 'G>(func : Functor<'F>, g : Functor<'G>) = abstract Unit : 'A -> App<'G, App<'F, 'A>> abstract CoUnit : App<'F, App<'G, 'A>> -> 'A - member self.LeftAdjunct (f : App<'F, 'A> -> 'B) (v : 'A) : App<'G, 'B> = + member self.LeftAdjunct (f : App<'F, 'A> -> 'B) (v : 'A) : App<'G, 'B> = g.Map f (self.Unit v) - member self.RightAdjunct (f : 'A -> App<'G, 'B>) (v : App<'F, 'A>) : 'B = + member self.RightAdjunct (f : 'A -> App<'G, 'B>) (v : App<'F, 'A>) : 'B = self.CoUnit <| func.Map f v member self.F : Functor<'F> = func member self.G : Functor<'G> = g -type AdjunctionMonad<'F, 'G>(adj : Adjunction<'F, 'G>) = +type AdjunctionMonad<'F, 'G>(adj : Adjunction<'F, 'G>) = inherit Monad>() - override self.Return (x : 'A) : App3 = + override self.Return (x : 'A) : App3 = Compose.Inj <| Comp (adj.Unit x) - override self.Bind (c : App3, k : 'A -> App3) = + override self.Bind (c : App3, k : 'A -> App3) = let comp = adj.G.Map (adj.RightAdjunct (Compose.Run << k)) (Compose.Run c) comp |> Comp |> Compose.Inj -type AdjunctionComonad<'F, 'G>(adj : Adjunction<'F, 'G>) = +type AdjunctionComonad<'F, 'G>(adj : Adjunction<'F, 'G>) = inherit Comonad>() - override self.Extract<'A> (w:App3) : 'A = - w |> Compose.Run |> adj.CoUnit + override self.Extract<'A> (w:App3) : 'A = + w |> Compose.Run |> adj.CoUnit override self.Extend<'A, 'B> (f:App3 -> 'B) (w:App3) : App3 = - let comp = adj.F.Map (adj.LeftAdjunct (f << Compose.Inj << Comp)) (Compose.Run w) - comp |> Comp |> Compose.Inj \ No newline at end of file + let comp = adj.F.Map (adj.LeftAdjunct (f << Compose.Inj << Comp)) (Compose.Run w) + comp |> Comp |> Compose.Inj diff --git a/src/Higher/Algebra.fs b/src/Higher/Algebra.fs new file mode 100644 index 0000000..f446a99 --- /dev/null +++ b/src/Higher/Algebra.fs @@ -0,0 +1,5 @@ +namespace Higher + +type Algebra<'F, 'A> = App<'F, 'A> -> 'A + +type CoAlgebra<'F, 'A> = 'A -> App<'F, 'A> diff --git a/src/Higher/App.config b/src/Higher/App.config new file mode 100644 index 0000000..7c7a547 --- /dev/null +++ b/src/Higher/App.config @@ -0,0 +1,10 @@ + + + + + + True + + + + diff --git a/src/Higher.Core/Applicative.fs b/src/Higher/Applicative.fs similarity index 54% rename from src/Higher.Core/Applicative.fs rename to src/Higher/Applicative.fs index 1de0f5d..4927d7b 100644 --- a/src/Higher.Core/Applicative.fs +++ b/src/Higher/Applicative.fs @@ -1,12 +1,10 @@ -namespace Higher.Core +namespace Higher -// Applicative Class +/// Applicative Class [] -type Applicative<'F>() = - inherit Functor<'F>() - override self.Map f func = +type Applicative<'F>() = + inherit Functor<'F>() + override self.Map f func = self.Apply (self.Pure f) func abstract Pure<'T> : 'T -> App<'F, 'T> abstract Apply<'T, 'R> : App<'F, 'T -> 'R> -> App<'F, 'T> -> App<'F, 'R> - - diff --git a/src/Higher.Core/Arrow.fs b/src/Higher/Arrow.fs similarity index 91% rename from src/Higher.Core/Arrow.fs rename to src/Higher/Arrow.fs index 116b159..6827d23 100644 --- a/src/Higher.Core/Arrow.fs +++ b/src/Higher/Arrow.fs @@ -1,4 +1,4 @@ -namespace Higher.Core +namespace Higher [] type Arrow<'F>() = @@ -15,4 +15,4 @@ type Arrow<'F>() = member self.Split (a : App2<'F, 'A, 'B>) (b : App2<'F, 'C, 'D>) : App2<'F, 'A * 'C, 'B * 'D> = self.First a |> self.Compose (self.Second b) member self.Fanout (a : App2<'F, 'A, 'B>) (b : App2<'F, 'A, 'C>) : App2<'F, 'A, 'B * 'C> = - self.Split a b |> self.MapIn (fun a -> a,a) \ No newline at end of file + self.Split a b |> self.MapIn (fun a -> a,a) diff --git a/src/Higher.Core/Category.fs b/src/Higher/Category.fs similarity index 58% rename from src/Higher.Core/Category.fs rename to src/Higher/Category.fs index 30162f4..7a52d72 100644 --- a/src/Higher.Core/Category.fs +++ b/src/Higher/Category.fs @@ -1,7 +1,7 @@ -namespace Higher.Core +namespace Higher -// Category Class +/// Category Class [] -type Category<'F>() = +type Category<'F>() = abstract Ident<'A> : unit -> App2<'F, 'A, 'A> - abstract Compose<'A, 'B, 'C> : App2<'F, 'A, 'B> -> App2<'F, 'B, 'C> -> App2<'F, 'A, 'C> \ No newline at end of file + abstract Compose<'A, 'B, 'C> : App2<'F, 'A, 'B> -> App2<'F, 'B, 'C> -> App2<'F, 'A, 'C> diff --git a/src/Higher.Core/Choice.fs b/src/Higher/Choice.fs similarity index 81% rename from src/Higher.Core/Choice.fs rename to src/Higher/Choice.fs index 88b1ecf..7873c14 100644 --- a/src/Higher.Core/Choice.fs +++ b/src/Higher/Choice.fs @@ -1,20 +1,20 @@ -namespace Higher.Core +namespace Higher -// Choice Monad type +/// Choice Monad type type Choice private () = static let token = new Choice() - static member Inj (value : Choice<'A,'B>) : App2 = + static member Inj (value : Choice<'A,'B>) : App2 = let app = new App(token, value) new App2<_, _, _>(AppToken.Token token, app) - static member Prj (app2 : App2) : Choice<'A, 'B> = + static member Prj (app2 : App2) : Choice<'A, 'B> = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ -// Choice Monad instance -type ChoiceMonad<'A>() = +/// Choice Monad instance +type ChoiceMonad<'A>() = inherit Monad>() with override self.Return x = Choice.Inj <| Choice2Of2 x - override self.Bind (m, f) = + override self.Bind (m, f) = match Choice.Prj m with | Choice2Of2 v -> f v | Choice1Of2 a -> Choice.Inj (Choice1Of2 a) diff --git a/src/Higher.Core/CoYoneda.fs b/src/Higher/CoYoneda.fs similarity index 71% rename from src/Higher.Core/CoYoneda.fs rename to src/Higher/CoYoneda.fs index 9531321..6319801 100644 --- a/src/Higher.Core/CoYoneda.fs +++ b/src/Higher/CoYoneda.fs @@ -1,41 +1,35 @@ -namespace Higher.Core +namespace Higher -type Lambda<'F, 'A, 'R> = +type Lambda<'F, 'A, 'R> = abstract Invoke<'B> : ('B -> 'A) -> App<'F, 'B> -> 'R -// type CoYoneda f α = ∃β. (β → α) * f β +/// type CoYoneda f α = ∃β. (β → α) * f β [] type CoYoneda<'F, 'A>() = - abstract Invoke<'R> : Lambda<'F, 'A, 'R> -> 'R + abstract Invoke<'R> : Lambda<'F, 'A, 'R> -> 'R -type CoYonedaConstr<'F, 'B, 'A>(f : 'B -> 'A, app : App<'F, 'B>) = +type CoYonedaConstr<'F, 'B, 'A>(f : 'B -> 'A, app : App<'F, 'B>) = inherit CoYoneda<'F, 'A>() - override self.Invoke lambda = + override self.Invoke lambda = lambda.Invoke f app type CoYoneda private () = static let token = new CoYoneda() - static member Inj (value : CoYoneda<'F, 'A>) : App2 = + static member Inj (value : CoYoneda<'F, 'A>) : App2 = let app = new App(token, value) new App2(AppToken.Token token, app) - static member Prj (app2 : App2) : CoYoneda<'F, 'A> = + static member Prj (app2 : App2) : CoYoneda<'F, 'A> = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ -type CoYonedaFunctor<'F>() = +type CoYonedaFunctor<'F>() = inherit Functor>() - - override self.Map (f : 'A -> 'B) (app : App2) = + + override self.Map (f : 'A -> 'B) (app : App2) = CoYoneda.Inj <| - (CoYoneda.Prj app).Invoke> + (CoYoneda.Prj app).Invoke> { new Lambda<'F, 'A, CoYoneda<'F, 'B>> with - member self.Invoke<'C> (k : 'C -> 'A) (app : App<'F, 'C>) = - new CoYonedaConstr<'F, 'C, 'B>(k >> f, app) :> CoYoneda<'F, 'B> } - - - - - - + member self.Invoke<'C> (k : 'C -> 'A) (app : App<'F, 'C>) = + new CoYonedaConstr<'F, 'C, 'B>(k >> f, app) :> CoYoneda<'F, 'B> } diff --git a/src/Higher.Core/Codensity.fs b/src/Higher/Codensity.fs similarity index 76% rename from src/Higher.Core/Codensity.fs rename to src/Higher/Codensity.fs index 8191fdd..2b588af 100644 --- a/src/Higher.Core/Codensity.fs +++ b/src/Higher/Codensity.fs @@ -1,33 +1,29 @@ -namespace Higher.Core +namespace Higher -// type C µ α = C (∀β. (α → µ β) → µ β) +/// type C µ α = C (∀β. (α → µ β) → µ β) type Codensity<'M, 'A> = abstract Invoke<'B> : ('A -> App<'M, 'B>) -> App<'M, 'B> type CodenT private () = static let token = new CodenT() - static member Inj (value : Codensity<'M, 'T>) : App2 = + static member Inj (value : Codensity<'M, 'T>) : App2 = let app = new App(token, value) new App2(AppToken.Token token, app) - static member Prj (app2 : App2) : Codensity<'M, 'T> = + static member Prj (app2 : App2) : Codensity<'M, 'T> = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ -type CodensityMonad<'M>() = +type CodensityMonad<'M>() = inherit Monad>() - override self.Return (x : 'A) = - CodenT.Inj <| + override self.Return (x : 'A) = + CodenT.Inj <| { new Codensity<'M, 'A> with member self.Invoke<'B> (f : 'A -> App<'M, 'B>) = f x } - override self.Bind (c : App2, k : 'A -> App2) = - CodenT.Inj <| + override self.Bind (c : App2, k : 'A -> App2) = + CodenT.Inj <| { new Codensity<'M, 'B> with member self.Invoke<'R> (f : 'B -> App<'M, 'R>) = - let c = CodenT.Prj c + let c = CodenT.Prj c c.Invoke (fun a -> let c' = CodenT.Prj (k a) in c'.Invoke f) } - - - - diff --git a/src/Higher.Core/Cofree.fs b/src/Higher/Cofree.fs similarity index 88% rename from src/Higher.Core/Cofree.fs rename to src/Higher/Cofree.fs index edeb517..dd154e8 100644 --- a/src/Higher.Core/Cofree.fs +++ b/src/Higher/Cofree.fs @@ -1,33 +1,35 @@ -namespace Higher.Core +namespace Higher /// Cofree comonad - an 'A stream with branching factor 'F. type Cofree<'F, 'A> = Cofree of 'A * App<'F, Cofree<'F, 'A>> type Cofree private () = - static let token = new Cofree() + static let token = new Cofree() static member Inj (value : Cofree<'F, 'A>) : App2 = let app = new App(token, value) - new App2(AppToken.Token token, app) + new App2(AppToken.Token token, app) static member Prj (app2 : App2) : Cofree<'F, 'A> = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ + type CofreeComonad<'F>(func : Functor<'F>) = inherit Comonad>() with - override self.Extract (c : App2) : 'A = + override self.Extract (c : App2) : 'A = let (Cofree(a,_)) = Cofree.Prj c in a override self.Extend (f : App2 -> 'B) (fa : App2) : App2 = - let (Cofree(a, ffa)) = Cofree.Prj fa + let (Cofree(_, ffa)) = Cofree.Prj fa let ffb = func.Map (fun fa -> self.Extend f (Cofree.Inj fa) |> Cofree.Prj) ffa Cofree.Cofree(f fa, ffb) |> Cofree.Inj + type Cofree with - + static member inline head (Cofree(a,_)) = a static member inline tail (Cofree(_,tl)) = tl - - static member toList (cofree : Cofree ) : 'A list = + + static member toList (cofree : Cofree ) : 'A list = let (Cofree(a, ffa)) = cofree in match Option.Prj ffa with | Some cofree -> a::(Cofree.toList cofree) @@ -35,5 +37,3 @@ type Cofree with static member ana (func : Functor<'F>) (f : 'A -> 'B) (g : 'A -> App<'F, 'A>) (a : 'A) : Cofree<'F, 'B> = Cofree.Cofree(f a, g a |> func.Map (Cofree.ana func f g)) - - diff --git a/src/Higher.Core/Comonad.fs b/src/Higher/Comonad.fs similarity index 92% rename from src/Higher.Core/Comonad.fs rename to src/Higher/Comonad.fs index 87a5f2e..86dbf86 100644 --- a/src/Higher.Core/Comonad.fs +++ b/src/Higher/Comonad.fs @@ -1,17 +1,18 @@ -namespace Higher.Core +namespace Higher -// Comonad Class +/// Comonad Class [] -type Comonad<'W>() = +type Comonad<'W>() = inherit Functor<'W>() override self.Map (f : 'A -> 'B) (func : App<'W, 'A>) = self.Extend (self.Extract >> f) func abstract Extract<'A> : App<'W, 'A> -> 'A abstract Extend<'A, 'B> : (App<'W, 'A> -> 'B) -> App<'W, 'A> -> App<'W, 'B> -// Generic comonad functions. + +/// Generic comonad functions. module Comonad = - + let duplicate (comonad : Comonad<'W>) (w : App<'W, 'A>) : App<'W, App<'W, 'A>> = comonad.Extend id w @@ -33,13 +34,12 @@ type ComonadZip<'W>() = inherit Comonad<'W>() abstract Apply : App<'W, 'A -> 'B> -> App<'W, 'A> -> App<'W, 'B> + module ComonadZip = - + let lift2 (comonad : ComonadZip<'W>) (f : 'A -> 'B -> 'C) (wa : App<'W, 'A>) (wb : App<'W, 'B>) : App<'W, 'C> = let wbc = comonad.Extend (comonad.Extract >> f) wa comonad.Apply wbc wb let zip (comonad : ComonadZip<'W>) (wa : App<'W, 'A>) (wb : App<'W, 'B>) : App<'W, 'A * 'B> = lift2 comonad (fun a b -> a,b) wa wb - - \ No newline at end of file diff --git a/src/Higher.Core/Compose.fs b/src/Higher/Compose.fs similarity index 82% rename from src/Higher.Core/Compose.fs rename to src/Higher/Compose.fs index 4122e66..562dde7 100644 --- a/src/Higher.Core/Compose.fs +++ b/src/Higher/Compose.fs @@ -1,10 +1,10 @@ -namespace Higher.Core +namespace Higher type Compose<'F, 'G, 'A> = Comp of App<'F, App<'G, 'A>> -type Compose private () = +type Compose private () = static let token = new Compose() - static member Inj (value : Compose<'F, 'G, 'A>) : App3 = + static member Inj (value : Compose<'F, 'G, 'A>) : App3 = let app = new App(token, value) let app2 = new App2(AppToken.Token token, app) new App3(AppToken, 'G>.Token app, app2) @@ -14,22 +14,19 @@ type Compose private () = let app2 = app3.Apply(token'') :?> App2 let app = app2.Apply(token') :?> App app.Apply(token) :?> _ - static member Run (app3 : App3) : App<'F, App<'G, 'A>> = + static member Run (app3 : App3) : App<'F, App<'G, 'A>> = let (Comp app) = Compose.Prj app3 in app -type ComposeFunctor<'F, 'G>(F : Functor<'F>, G : Functor<'G>) = +type ComposeFunctor<'F, 'G>(F : Functor<'F>, G : Functor<'G>) = inherit Functor>() - override self.Map (f : 'A -> 'B) (app : App3) : App3 = + override self.Map (f : 'A -> 'B) (app : App3) : App3 = Compose.Inj <| Comp (F.Map (G.Map f) (Compose.Run app)) - -type ComposeApplicative<'F, 'G>(F : Applicative<'F>, G : Applicative<'G>) = + +type ComposeApplicative<'F, 'G>(F : Applicative<'F>, G : Applicative<'G>) = inherit Applicative>() - override self.Pure (v : 'A) : App3 = + override self.Pure (v : 'A) : App3 = Compose.Inj <| Comp (F.Pure (G.Pure v)) override self.Apply (f : App, 'A -> 'B>) (app : App3) : App3 = Compose.Inj <| Comp (F.Apply (F.Map G.Apply (Compose.Run f)) (Compose.Run app)) - - - diff --git a/src/Higher.Core/Const.fs b/src/Higher/Const.fs similarity index 73% rename from src/Higher.Core/Const.fs rename to src/Higher/Const.fs index 9733a34..62dcfa0 100644 --- a/src/Higher.Core/Const.fs +++ b/src/Higher/Const.fs @@ -1,17 +1,16 @@ -namespace Higher.Core +namespace Higher type Const<'A, 'B> = C of 'A -type Const private () = +type Const private () = static let token = Const () static member Inj (value : Const<'A, 'B>) : App2 = App2(AppToken.Token token, value) static member Prj (app : App2) : Const<'A, 'B> = app.Apply(AppToken.Token token) :?> _ - + type ConstFunctor<'K>() = inherit Functor>() with - override self.Map (f : 'A -> 'B) (app : App2) : App2 = - let (C k) = app |> Const.Prj + override self.Map (_ : 'A -> 'B) (app : App2) : App2 = + let (C k) = app |> Const.Prj (C k) |> Const.Inj - diff --git a/src/Higher.Core/Cont.fs b/src/Higher/Cont.fs similarity index 75% rename from src/Higher.Core/Cont.fs rename to src/Higher/Cont.fs index 6171fe4..f727398 100644 --- a/src/Higher.Core/Cont.fs +++ b/src/Higher/Cont.fs @@ -1,24 +1,24 @@ -namespace Higher.Core +namespace Higher -// Continuation Monad type +/// Continuation Monad type type Cont<'R, 'T> = C of (('T -> 'R) -> 'R) + type Cont private () = static let token = new Cont() - static member Inj (value : Cont<'R, 'T>) : App2 = + static member Inj (value : Cont<'R, 'T>) : App2 = let app = new App(token, value) new App2(AppToken.Token token, app) - static member Prj (app2 : App2) : Cont<'R, 'T> = + static member Prj (app2 : App2) : Cont<'R, 'T> = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ - static member Run(cont : App2) = + static member Run(cont : App2) = let (C f) = Cont.Prj cont in f -// Continuation Monad instance -type ContMonad<'R>() = +/// Continuation Monad instance +type ContMonad<'R>() = inherit Monad>() with override self.Return x = Cont.Inj <| C (fun k -> k x) - override self.Bind (m, f) = - Cont.Inj <| C (fun k -> + override self.Bind (m, f) = + Cont.Inj <| C (fun k -> let contF = Cont.Run m contF (fun x -> Cont.Run (f x) k)) - diff --git a/src/Higher.Core/ContT.fs b/src/Higher/ContT.fs similarity index 69% rename from src/Higher.Core/ContT.fs rename to src/Higher/ContT.fs index 51a9192..59fd8c5 100644 --- a/src/Higher.Core/ContT.fs +++ b/src/Higher/ContT.fs @@ -1,10 +1,11 @@ -namespace Higher.Core +namespace Higher -// Continuation Monad Transformer type -type ContT<'R, 'M, 'T> = CT of (('T -> App<'M, 'R>) -> App<'M, 'R>) -type ContT private () = +/// Continuation Monad Transformer type +type ContT<'R, 'M, 'T> = CT of (('T -> App<'M, 'R>) -> App<'M, 'R>) + +type ContT private () = static let token = new ContT() - static member Inj (value : ContT<'R, 'M, 'T>) : App3 = + static member Inj (value : ContT<'R, 'M, 'T>) : App3 = let app = new App(token, value) let app2 = new App2(AppToken.Token token, app) new App3(AppToken, 'M>.Token app, app2) @@ -14,26 +15,25 @@ type ContT private () = let app2 = app3.Apply(token'') :?> App2 let app = app2.Apply(token') :?> App app.Apply(token) :?> _ - static member Run (contT : App3) = + static member Run (contT : App3) = let (CT cont) = ContT.Prj contT in cont - -// ContT Monad Transformer instance -type ContTMonadTrans<'R>() = +/// ContT Monad Transformer instance +type ContTMonadTrans<'R>() = inherit MonadTrans>() with - override self.Lift monad m = + override self.Lift monad m = ContT.Inj <| CT (fun k -> monad { let! x = m in return! k x }) -// ContT Monad instance -type ContTMonad<'R, 'M>(monad : Monad<'M>) = +/// ContT Monad instance +type ContTMonad<'R, 'M>(monad : Monad<'M>) = inherit Monad>() with override self.Return x = ContT.Inj <| CT (fun k -> monad { return! k x }) - override self.Bind (m, f) = + override self.Bind (m, f) = ContT.Inj <| CT (fun k -> - let cont = ContT.Run m - cont (fun x -> + let cont = ContT.Run m + cont (fun x -> monad { return! ContT.Run (f x) k - })) \ No newline at end of file + })) diff --git a/src/Higher.Core/Coproduct.fs b/src/Higher/Coproduct.fs similarity index 59% rename from src/Higher.Core/Coproduct.fs rename to src/Higher/Coproduct.fs index a0e148d..956fccc 100644 --- a/src/Higher.Core/Coproduct.fs +++ b/src/Higher/Coproduct.fs @@ -1,109 +1,112 @@ -namespace Higher.Core +namespace Higher type Coproduct<'F,'G,'A> = Cp of Choice,App<'G,'A>> -type Coproduct private () = +type Coproduct private () = static let token = new Coproduct() - static member Inj (value: Coproduct<'F,'G,'A>) : App3 = + static member Inj (value: Coproduct<'F,'G,'A>) : App3 = let app = new App(token,value) let app2 = new App2(AppToken.Token token, app) new App3(AppToken,'G>.Token app, app2) - static member Prj (app3: App3) : Coproduct<'F,'G,'A> = + static member Prj (app3: App3) : Coproduct<'F,'G,'A> = let token' = AppToken.Token token let token'' = AppToken,'G>.Token token' let app2 = app3.Apply(token'') :?> App2 let app = app2.Apply(token') :?> App app.Apply(token) :?> _ + [] -module Coproduct = +module Coproduct = - let inline coproduct - (f: App<'F,'A> -> 'B) - (g: App<'G,'A> -> 'B) + let inline coproduct + (f: App<'F,'A> -> 'B) + (g: App<'G,'A> -> 'B) (cp: App3) : 'B = match Coproduct.Prj cp with | Cp (Choice1Of2 x) -> f x | Cp (Choice2Of2 x) -> g x - let inline left - (fa: App<'F,'A>) - : App3 = + let inline left + (fa: App<'F,'A>) + : App3 = Coproduct.Inj << Cp << Choice1Of2 <| fa - let inline right - (ga: App<'G,'A>) - : App3 = + let inline right + (ga: App<'G,'A>) + : App3 = Coproduct.Inj << Cp << Choice2Of2 <| ga type CoproductFunctor<'F,'G> - (functorF: Functor<'F>, functorG: Functor<'G>) = - + (functorF: Functor<'F>, functorG: Functor<'G>) = + inherit Functor>() - override self.Map - (f: 'A -> 'B) - (app: App3) - : App3 = + override self.Map + (f: 'A -> 'B) + (app: App3) + : App3 = - Coproduct.coproduct - (Coproduct.left << functorF.Map f) - (Coproduct.right << functorG.Map f) + Coproduct.coproduct + (Coproduct.left << functorF.Map f) + (Coproduct.right << functorG.Map f) app type CoproductTraversable<'F,'G> - (travF: Traversable<'F>, travG: Traversable<'G>) = - + (travF: Traversable<'F>, travG: Traversable<'G>) = + inherit Traversable>() - override self.Traverse<'H, 'T, 'R> - (app : Applicative<'H>) - (f : 'T -> App<'H, 'R>) - (trav : App3) - : App<'H,App3> = + override self.Traverse<'H, 'T, 'R> + (app : Applicative<'H>) + (f : 'T -> App<'H, 'R>) + (trav : App3) + : App<'H,App3> = Coproduct.coproduct (app.Map Coproduct.left << travF.Traverse app f) (app.Map Coproduct.right << travG.Traverse app f) trav + type CoproductComonad<'F,'G> - (comonadF: Comonad<'F>, comonadG: Comonad<'G>) = + (comonadF: Comonad<'F>, comonadG: Comonad<'G>) = inherit Comonad>() - override self.Extend - (f: App3 -> 'B) - (cp:App3) + override self.Extend + (f: App3 -> 'B) + (cp:App3) : App3 = Coproduct.coproduct (Coproduct.left << comonadF.Extend (f << Coproduct.left)) (Coproduct.right << comonadG.Extend (f << Coproduct.right)) - cp + cp - override self.Extract - (cp: App3) - : 'A = + override self.Extract + (cp: App3) + : 'A = Coproduct.coproduct comonadF.Extract comonadG.Extract cp + type CoproductContraFunctor<'F,'G> - (contraF : ContraFunctor<'F>, contraG : ContraFunctor<'G>) = + (contraF : ContraFunctor<'F>, contraG : ContraFunctor<'G>) = inherit ContraFunctor>() - override self.ContraMap - (f : 'A -> 'B) + override self.ContraMap + (f : 'A -> 'B) (cp : App3) - : App3 = - Coproduct.coproduct + : App3 = + Coproduct.coproduct (Coproduct.left << contraF.ContraMap f) (Coproduct.right << contraG.ContraMap f) - cp \ No newline at end of file + cp diff --git a/src/Higher.Core/CoreTypes.fs b/src/Higher/CoreTypes.fs similarity index 71% rename from src/Higher.Core/CoreTypes.fs rename to src/Higher/CoreTypes.fs index 42330d4..1b5fefc 100644 --- a/src/Higher.Core/CoreTypes.fs +++ b/src/Higher/CoreTypes.fs @@ -1,41 +1,33 @@ -namespace Higher.Core +namespace Higher open System -// The basic idea of Type Defunctionalization is based on +// The basic idea of Type Defunctionalization is based on // https://ocamllabs.github.io/higher/lightweight-higher-kinded-polymorphism.pdf // OCaml implementation https://github.com/ocamllabs/higher -// Represents type application -// To ensure type-safety we use a secret token based control access policy. +/// Represents type application. +/// To ensure type-safety we use a secret token based control access policy. type App<'F, 'T> (token : 'F, value : obj) = - do + do if Object.ReferenceEquals(token, Unchecked.defaultof<'F>) then raise <| new System.InvalidOperationException("Invalid token") // Apply the secret token to have access to the encapsulated value member self.Apply(token' : 'F) = - if Object.ReferenceEquals(token, token') then - value + if Object.ReferenceEquals(token, token') then + value else raise <| new InvalidOperationException("Invalid token") type App2<'F, 'T1, 'T2> = App, 'T2> type App3<'F, 'T1, 'T2, 'T3> = App, 'T3> type App4<'F, 'T1, 'T2, 'T3, 'T4> = App, 'T4> -// A Singleton-like type for managing parameterized tokens -type AppToken<'App, 'R>() = - static let appTokenRef = ref Unchecked.defaultof> - static member Token (token : 'App) = +// A Singleton-like type for managing parameterized tokens +type AppToken<'App, 'R>() = + static let appTokenRef = ref Unchecked.defaultof> + static member Token (token : 'App) = if !appTokenRef = Unchecked.defaultof> then lock appTokenRef (fun () -> if !appTokenRef = Unchecked.defaultof> then appTokenRef := new App<'App, 'R>(token, Unchecked.defaultof<'R>) ) !appTokenRef - - - - - - - - diff --git a/src/Higher.Core/FFree.fs b/src/Higher/FFree.fs similarity index 76% rename from src/Higher.Core/FFree.fs rename to src/Higher/FFree.fs index 8f5d19d..2fbb4de 100644 --- a/src/Higher.Core/FFree.fs +++ b/src/Higher/FFree.fs @@ -1,23 +1,23 @@ -namespace Higher.Core +namespace Higher // http://okmij.org/ftp/Computation/free-monad.html [] -type FFree<'F, 'A>() = - abstract Invoke<'R> : FFreeUnPack<'F, 'A, 'R> -> 'R +type FFree<'F, 'A>() = + abstract Invoke<'R> : FFreeUnPack<'F, 'A, 'R> -> 'R -and FPure<'F, 'A>(a : 'A) = +and FPure<'F, 'A>(a : 'A) = inherit FFree<'F, 'A>() - override self.Invoke unpack = + override self.Invoke unpack = unpack.Invoke a -and FImpure<'F, 'B, 'A>(app : App<'F, 'B>, f : 'B -> App2) = +and FImpure<'F, 'B, 'A>(app : App<'F, 'B>, f : 'B -> App2) = inherit FFree<'F, 'A>() - override self.Invoke unpack = + override self.Invoke unpack = unpack.Invoke<'B>(app, f) and FFreeUnPack<'F, 'A, 'R> = - abstract Invoke : 'A -> 'R + abstract Invoke : 'A -> 'R abstract Invoke<'B> : App<'F, 'B> * ('B -> App2) -> 'R and FFree private () = @@ -25,19 +25,19 @@ and FFree private () = static member Inj (value : FFree<'F, 'T>) : App2 = let app = new App(token, value) new App2(AppToken.Token token, app) - static member Prj (app2 : App2) : FFree<'F, 'T> = + static member Prj (app2 : App2) : FFree<'F, 'T> = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ -// Freer Monad instance -type FreerMonad<'F>() = +/// Freer Monad instance +type FreerMonad<'F>() = inherit Monad>() with override self.Return x = FFree.Inj <| new FPure<'F, 'A>(x) override self.Bind (app : App2, f : 'A -> App2) : App2 = let monad = self let ffree = FFree.Prj app - ffree.Invoke> + ffree.Invoke> { new FFreeUnPack<'F, 'A, App2> with member self.Invoke (a : 'A) = f a - member self.Invoke<'C> (app : App<'F, 'C>, f' : 'C -> App2) = - FFree.Inj <| new FImpure<'F, 'C, 'B>(app, Monad.compose monad f' f) } \ No newline at end of file + member self.Invoke<'C> (app : App<'F, 'C>, f' : 'C -> App2) = + FFree.Inj <| new FImpure<'F, 'C, 'B>(app, Monad.compose monad f' f) } diff --git a/src/Higher.Core/FTLens.fs b/src/Higher/FTLens.fs similarity index 72% rename from src/Higher.Core/FTLens.fs rename to src/Higher/FTLens.fs index 59dfd16..26708da 100644 --- a/src/Higher.Core/FTLens.fs +++ b/src/Higher/FTLens.fs @@ -1,31 +1,29 @@ -namespace Higher.Core +namespace Higher -// Twan van Laarhoven's Functor transformer lenses // http://twanvl.nl/files/lenses-talk-2011-05-17.pdf -// type FTLens α β γ δ = ∀f . Functor f ⇒ (α → f β) → (γ → f δ) - - -type FTLens<'S, 'T, 'A, 'B> = +/// Twan van Laarhoven's Functor transformer lenses. +/// +/// type FTLens α β γ δ = ∀f . Functor f ⇒ (α → f β) → (γ → f δ) +type FTLens<'S, 'T, 'A, 'B> = abstract Apply<'F> : Functor<'F> -> ('A -> App<'F, 'B>) -> ('S -> App<'F, 'T>) - module Lens = let lens<'S, 'T, 'A, 'B> (get: 'S -> 'A) (set: 'B -> 'S -> 'T) : FTLens<'S, 'T, 'A, 'B> = { new FTLens<'S, 'T, 'A, 'B> with - override self.Apply<'F> (F : Functor<'F>) (f : 'A -> App<'F, 'B>) = - fun s -> F.Map (fun x -> set x s) (f (get s)) } + override self.Apply<'F> (F : Functor<'F>) (f : 'A -> App<'F, 'B>) = + fun s -> F.Map (fun x -> set x s) (f (get s))} let view<'S, 'T, 'A, 'B> (lens : FTLens<'S, 'T, 'A, 'B>) : 'S -> 'A = let F = new ConstFunctor<'A>() let f = lens.Apply F (C >> Const.Inj) - fun a -> let (C k) = Const.Prj (f a) in k + fun a -> let (C k) = Const.Prj (f a) in k - let over<'S, 'T, 'A, 'B> (lens : FTLens<'S, 'T, 'A, 'B>) (f : 'A -> 'B) : 'S -> 'T = + let over<'S, 'T, 'A, 'B> (lens : FTLens<'S, 'T, 'A, 'B>) (f : 'A -> 'B) : 'S -> 'T = let F = new IdentityFunctor() - let f' = lens.Apply F (f >> Id >> Identity.Inj) + let f' = lens.Apply F (f >> Id >> Identity.Inj) fun a -> let (Id v) = Identity.Prj (f' a) in v let set (lens : FTLens<'S, 'T, 'A, 'B>) (b : 'B) : 'S -> 'T = over lens (fun _ -> b) @@ -33,6 +31,3 @@ module Lens = let (>->) (l1: FTLens<_, _, _, _>) (l2: FTLens<_, _, _, _>) = { new FTLens<_, _, _, _> with override t.Apply F f = l1.Apply F (l2.Apply F f)} - - - diff --git a/src/Higher.Core/Fix.fs b/src/Higher/Fix.fs similarity index 77% rename from src/Higher.Core/Fix.fs rename to src/Higher/Fix.fs index d688237..07468d7 100644 --- a/src/Higher.Core/Fix.fs +++ b/src/Higher/Fix.fs @@ -1,18 +1,19 @@ -namespace Higher.Core +namespace Higher -/// Fix point. +/// Fixed point. type Fix<'F> = Fix of App<'F, Fix<'F>> type Fix private () = static let token = new Fix() - static member Inj (value : Fix<'F>) : App = + static member Inj (value : Fix<'F>) : App = new App<_, _>(token, value) - static member Prj (app : App) : Fix<'F> = + static member Prj (app : App) : Fix<'F> = app.Apply(token) :?> _ + [] module Fix = - + let inline un (Fix(f)) = f let rec cata (func : Functor<'F> ) (alg : Algebra<'F, 'A>) (fix : Fix<'F>) : 'A = @@ -27,7 +28,5 @@ module Fix = |> func.Map (ana func coalg) |> Fix.Fix - let hylo (func : Functor<'F>) (alg : Algebra<'F, 'B>) (coalg : CoAlgebra<'F, 'A>) (a : 'A) : 'B = + let hylo (func : Functor<'F>) (alg : Algebra<'F, 'B>) (coalg : CoAlgebra<'F, 'A>) (a : 'A) : 'B = ana func coalg a |> cata func alg - - \ No newline at end of file diff --git a/src/Higher.Core/Flip.fs b/src/Higher/Flip.fs similarity index 91% rename from src/Higher.Core/Flip.fs rename to src/Higher/Flip.fs index cffa873..ea30841 100644 --- a/src/Higher.Core/Flip.fs +++ b/src/Higher/Flip.fs @@ -1,10 +1,10 @@ -namespace Higher.Core +namespace Higher type Flip<'F, 'A, 'B> = F of App2<'F, 'B, 'A> -type Flip private () = +type Flip private () = static let token = new Flip() - static member Inj (value : Flip<'F, 'A, 'B>) : App3 = + static member Inj (value : Flip<'F, 'A, 'B>) : App3 = let app = new App(token, value) let app2 = new App2(AppToken.Token token, app) new App3(AppToken, 'A>.Token app, app2) @@ -14,6 +14,5 @@ type Flip private () = let app2 = app3.Apply(token'') :?> App2 let app = app2.Apply(token') :?> App app.Apply(token) :?> _ - static member Run (app3 : App3) : App2<'F, 'B, 'A> = + static member Run (app3 : App3) : App2<'F, 'B, 'A> = let (F app) = Flip.Prj app3 in app - diff --git a/src/Higher.Core/Free.fs b/src/Higher/Free.fs similarity index 73% rename from src/Higher.Core/Free.fs rename to src/Higher/Free.fs index aa31c51..0fcbde5 100644 --- a/src/Higher.Core/Free.fs +++ b/src/Higher/Free.fs @@ -1,23 +1,26 @@ -namespace Higher.Core +namespace Higher + +/// Free Monad type +type Free<'F, 'T> = + | Return of 'T + | Wrap of App<'F, Free<'F, 'T>> -// Free Monad type -type Free<'F, 'T> = Return of 'T | Wrap of App<'F, Free<'F, 'T>> type Free private () = static let token = new Free() static member Inj (value : Free<'F, 'T>) : App2 = let app = new App(token, value) new App2(AppToken.Token token, app) - static member Prj (app2 : App2) : Free<'F, 'T> = + static member Prj (app2 : App2) : Free<'F, 'T> = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ -// Free Monad instance -type FreeMonad<'F>(fuctorFree : Functor<'F>) = +/// Free Monad instance +type FreeMonad<'F>(fuctorFree : Functor<'F>) = inherit Monad>() with override self.Return x = Free.Inj <| Return x - override self.Bind (m, f) = + override self.Bind (m, f) = match Free.Prj m with | Return x -> f x - | Wrap func -> + | Wrap func -> let func' = fuctorFree.Map (fun m' -> Free.Prj <| self.Bind(Free.Inj m', f)) func Free.Inj <| Wrap func' diff --git a/src/Higher.Core/Fun.fs b/src/Higher/Fun.fs similarity index 62% rename from src/Higher.Core/Fun.fs rename to src/Higher/Fun.fs index e2ac53d..25047b1 100644 --- a/src/Higher.Core/Fun.fs +++ b/src/Higher/Fun.fs @@ -1,26 +1,26 @@ -namespace Higher.Core +namespace Higher -// Function type +/// Function type type Fun private () = static let token = new Fun() static member Inj (value : 'A -> 'B) : App2 = let app = new App(token, value) new App2(AppToken.Token token, app) - static member Prj (app2 : App2) : 'A -> 'B = + static member Prj (app2 : App2) : 'A -> 'B = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ -// Function Functor -type FunFunctor<'E>() = - inherit Functor>() +/// Function Functor +type FunFunctor<'E>() = + inherit Functor>() override self.Map (f : 'A -> 'B) (v : App2) : App2 = Fun.Inj <| fun e -> f (Fun.Prj v e) -// Function Category instance -type FunCategory() = +/// Function Category instance +type FunCategory() = inherit Category() with override self.Ident() = Fun.Inj id - override self.Compose f g = - Fun.Inj (fun x -> Fun.Prj g (Fun.Prj f x)) \ No newline at end of file + override self.Compose f g = + Fun.Inj (fun x -> Fun.Prj g (Fun.Prj f x)) diff --git a/src/Higher.Core/Functor.fs b/src/Higher/Functor.fs similarity index 83% rename from src/Higher.Core/Functor.fs rename to src/Higher/Functor.fs index 3ff6fbc..eb8e04d 100644 --- a/src/Higher.Core/Functor.fs +++ b/src/Higher/Functor.fs @@ -1,21 +1,21 @@ -namespace Higher.Core +namespace Higher -// Functor base classes +// Functor base classes [] -type Functor<'F>() = +type Functor<'F>() = abstract Map<'A, 'B> : ('A -> 'B) -> App<'F, 'A> -> App<'F, 'B> [] -type ContraFunctor<'F>() = +type ContraFunctor<'F>() = abstract ContraMap<'A, 'B> : ('A -> 'B) -> App<'F, 'B> -> App<'F, 'A> [] -type BiFunctor<'F>() = +type BiFunctor<'F>() = abstract BiMap<'A, 'B, 'C, 'D> : ('A -> 'B) -> ('C -> 'D) -> App2<'F, 'A, 'C> -> App2<'F, 'B, 'D> - member self.First<'A, 'B, 'C> (f : 'A -> 'B) (fac : App2<'F, 'A, 'C>) : App2<'F, 'B, 'C> = - self.BiMap f id fac - member self.Second<'A, 'B, 'C> (f : 'B -> 'C) (fab : App2<'F, 'A, 'B>) : App2<'F, 'A, 'C> = + member self.First<'A, 'B, 'C> (f : 'A -> 'B) (fac : App2<'F, 'A, 'C>) : App2<'F, 'B, 'C> = + self.BiMap f id fac + member self.Second<'A, 'B, 'C> (f : 'B -> 'C) (fab : App2<'F, 'A, 'B>) : App2<'F, 'A, 'C> = self.BiMap id f fab [] @@ -28,18 +28,18 @@ type ProFunctor<'F>() = module FunctorLaws = - + let identity (eq : App<'F, 'A> -> App<'F, 'A> -> bool) (func : Functor<'F>) (fa : App<'F, 'A>) = eq (func.Map id fa) fa + module BiFunctorLaws = - + let identity (eq : App2<'F, 'A, 'B> -> App2<'F, 'A, 'B> -> bool) (func : BiFunctor<'F>) (fab : App2<'F, 'A, 'B>) = eq (func.BiMap id id fab) fab + module ProFunctorLaws = - - let identity (eq : App2<'F, 'A, 'B> -> App2<'F, 'A, 'B> -> bool) (func : ProFunctor<'F>) (fab : App2<'F, 'A, 'B>) = - eq (func.DiMap id id fab) fab - \ No newline at end of file + let identity (eq : App2<'F, 'A, 'B> -> App2<'F, 'A, 'B> -> bool) (func : ProFunctor<'F>) (fab : App2<'F, 'A, 'B>) = + eq (func.DiMap id id fab) fab diff --git a/src/Higher/Higher.fsproj b/src/Higher/Higher.fsproj new file mode 100644 index 0000000..c711fc6 --- /dev/null +++ b/src/Higher/Higher.fsproj @@ -0,0 +1,185 @@ + + + + Debug + AnyCPU + 2.0 + a76feeb6-cf93-465d-8f57-d729c1fffe76 + Library + Higher + Higher + v4.0 + 4.3.0.0 + Higher + + + + true + full + false + false + .\bin\Debug + DEBUG;TRACE + 3 + .\bin\$(Configuration)\$(AssemblyName).xml + --warnon:1182 + + + pdbonly + true + true + .\bin\Release + TRACE + 3 + .\bin\$(Configuration)\$(AssemblyName).xml + --warnon:1182 + + + 11 + + + + + $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets + + + + + $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ..\..\packages\FSharp.Core\lib\net20\FSharp.Core.dll + True + True + + + + + + + ..\..\packages\FSharp.Core\lib\net40\FSharp.Core.dll + True + True + + + + + + + ..\..\packages\FSharp.Core\lib\portable-net45+monoandroid10+monotouch10+xamarinios10\FSharp.Core.dll + True + True + + + + + + + ..\..\packages\FSharp.Core\lib\portable-net45+netcore45\FSharp.Core.dll + True + True + + + + + + + ..\..\packages\FSharp.Core\lib\portable-net45+netcore45+wp8\FSharp.Core.dll + True + True + + + + + + + ..\..\packages\FSharp.Core\lib\portable-net45+netcore45+wpa81+wp8\FSharp.Core.dll + True + True + + + + + + + ..\..\packages\FSharp.Core\lib\portable-net45+sl5+netcore45\FSharp.Core.dll + True + True + + + + + diff --git a/src/Higher.Core/Identity.fs b/src/Higher/Identity.fs similarity index 94% rename from src/Higher.Core/Identity.fs rename to src/Higher/Identity.fs index e4dfefc..0eeb563 100644 --- a/src/Higher.Core/Identity.fs +++ b/src/Higher/Identity.fs @@ -1,8 +1,8 @@ -namespace Higher.Core +namespace Higher type Identity<'A> = Id of 'A -type Identity private () = +type Identity private () = static let token = Identity() static member inline un (Id(a)) = a static member Inj (value : Identity<'A>) : App = @@ -12,7 +12,7 @@ type Identity private () = static member Run (app : App) : 'A = let (Id a) = Identity.Prj app a - + type IdentityFunctor() = inherit Functor() with override self.Map (f : 'A -> 'B) (app : App) : App = @@ -38,4 +38,4 @@ type IdentityComonad() = override self.Extract (app : App) : 'A = app |> Identity.Prj |> Identity.un override self.Extend (f : App -> 'B) (app : App) : App = - app |> f |> Id |> Identity.Inj \ No newline at end of file + app |> f |> Id |> Identity.Inj diff --git a/src/Higher.Core/Index.fs b/src/Higher/Index.fs similarity index 63% rename from src/Higher.Core/Index.fs rename to src/Higher/Index.fs index 8fa865f..108a425 100644 --- a/src/Higher.Core/Index.fs +++ b/src/Higher/Index.fs @@ -1,6 +1,6 @@ -namespace Higher.Core +namespace Higher -// Index-preserving Function +/// Index-preserving Function type Index<'F, 'G> = abstract Invoke<'A> : App<'F, 'A> -> App<'G, 'A> @@ -9,20 +9,19 @@ type Index private () = static member Inj (value : Index<'F, 'G>) : App2 = let app = new App(token, value) new App2(AppToken.Token token, app) - static member Prj (app2 : App2) : Index<'F, 'G> = + static member Prj (app2 : App2) : Index<'F, 'G> = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ - static member Run(index : App2) = + static member Run(index : App2) = Index.Prj index - -// Index-preserving Category instance -type IndexCategory() = +/// Index-preserving Category instance +type IndexCategory() = inherit Category() with - override self.Ident<'F>() = - Index.Inj { new Index<'F, 'F> with + override self.Ident<'F>() = + Index.Inj { new Index<'F, 'F> with member self.Invoke x = x } - override self.Compose f g = - Index.Inj ({ new Index<'A, 'C> with - member self.Invoke x = - (Index.Prj g).Invoke <| (Index.Prj f).Invoke x }) \ No newline at end of file + override self.Compose f g = + Index.Inj ({ new Index<'A, 'C> with + member self.Invoke x = + (Index.Prj g).Invoke <| (Index.Prj f).Invoke x }) diff --git a/src/Higher.Core/Kleisli.fs b/src/Higher/Kleisli.fs similarity index 81% rename from src/Higher.Core/Kleisli.fs rename to src/Higher/Kleisli.fs index c669b83..6db4dfa 100644 --- a/src/Higher.Core/Kleisli.fs +++ b/src/Higher/Kleisli.fs @@ -1,10 +1,10 @@ -namespace Higher.Core +namespace Higher type Kleisli<'M, 'A, 'B> = K of ('A -> App<'M, 'B>) -type Kleisli private () = +type Kleisli private () = static let token = new Kleisli() - static member Inj (value : Kleisli<'M, 'A, 'B>) : App3 = + static member Inj (value : Kleisli<'M, 'A, 'B>) : App3 = let app = new App(token, value) let app2 = new App2(AppToken.Token token, app) new App3(AppToken, 'A>.Token app, app2) @@ -14,20 +14,20 @@ type Kleisli private () = let app2 = app3.Apply(token'') :?> App2 let app = app2.Apply(token') :?> App app.Apply(token) :?> _ - static member Run (app : App3) = + static member Run (app : App3) = let (K f) = Kleisli.Prj app in f -type KleisliArrow<'M>(monad : Monad<'M>) = +type KleisliArrow<'M>(monad : Monad<'M>) = inherit Arrow>() - override self.Arr(f : ('A -> 'B)) : App2, 'A, 'B> = + override self.Arr(f : ('A -> 'B)) : App2, 'A, 'B> = Kleisli.Inj <| K (fun a -> monad { return f a }) - override self.First(f : App2, 'A, 'B>) : App2, 'A * 'C, 'B * 'C> = - let (K f') = Kleisli.Prj f + override self.First(f : App2, 'A, 'B>) : App2, 'A * 'C, 'B * 'C> = + let (K f') = Kleisli.Prj f Kleisli.Inj <| K (fun (a, c) -> monad { let! b = f' a in return (b, c) }) - override self.Ident<'A>() : App2, 'A, 'A> = + override self.Ident<'A>() : App2, 'A, 'A> = Kleisli.Inj <| K (fun a -> monad { return a }) - override self.Compose(f : App2, 'A, 'B>) (g : App2, 'B, 'C>) : App2, 'A, 'C> = + override self.Compose(f : App2, 'A, 'B>) (g : App2, 'B, 'C>) : App2, 'A, 'C> = let (K f') = Kleisli.Prj f let (K g') = Kleisli.Prj g - Kleisli.Inj <| K (Monad.compose monad f' g') \ No newline at end of file + Kleisli.Inj <| K (Monad.compose monad f' g') diff --git a/src/Higher.Core/LeftKan.fs b/src/Higher/LeftKan.fs similarity index 74% rename from src/Higher.Core/LeftKan.fs rename to src/Higher/LeftKan.fs index d63c394..073924d 100644 --- a/src/Higher.Core/LeftKan.fs +++ b/src/Higher/LeftKan.fs @@ -1,23 +1,24 @@ -namespace Higher.Core +namespace Higher -type Lambda<'G, 'H, 'A, 'R> = +type Lambda<'G, 'H, 'A, 'R> = abstract Invoke<'B> : (App<'G, 'B> -> 'A) -> App<'H, 'B> -> 'R -// type Lan g h α = ∃β. (g β → α) * h β -// type CoYoneda f a = Lan Id f a +/// type Lan g h α = ∃β. (g β → α) * h β +/// +/// type CoYoneda f a = Lan Id f a [] type Lan<'G, 'H, 'A>() = - abstract Invoke<'R> : Lambda<'G, 'H, 'A, 'R> -> 'R + abstract Invoke<'R> : Lambda<'G, 'H, 'A, 'R> -> 'R -type LanConstr<'G, 'H, 'B, 'A>(f : App<'G, 'B> -> 'A, app : App<'H, 'B>) = +type LanConstr<'G, 'H, 'B, 'A>(f : App<'G, 'B> -> 'A, app : App<'H, 'B>) = inherit Lan<'G, 'H, 'A>() - override self.Invoke lambda = + override self.Invoke lambda = lambda.Invoke f app type Lan private () = static let token = new Lan() - static member Inj (value : Lan<'G, 'H, 'A>) : App3 = + static member Inj (value : Lan<'G, 'H, 'A>) : App3 = let app = new App(token, value) let app2 = new App2(AppToken.Token token, app) new App3(AppToken, 'H>.Token app, app2) @@ -29,18 +30,12 @@ type Lan private () = app.Apply(token) :?> _ -type LanFunctor<'G, 'H>() = +type LanFunctor<'G, 'H>() = inherit Functor>() - - override self.Map (f : 'A -> 'B) (app : App3) = + + override self.Map (f : 'A -> 'B) (app : App3) = Lan.Inj <| - (Lan.Prj app).Invoke> + (Lan.Prj app).Invoke> { new Lambda<'G, 'H, 'A, Lan<'G, 'H, 'B>> with - member self.Invoke<'C> (k : App<'G, 'C> -> 'A) (app : App<'H, 'C>) = - new LanConstr<'G, 'H, 'C, 'B>(k >> f, app) :> Lan<'G, 'H, 'B> } - - - - - - + member self.Invoke<'C> (k : App<'G, 'C> -> 'A) (app : App<'H, 'C>) = + new LanConstr<'G, 'H, 'C, 'B>(k >> f, app) :> Lan<'G, 'H, 'B> } diff --git a/src/Higher.Core/Leibniz.fs b/src/Higher/Leibniz.fs similarity index 80% rename from src/Higher.Core/Leibniz.fs rename to src/Higher/Leibniz.fs index 2bbd2be..63f3e4c 100644 --- a/src/Higher.Core/Leibniz.fs +++ b/src/Higher/Leibniz.fs @@ -1,33 +1,35 @@ -namespace Higher.Core +namespace Higher -// Source +// Source // https://github.com/ocamllabs/higher/blob/master/examples/example-2-leibniz.ml // http://okmij.org/ftp/Haskell/LeibnizInjective.hs type Eq<'A, 'B> = abstract Invoke<'F> : App<'F, 'A> -> App<'F, 'B> + type Eq private () = static let token = new Eq() - static member Inj (value : Eq<'A, 'B>) : App2 = + static member Inj (value : Eq<'A, 'B>) : App2 = let app = new App(token, value) new App2(AppToken.Token token, app) - static member Prj (app2 : App2) : Eq<'A, 'B> = + static member Prj (app2 : App2) : Eq<'A, 'B> = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ + type AppEq<'A, 'B> = App2 -module Leibniz = - +module Leibniz = + let refl : unit -> AppEq<'A, 'A> = fun () -> Eq.Inj <| { new Eq<'A, 'A> with member self.Invoke<'F> (eq : App<'F, 'A>) = eq } let subst : AppEq<'A, 'B> -> App<'F, 'A> -> App<'F, 'B> = fun eq app -> - (Eq.Prj eq).Invoke app + (Eq.Prj eq).Invoke app let trans : AppEq<'A, 'B> -> AppEq<'B, 'C> -> AppEq<'A, 'C> = fun ab bc -> subst bc ab @@ -37,6 +39,5 @@ module Leibniz = x let symm : AppEq<'A, 'B> -> AppEq<'B, 'A> = fun ab -> - let flip = Flip.Inj <| F (refl ()) + let flip = Flip.Inj <| F (refl ()) Flip.Run <| subst ab flip - \ No newline at end of file diff --git a/src/Higher.Core/List.fs b/src/Higher/List.fs similarity index 58% rename from src/Higher.Core/List.fs rename to src/Higher/List.fs index 77b76db..3c5f279 100644 --- a/src/Higher.Core/List.fs +++ b/src/Higher/List.fs @@ -1,39 +1,37 @@ -namespace Higher.Core +namespace Higher -// List Monad type +/// List Monad type type List private () = - static let token = new List() - static member Inj (value : 'T list) : App = + static let token = new List() + static member Inj (value : 'T list) : App = new App<_, _>(token, value) - static member Prj (app : App) : 'T list = + static member Prj (app : App) : 'T list = app.Apply(token) :?> _ -// List Monad instance -type ListMonad() = +/// List Monad instance +type ListMonad() = inherit Monad() with override self.Return x = List.Inj [x] override self.Bind (m, f) = m - |> List.Prj - |> List.collect (fun v -> List.Prj (f v)) + |> List.Prj + |> List.collect (fun v -> List.Prj (f v)) |> List.Inj -// List Applicative Functor instance -type ListApplicative() = +/// List Applicative Functor instance +type ListApplicative() = inherit Applicative() with override self.Pure x = List.Inj [x] override self.Apply appF app = let fs, xs = List.Prj appF, List.Prj app xs |> List.zip fs |> List.map (fun (f, x) -> f x) |> List.Inj - - -// List Traversable instance -type ListTraversable() = +/// List Traversable instance +type ListTraversable() = inherit Traversable() with - override self.Map f func = + override self.Map f func = func |> List.Prj |> List.map f |> List.Inj - override self.Traverse<'F, 'T, 'R> (app : Applicative<'F>) (f : 'T -> App<'F, 'R>) (trav : App) = + override self.Traverse<'F, 'T, 'R> (app : Applicative<'F>) (f : 'T -> App<'F, 'R>) (trav : App) = let xs = trav |> List.Prj |> List.map f let appCons = app.Pure (fun (x : 'R) xs -> List.Inj (x :: (List.Prj xs))) - List.foldBack (fun appX appXs -> app.Apply (app.Apply appCons appX) appXs) xs (app.Pure (List.Inj [])) \ No newline at end of file + List.foldBack (fun appX appXs -> app.Apply (app.Apply appCons appX) appXs) xs (app.Pure (List.Inj [])) diff --git a/src/Higher.Core/ListT.fs b/src/Higher/ListT.fs similarity index 52% rename from src/Higher.Core/ListT.fs rename to src/Higher/ListT.fs index 2f2c638..ac8b207 100644 --- a/src/Higher.Core/ListT.fs +++ b/src/Higher/ListT.fs @@ -1,34 +1,34 @@ -namespace Higher.Core +namespace Higher -// ListT Monad Transformer type -type ListT<'M, 'T> = OT of App<'M, 'T list> -type ListT private () = +/// ListT Monad Transformer type +type ListT<'M, 'T> = LT of App<'M, 'T list> + +type ListT private () = static let token = new ListT() - static member Inj (value : ListT<'M, 'T>) : App2 = + static member Inj (value : ListT<'M, 'T>) : App2 = let app = new App(token, value) new App2(AppToken.Token token, app) - static member Prj (app2 : App2) : ListT<'M, 'T> = + static member Prj (app2 : App2) : ListT<'M, 'T> = let app = app2.Apply(AppToken.Token token) :?> App app.Apply(token) :?> _ - static member Run (listT : App2) = - let (OT appList) = ListT.Prj listT in appList - + static member Run (listT : App2) = + let (LT appList) = ListT.Prj listT in appList -// ListT Monad Transformer instance -type ListTMonadTrans() = +/// ListT Monad Transformer instance +type ListTMonadTrans() = inherit MonadTrans() with - override self.Lift monad m = - ListT.Inj <| OT (monad { let! x = m in return [x] }) + override self.Lift monad m = + ListT.Inj <| LT (monad { let! x = m in return [x] }) -// ListT Monad instance -type ListTMonad<'M>(monad : Monad<'M>) = +/// ListT Monad instance +type ListTMonad<'M>(monad : Monad<'M>) = inherit Monad>() with - override self.Return x = ListT.Inj <| OT (monad { return [x] }) - override self.Bind (m, f) = - ListT.Inj <| OT (monad { + override self.Return x = ListT.Inj <| LT (monad { return [x] }) + override self.Bind (m, f) = + ListT.Inj <| LT (monad { let! xs = ListT.Run m - let! yss = Monad.mapM monad (ListT.Run << f) xs + let! yss = Monad.mapM monad (ListT.Run << f) xs return List.concat yss }) diff --git a/src/Higher.Core/Monad.fs b/src/Higher/Monad.fs similarity index 78% rename from src/Higher.Core/Monad.fs rename to src/Higher/Monad.fs index f996fe7..40f9dfa 100644 --- a/src/Higher.Core/Monad.fs +++ b/src/Higher/Monad.fs @@ -1,12 +1,12 @@ -namespace Higher.Core -open System +namespace Higher +open System -// Monad Class +/// Monad Class [] -type Monad<'M>() = - inherit Applicative<'M>() +type Monad<'M>() = + inherit Applicative<'M>() override self.Pure x = self.Return x - override self.Apply appF app = + override self.Apply appF app = self { let! f = appF let! x = app @@ -15,20 +15,20 @@ type Monad<'M>() = abstract Return<'T> : 'T -> App<'M, 'T> abstract Bind<'T, 'R> : App<'M, 'T> * ('T -> App<'M, 'R>) -> App<'M, 'R> member self.ReturnFrom m = m - -// Generic Monad functions -module Monad = - - let compose (monad : Monad<'M>) (f : 'A -> App<'M, 'B>) (g : 'B -> App<'M, 'C>) : 'A -> App<'M, 'C> = + +/// Generic Monad functions +module Monad = + + let compose (monad : Monad<'M>) (f : 'A -> App<'M, 'B>) (g : 'B -> App<'M, 'C>) : 'A -> App<'M, 'C> = fun a -> monad { let! b = f a in return! g b } - let join (monad : Monad<'M>) (mm : App<'M, App<'M, 'T>>) : App<'M, 'T> = + let join (monad : Monad<'M>) (mm : App<'M, App<'M, 'T>>) : App<'M, 'T> = monad.Bind(mm, fun m -> m) let rec sequence (monad : Monad<'M>) (ms : App<'M, 'T> list) : App<'M, 'T list> = match ms with - | m :: ms -> + | m :: ms -> monad { let! x = m let! xs = sequence monad ms @@ -41,13 +41,10 @@ module Monad = let rec filterM (monad : Monad<'M>) (f : 'T -> App<'M, bool>) (xs : 'T list) : App<'M, 'T list> = match xs with - | x :: xs -> + | x :: xs -> monad { let! flag = f x let! xs' = filterM monad f xs return if flag then x :: xs' else xs' } - | [] -> monad { return [] } - - - + | [] -> monad { return [] } diff --git a/src/Higher.Core/MonadTrans.fs b/src/Higher/MonadTrans.fs similarity index 68% rename from src/Higher.Core/MonadTrans.fs rename to src/Higher/MonadTrans.fs index e6caf45..b745226 100644 --- a/src/Higher.Core/MonadTrans.fs +++ b/src/Higher/MonadTrans.fs @@ -1,8 +1,6 @@ -namespace Higher.Core +namespace Higher -// Monad Transformer Class +/// Monad Transformer Class [] type MonadTrans<'MT>() = abstract Lift<'M, 'T> : Monad<'M> -> App<'M, 'T> -> App2<'MT, 'M, 'T> - - diff --git a/src/Higher.Core/Monoid.fs b/src/Higher/Monoid.fs similarity index 75% rename from src/Higher.Core/Monoid.fs rename to src/Higher/Monoid.fs index 89916ff..aa9819f 100644 --- a/src/Higher.Core/Monoid.fs +++ b/src/Higher/Monoid.fs @@ -1,12 +1,12 @@ -namespace Higher.Core -open System +namespace Higher +open System -// Monoid class +/// Monoid class [] type Monoid<'T>() = abstract Empty : 'T abstract Append : 'T -> 'T -> 'T - + type Monoid private () = static let token = Monoid() static member Inj (m : 'T) : App2 = @@ -18,32 +18,32 @@ type Monoid private () = static member Run (app2: App2) : 'T = Monoid.Prj app2 -// Monoids are single object categories +/// Monoids are single object categories type MonoidCategory<'T>(m: Monoid<'T>) = - inherit Category() with + inherit Category() with override self.Ident<'A> () : App2 = Monoid.Inj m.Empty override self.Compose<'A, 'B, 'C> (ab:App2) (bc:App2) : App2 = m.Append (Monoid.Prj ab) (Monoid.Prj bc) |> Monoid.Inj - + // Basic Monoid instances type StringMonoid() = - inherit Monoid() with - override self.Empty = "" + inherit Monoid() with + override self.Empty = "" override self.Append x y = x + y type ListMonoid<'T>() = - inherit Monoid<'T list>() with - override self.Empty = [] + inherit Monoid<'T list>() with + override self.Empty = [] override self.Append xs ys = List.append xs ys type SeqMonoid<'T>() = - inherit Monoid>() with - override self.Empty = Seq.empty + inherit Monoid>() with + override self.Empty = Seq.empty override self.Append xs ys = Seq.append xs ys type EndoMonoid<'T>() = inherit Monoid<'T -> 'T>() with override self.Empty = id - override self.Append f g = f >> g \ No newline at end of file + override self.Append f g = f >> g diff --git a/src/Higher.Core/Option.fs b/src/Higher/Option.fs similarity index 54% rename from src/Higher.Core/Option.fs rename to src/Higher/Option.fs index 44b114a..db3dd71 100644 --- a/src/Higher.Core/Option.fs +++ b/src/Higher/Option.fs @@ -1,19 +1,18 @@ -namespace Higher.Core +namespace Higher -// Option Monad type +/// Option Monad type type Option private () = static let token = new Option() - static member Inj (value : 'T option) : App = + static member Inj (value : 'T option) : App = new App<_, _>(token, value) - static member Prj (app : App) : 'T option = + static member Prj (app : App) : 'T option = app.Apply(token) :?> _ -// Option Monad instance -type OptionMonad() = +/// Option Monad instance +type OptionMonad() = inherit Monad