From 23fee42a2008651d56589c68fd98e589ccfcca72 Mon Sep 17 00:00:00 2001
From: Bogdan Popa <bogdan@defn.io>
Date: Sun, 25 Aug 2019 14:11:10 +0300
Subject: [PATCH] core: initial commit

---
 .gitignore               |   2 +
 README.md                |  10 ++++
 sass/LICENSE             |  28 ++++++++++
 sass/doc.scrbl           |  32 +++++++++++
 sass/info.rkt            |   9 +++
 sass/main.rkt            | 117 +++++++++++++++++++++++++++++++++++++++
 sass/private/libsass.rkt |  71 ++++++++++++++++++++++++
 sass/resources/test.scss |   5 ++
 8 files changed, 274 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 README.md
 create mode 100644 sass/LICENSE
 create mode 100644 sass/doc.scrbl
 create mode 100644 sass/info.rkt
 create mode 100644 sass/main.rkt
 create mode 100644 sass/private/libsass.rkt
 create mode 100644 sass/resources/test.scss

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..7c8d499
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+compiled
+doc
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..c679f57
--- /dev/null
+++ b/README.md
@@ -0,0 +1,10 @@
+# racket-sass
+
+Racket bindings for [libsass].
+
+## TODOs
+
+* [ ] support for custom [`Sass_Options`](https://github.com/sass/libsass/blob/master/docs/api-context.md#basic-usage).
+
+
+[libsass]: https://github.com/sass/libsass
diff --git a/sass/LICENSE b/sass/LICENSE
new file mode 100644
index 0000000..c06c65c
--- /dev/null
+++ b/sass/LICENSE
@@ -0,0 +1,28 @@
+Copyright 2019 Bogdan Popa <bogdan@defn.io>
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the copyright holder nor the names of its
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/sass/doc.scrbl b/sass/doc.scrbl
new file mode 100644
index 0000000..fde5613
--- /dev/null
+++ b/sass/doc.scrbl
@@ -0,0 +1,32 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     sass))
+
+@title{@exec{SASS}: Bindings to libsass}
+@author[(author+email "Bogdan Popa" "bogdan@defn.io")]
+
+
+@section[#:tag "intro"]{Introduction}
+
+@(define libsass-uri "https://github.com/sass/libsass")
+
+@exec{sass} exposes bindings to @link[libsass-uri]{libsass} via the FFI.
+
+
+@section[#:tag "reference"]{Reference}
+@defmodule[sass]
+
+@deftogether[
+  (@defproc[(compile/file [path path-string?]) string?]
+   @defproc[(compile/bytes [data bytes?]) string?]
+   @defproc[(compile/string [data string?]) string?])]{
+
+  Compile a SCSS file, bytes or a string into a string of CSS.  Raises
+  @racket[exn:fail:sass?] on error.
+}
+
+@deftogether[
+  (@defproc[(exn:fail:sass? [v any/c]) boolean?]
+   @defproc[(exn:fail:sass-code [e exn:fail:sass?]) exact-integer?])]{
+}
diff --git a/sass/info.rkt b/sass/info.rkt
new file mode 100644
index 0000000..33645bf
--- /dev/null
+++ b/sass/info.rkt
@@ -0,0 +1,9 @@
+#lang info
+
+(define version "0.0.0")
+(define collection "sass")
+(define deps '("base"))
+(define build-deps '("racket-doc"
+                     "rackunit-lib"
+                     "scribble-lib"))
+(define scribblings '(("doc.scrbl")))
diff --git a/sass/main.rkt b/sass/main.rkt
new file mode 100644
index 0000000..ddcc0e1
--- /dev/null
+++ b/sass/main.rkt
@@ -0,0 +1,117 @@
+#lang racket/base
+
+(require racket/contract
+         racket/string
+         "private/libsass.rkt")
+
+(provide
+ (struct-out exn:fail:sass)
+
+ (rename-out [libsass_version sass-version]
+             [libsass_language_version sass-language-version])
+
+ compile/file
+ compile/bytes
+ compile/string)
+
+(struct exn:fail:sass exn:fail (code))
+
+(define (raise-context-error context code)
+  (define message (sass_context_get_error_message context))
+  (raise (exn:fail:sass message (current-continuation-marks) code)))
+
+(define/contract (compile/file path)
+  (-> path-string? string?)
+  (define context #f)
+
+  (dynamic-wind
+    (lambda _
+      (set! context (sass_make_file_context (path->complete-path path))))
+    (lambda _
+      (define code (sass_compile_file_context context))
+      (case code
+        [(0) (sass_context_get_output_string (sass_file_context_get_context context))]
+        [else (raise-context-error (sass_file_context_get_context context) code)]))
+    (lambda _
+      (sass_delete_file_context context))))
+
+(define/contract (compile/bytes data)
+  (-> bytes? string?)
+  (define context #f)
+
+  (dynamic-wind
+    (lambda _
+      ;; Sass_Data_Context frees the string that gets passed into it after
+      ;; compilation so we have to copy the input string and ensure that the
+      ;; resulting copy isn't managed by the GC.
+      (set! context (sass_make_data_context (bytes->unmanaged-cstring data))))
+    (lambda ()
+      (define code (sass_compile_data_context context))
+      (case code
+        [(0) (sass_context_get_output_string (sass_data_context_get_context context))]
+        [else (raise-context-error (sass_data_context_get_context context) code)]))
+    (lambda ()
+      (sass_delete_data_context context))))
+
+(define/contract (compile/string data)
+  (-> non-empty-string? string?)
+  (compile/bytes (string->bytes/utf-8 data)))
+
+
+(module+ test
+  (require rackunit)
+
+  (test-case "can compile SCSS files to CSS"
+    (define output
+      (compile/file "resources/test.scss"))
+
+    (define expected #<<STYLE
+body {
+  color: #fff; }
+
+STYLE
+      )
+
+    (check-equal? output expected))
+
+  (test-case "can compile SCSS strings to CSS"
+    (define output
+      (compile/string #<<STYLE
+$primary: red;
+
+* { margin: 0; padding: 0; box-sizing: border-box; }
+
+body {
+  color: $primary;
+}
+STYLE
+                      ))
+
+    (define expected #<<STYLE
+* {
+  margin: 0;
+  padding: 0;
+  box-sizing: border-box; }
+
+body {
+  color: red; }
+
+STYLE
+      )
+
+    (check-equal? output expected))
+
+  (test-case "handles exceptions"
+    (check-exn
+     (lambda (e)
+       (and (exn:fail:sass? e)
+            (check-equal? (exn-message e) #<<MESSAGE
+Error: Invalid CSS after "a {": expected "}", was ""
+        on line 1:3 of stdin
+>> a {
+   --^
+
+MESSAGE
+                          )))
+     (lambda _
+       (compile/string "a {")))))
diff --git a/sass/private/libsass.rkt b/sass/private/libsass.rkt
new file mode 100644
index 0000000..d907b3d
--- /dev/null
+++ b/sass/private/libsass.rkt
@@ -0,0 +1,71 @@
+#lang racket/base
+
+(require ffi/unsafe
+         ffi/unsafe/define)
+
+(provide
+ bytes->unmanaged-cstring
+
+ libsass_version
+ libsass_language_version
+
+ sass_context_get_options
+ sass_context_get_output_string
+ sass_context_get_error_message
+
+ sass_make_data_context
+ sass_delete_data_context
+ sass_data_context_get_context
+ sass_compile_data_context
+
+ sass_make_file_context
+ sass_delete_file_context
+ sass_file_context_get_context
+ sass_compile_file_context)
+
+(define (bytes->unmanaged-cstring bs)
+  (define sz (bytes-length bs))
+  (define p (malloc 'raw (add1 sz)))
+  (begin0 p
+    (memcpy p bs sz)
+    (memset p sz 0 1)))
+
+;; Basics ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-ffi-definer define-sass (ffi-lib "libsass"))
+
+(define-sass libsass_version (_fun -> _string))
+(define-sass libsass_language_version (_fun -> _string))
+
+
+;; Sass_Options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define _Sass_Options-pointer (_cpointer 'Sass_Options))
+
+
+;; Sass_Context ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define _Sass_Context-pointer (_cpointer 'Sass_Context))
+(define-sass sass_context_get_options (_fun _Sass_Context-pointer -> _Sass_Options-pointer))
+(define-sass sass_context_get_output_string (_fun _Sass_Context-pointer -> _string))
+(define-sass sass_context_get_error_message (_fun _Sass_Context-pointer -> _string))
+
+
+;; Sass_Data_Context ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define _Sass_Data_Context-pointer (_cpointer 'Sass_Data_Context))
+
+(define-sass sass_make_data_context (_fun _pointer -> _Sass_Data_Context-pointer))
+(define-sass sass_delete_data_context (_fun _Sass_Data_Context-pointer -> _void))
+(define-sass sass_data_context_get_context (_fun _Sass_Data_Context-pointer -> _Sass_Context-pointer))
+(define-sass sass_compile_data_context (_fun _Sass_Data_Context-pointer -> _int))
+
+
+;; Sass_File_Context ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define _Sass_File_Context-pointer (_cpointer 'Sass_File_Context))
+
+(define-sass sass_make_file_context (_fun _path -> _Sass_File_Context-pointer))
+(define-sass sass_delete_file_context (_fun _Sass_File_Context-pointer -> _void))
+(define-sass sass_file_context_get_context (_fun _Sass_File_Context-pointer -> _Sass_Context-pointer))
+(define-sass sass_compile_file_context (_fun _Sass_File_Context-pointer -> _int))
diff --git a/sass/resources/test.scss b/sass/resources/test.scss
new file mode 100644
index 0000000..dbbfcf9
--- /dev/null
+++ b/sass/resources/test.scss
@@ -0,0 +1,5 @@
+$a: #fff;
+
+body {
+  color: $a;
+}