Initial commit

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..58df8c9
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+a.out
+Clean System Files
+*.json

diff --git a/flac.dcl b/flac.dcl
new file mode 100644 (file)
index 0000000..fb9f6c5
--- /dev/null
+++ b/flac.dcl
@@ -0,0 +1,6 @@
+definition module flac
+
+from System.FilePath import :: FilePath
+from Data.Error import :: MaybeError, :: MaybeErrorString
+
+getTags :: FilePath !*World -> *(MaybeErrorString [(String, String)], !*World)

diff --git a/flac.icl b/flac.icl
new file mode 100644 (file)
index 0000000..b45783c
--- /dev/null
+++ b/flac.icl
@@ -0,0 +1,52 @@
+implementation module flac
+
+import StdEnv
+
+import Data.Error
+import Data.Func
+import Control.Monad => qualified join
+import System.FilePath
+import System._Pointer
+import System._Posix
+import Text
+
+import StdDebug
+
+NUM_COMMENT_OFFSET :== 32
+COMMENTS_OFFSET :== 40
+COMMENT_SIZE :== 16
+
+getTags :: FilePath !*World -> *(MaybeErrorString [(String, String)], !*World)
+getTags fp w
+       #! (mdp, w) = mallocSt 8 w
+       #! (ok, w) = FLAC__metadata_get_tags (packString fp) mdp w
+       | not ok
+               #! w = freeSt mdp w
+               = (Error "Error getting tags", w)
+       #! md = derefInt mdp
+       #! num_comments = readInt md NUM_COMMENT_OFFSET
+       #! comments = readInt md COMMENTS_OFFSET
+       #! comments = mapM (makeComment o derefString)
+               [readInt comments (COMMENT_SIZE*i+8)\\i<-[0..num_comments-1]]
+       #! w = FLAC__metadata_object_delete md w
+       #! w = freeSt mdp w
+       = (comments, w)
+where
+       makeComment :: !String -> MaybeErrorString (String, String)
+       makeComment s = case indexOf "=" s of
+               -1 = Error "No = in the tag"
+               i = Ok (s % (0, i-1), s % (i+1, size s))
+
+FLAC__metadata_get_tags :: !String !Pointer !*env -> (!Bool, !*env)
+FLAC__metadata_get_tags _ _ _ = code {
+       ccall FLAC__metadata_get_tags "sp:I:A"
+}
+
+FLAC__metadata_object_delete :: !Pointer !*env -> *env
+FLAC__metadata_object_delete _ _ = code {
+       ccall FLAC__metadata_object_delete "p:V:A"
+}
+
+Start w = getTags
+       "/mnt/data/music/Ahab/The Divinity of Oceans/01 Yet Another Raft of the Medusa (Pollard's Weakness).flac"
+       w

diff --git a/index.dcl b/index.dcl
new file mode 100644 (file)
index 0000000..c801bb1
--- /dev/null
+++ b/index.dcl
@@ -0,0 +1,3 @@
+definition module index
+
+:: MusicDB

diff --git a/index.icl b/index.icl
new file mode 100644 (file)
index 0000000..373ed82
--- /dev/null
+++ b/index.icl
@@ -0,0 +1,45 @@
+implementation module index
+
+import StdEnv
+import Data.Maybe
+import Data.Error
+import System.File
+import System.Directory
+import Text.GenJSON
+import Data.Tree
+
+derive JSONEncode RTree, FileInfo, Tm, MaybeError
+derive JSONDecode RTree, FileInfo, Tm, MaybeError
+
+:: MusicDB :== RTree MusicEntry
+:: MusicEntry =
+       { fe_filepath   :: !FilePath
+       , fe_fileinfo   :: !MaybeOSError FileInfo
+       , fe_musicentry :: [!Tag!]
+       }
+:: Tag =
+       { tag_key   :: !String
+       , tag_value :: !String
+       }
+
+index :: MusicDB (RTree (FilePath, MaybeOSError FileInfo)) *World -> *(MusicDB, *World)
+index (RNode mn mcs) (RNode (fp, mfi) fcs) w = (RNode mn mcs, w)
+
+dbfile = "db.json"
+root = "/mnt/data/music"
+
+writeDB db w
+       # (ok, f, w) = fopen dbfile FWriteData w
+       | not ok = abort "Cannot open file\n"
+       # (ok, w) = fclose (f <<< toJSON db) w
+       | not ok = abort "Cannot close file\n"
+       = w
+
+Start w
+       # (mfi, w) = getFileInfo root w
+       | isError mfi = abort "Cannot open root\n"
+       # (Ok fi) = mfi
+       | not fi.directory = abort "Root is not a directory\n"
+       # (tree, w) = readDirectoryTree root Nothing w
+       # (db, w) = index (RNode {fe_filepath=root,fe_fileinfo=mfi,fe_musicentry=[!!]} []) tree w
+       = writeDB tree w