From 80d019d8ef6eeb1dd2f40c26af14e0ed49659894 Mon Sep 17 00:00:00 2001
From: Bogdan Popa <bogdan@defn.io>
Date: Sun, 25 Aug 2019 16:48:39 +0300
Subject: [PATCH] core: add support for custom include paths

---
 sass/doc.scrbl                     |   7 ++
 sass/main.rkt                      | 102 ++++++++++++++++++++---------
 sass/private/libsass.rkt           |   3 +
 sass/resources/include/_reset.scss |   5 ++
 4 files changed, 87 insertions(+), 30 deletions(-)
 create mode 100644 sass/resources/include/_reset.scss

diff --git a/sass/doc.scrbl b/sass/doc.scrbl
index fde5613..b97da7b 100644
--- a/sass/doc.scrbl
+++ b/sass/doc.scrbl
@@ -24,9 +24,16 @@
 
   Compile a SCSS file, bytes or a string into a string of CSS.  Raises
   @racket[exn:fail:sass?] on error.
+
+  Files referenced in @exec{@"@"import} statements are searched using
+  the value of @racket[current-include-paths].
 }
 
 @deftogether[
   (@defproc[(exn:fail:sass? [v any/c]) boolean?]
    @defproc[(exn:fail:sass-code [e exn:fail:sass?]) exact-integer?])]{
 }
+
+@defparam[current-include-paths paths (listof path-string?) #:value null]{
+  A parameter that controls where SCSS imports should be looked up.
+}
diff --git a/sass/main.rkt b/sass/main.rkt
index ddcc0e1..1dfacbf 100644
--- a/sass/main.rkt
+++ b/sass/main.rkt
@@ -20,38 +20,53 @@
   (define message (sass_context_get_error_message context))
   (raise (exn:fail:sass message (current-continuation-marks) code)))
 
-(define/contract (compile/file path)
+(define/contract current-include-paths
+  (parameter/c (listof path-string?))
+  (make-parameter null))
+
+(define (prepare-context! context)
+  (define options (sass_context_get_options context))
+  (for ([path (reverse (current-include-paths))])
+    ;; Unlike Sass_Data_Context, this function does not take ownership
+    ;; of path.  Cool.
+    (sass_option_push_include_path options path)))
+
+(define ((make-compiler #:constructor make-wrapper
+                        #:destructor free-wrapper
+                        #:context-accessor get-context
+                        #:compilation-fn compile-sass) input)
+  (define wrapper #f)
+  (define context #f)
+
+  (dynamic-wind
+    (lambda _
+      (set! wrapper (make-wrapper input))
+      (set! context (get-context wrapper))
+      (prepare-context! context))
+    (lambda _
+      (define code (compile-sass wrapper))
+      (case code
+        [(0) (sass_context_get_output_string context)]
+        [else (raise-context-error context code)]))
+    (lambda _
+      (free-wrapper wrapper))))
+
+(define/contract compile/file
   (-> path-string? string?)
-  (define context #f)
+  (make-compiler #:constructor (compose1 sass_make_file_context path->complete-path)
+                 #:destructor sass_delete_file_context
+                 #:context-accessor sass_file_context_get_context
+                 #:compilation-fn sass_compile_file_context))
 
-  (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)
+(define/contract compile/bytes
   (-> 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))))
+  ;; 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.
+  (make-compiler #:constructor (compose1 sass_make_data_context bytes->unmanaged-cstring)
+                 #:destructor sass_delete_data_context
+                 #:context-accessor sass_data_context_get_context
+                 #:compilation-fn sass_compile_data_context))
 
 (define/contract (compile/string data)
   (-> non-empty-string? string?)
@@ -101,7 +116,34 @@ STYLE
 
     (check-equal? output expected))
 
-  (test-case "handles exceptions"
+  (test-case "can include files off the include path"
+    (define output
+      (parameterize ([current-include-paths '("resources/include")])
+        (compile/string #<<STYLE
+@import "_reset.scss";
+STYLE
+                        )))
+
+    (define expected #<<STYLE
+* {
+  margin: 0;
+  padding: 0;
+  box-sizing: border-box; }
+
+STYLE
+      )
+
+    (check-equal? output expected))
+
+  (test-case "raises an exception when an included file can't be found on the path"
+    (check-exn
+     (lambda (e)
+       (and (exn:fail:sass? e)
+            (check-regexp-match #rx"File to import not found or unreadable" (exn-message e))))
+     (lambda _
+       (compile/string "@import '_reset.scss';"))))
+
+  (test-case "raises an exception on parse error"
     (check-exn
      (lambda (e)
        (and (exn:fail:sass? e)
diff --git a/sass/private/libsass.rkt b/sass/private/libsass.rkt
index d907b3d..949e6dd 100644
--- a/sass/private/libsass.rkt
+++ b/sass/private/libsass.rkt
@@ -9,6 +9,8 @@
  libsass_version
  libsass_language_version
 
+ sass_option_push_include_path
+
  sass_context_get_options
  sass_context_get_output_string
  sass_context_get_error_message
@@ -41,6 +43,7 @@
 ;; Sass_Options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define _Sass_Options-pointer (_cpointer 'Sass_Options))
+(define-sass sass_option_push_include_path (_fun _Sass_Options-pointer _string -> _void))
 
 
 ;; Sass_Context ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/sass/resources/include/_reset.scss b/sass/resources/include/_reset.scss
new file mode 100644
index 0000000..cca57b3
--- /dev/null
+++ b/sass/resources/include/_reset.scss
@@ -0,0 +1,5 @@
+* {
+  margin: 0;
+  padding: 0;
+  box-sizing: border-box;
+}