Storing a tree in a database. Related blog post: http://fsharpforfunandprofit.com/posts/recursive-types-and-folds-3b/

RecursiveTypesAndFold-3b-database.fsx

(*
RecursiveTypesAndFold-3b-database.fsx

Example: Storing a tree in a database

Related blog post: http://fsharpforfunandprofit.com/posts/recursive-types-and-folds-3b/
*)

// ==============================================
// PART 3b - Storing a tree in a database
// ==============================================

// ==============================================
// Tree implementation
// ==============================================

type Tree<'LeafData,'INodeData> =
    | LeafNode of 'LeafData
    | InternalNode of 'INodeData * Tree<'LeafData,'INodeData> seq


module Tree = 

    let rec cata fLeaf fNode (tree:Tree<'LeafData,'INodeData>) :'r = 
        let recurse = cata fLeaf fNode  
        match tree with
        | LeafNode leafInfo -> 
            fLeaf leafInfo 
        | InternalNode (nodeInfo,subtrees) -> 
            fNode nodeInfo (subtrees |> Seq.map recurse)

    let rec fold fLeaf fNode acc (tree:Tree<'LeafData,'INodeData>) :'r = 
        let recurse = fold fLeaf fNode  
        match tree with
        | LeafNode leafInfo -> 
            fLeaf acc leafInfo 
        | InternalNode (nodeInfo,subtrees) -> 
            // determine the local accumulator at this level
            let localAccum = fNode acc nodeInfo
            // thread the local accumulator through all the subitems using Seq.fold
            let finalAccum = subtrees |> Seq.fold recurse localAccum 
            // ... and return it
            finalAccum 

    let rec map fLeaf fNode (tree:Tree<'LeafData,'INodeData>) = 
        let recurse = map fLeaf fNode  
        match tree with
        | LeafNode leafInfo -> 
            let newLeafInfo = fLeaf leafInfo
            LeafNode newLeafInfo 
        | InternalNode (nodeInfo,subtrees) -> 
            let newSubtrees = subtrees |> Seq.map recurse 
            let newNodeInfo = fNode nodeInfo
            InternalNode (newNodeInfo, newSubtrees)

    let rec iter fLeaf fNode (tree:Tree<'LeafData,'INodeData>) = 
        let recurse = iter fLeaf fNode  
        match tree with
        | LeafNode leafInfo -> 
            fLeaf leafInfo
        | InternalNode (nodeInfo,subtrees) -> 
            subtrees |> Seq.iter recurse 
            fNode nodeInfo
            
// ==============================================
// IO FileSystem as Tree
// ==============================================

module IOFileSystem_Tree = 

    open System
    open System.IO

    type FileSystemTree = Tree<IO.FileInfo,IO.DirectoryInfo>

    let fromFile (fileInfo:FileInfo) = 
        LeafNode fileInfo 

    let rec fromDir (dirInfo:DirectoryInfo) = 
        let subItems = seq{
            yield! dirInfo.EnumerateFiles() |> Seq.map fromFile
            yield! dirInfo.EnumerateDirectories() |> Seq.map fromDir
            }
        InternalNode (dirInfo,subItems)
   

// ==============================================
// DbDirectoryTree implementation
// ==============================================

module DbDirectoryTree =

    open System
    open System.IO
    open IOFileSystem_Tree

(*
CREATE TABLE DbDir (
	DirId int IDENTITY NOT NULL,
	Name nvarchar(50) NOT NULL
)

CREATE TABLE DbFile (
	FileId int IDENTITY NOT NULL,
	Name nvarchar(50) NOT NULL,
	FileSize int NOT NULL
)

CREATE TABLE DbDir_File (
	DirId int NOT NULL,
	FileId int NOT NULL
)

CREATE TABLE DbDir_Dir (
	ParentDirId int NOT NULL,
	ChildDirId int NOT NULL
)

*)
    let nextIdentity =
        let id = ref 0
        fun () -> 
            id := !id + 1
            !id

    // test
    // nextIdentity() // 1
    // nextIdentity() // 1


(*
    /// Insert a DbFile record and return the new file id
    let insertDbFile name (fileSize:int64) =
        let id = nextIdentity()
        printfn "%10s: inserting id:%i name:%s size:%i" "DbFile" id name fileSize
        id

    /// Insert a DbDir record and return the new directory id
    let insertDbDir name =
        let id = nextIdentity()
        printfn "%10s: inserting id:%i name:%s" "DbDir" id name
        id
*)

    type PrimaryKey =
        | FileId of int
        | DirId of int

    /// Insert a DbFile record and return the new PrimaryKey
    let insertDbFile name (fileSize:int64) =
        let id = nextIdentity()
        printfn "%10s: inserting id:%i name:%s size:%i" "DbFile" id name fileSize
        FileId id

    /// Insert a DbDir record and return the new PrimaryKey
    let insertDbDir name =
        let id = nextIdentity()
        printfn "%10s: inserting id:%i name:%s" "DbDir" id name
        DirId id

    /// Insert a DbDir_File record
    let insertDbDir_File dirId fileId =
        printfn "%10s: inserting parentDir:%i childFile:%i" "DbDir_File" dirId fileId 

    /// Insert a DbDir_Dir record
    let insertDbDir_Dir parentDirId childDirId =
        printfn "%10s: inserting parentDir:%i childDir:%i" "DbDir_Dir" parentDirId childDirId
        

    let pkToInt primaryKey = 
        match primaryKey with
        | FileId fileId -> fileId 
        | DirId dirId -> dirId 


    let insertFileSystemTree fileSystemItem =

        let fFile (fi:FileInfo) = 
            insertDbFile fi.Name fi.Length

        let fDir (di:DirectoryInfo) childIds  = 
            let dirId = insertDbDir di.Name
            let parentPK = pkToInt dirId 
            childIds |> Seq.iter (fun childId ->
                match childId with
                | FileId fileId -> insertDbDir_File parentPK fileId 
                | DirId childDirId -> insertDbDir_Dir parentPK childDirId 
            )
            // return the id to the parent
            dirId

        fileSystemItem
        |> Tree.cata fFile fDir 
        

    // ---------------------------------
    // testing
    // ---------------------------------

    // set the current directory to the current source directory
    Directory.SetCurrentDirectory __SOURCE_DIRECTORY__

    // get the current directory as a Tree
    let currentDir = fromDir (DirectoryInfo("."))

    // insert into the database
    currentDir 
    |> insertFileSystemTree

// example output
(*
     DbDir: inserting id:41 name:FoldAndRecursiveTypes
    DbFile: inserting id:42 name:Fold.fsx size:8315
DbDir_File: inserting parentDir:41 childFile:42
    DbFile: inserting id:43 name:FoldAndRecursiveTypes.fsproj size:3680
DbDir_File: inserting parentDir:41 childFile:43
    DbFile: inserting id:44 name:FoldAndRecursiveTypes.sln size:1010
DbDir_File: inserting parentDir:41 childFile:44
...
     DbDir: inserting id:57 name:bin
     DbDir: inserting id:58 name:Debug
 DbDir_Dir: inserting parentDir:57 childDir:58
 DbDir_Dir: inserting parentDir:41 childDir:57


*)