diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,8 @@ +# Change Log +All notable changes to this project will be documented in this file. +This project adheres to [Semantic Versioning](http://semver.org/). + +## 0.1.0 - 2015-04-11 +### Added +- Support for functions, importers, headers and sass values. +- Compilation of files and strings. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Jakub Fijałkowski + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Text/Sass.hs b/Text/Sass.hs new file mode 100644 --- /dev/null +++ b/Text/Sass.hs @@ -0,0 +1,187 @@ +-- | Module : Text.Sass +-- Stability : experimental +-- +-- This module provides support for , a CSS +-- extension language. It supports basic compilation, functions, importers and +-- headers, so it should suffice for most of the work. +-- +-- Code used in this document is testable - see test/Text/Sass/TutorialSpec.hs. +module Text.Sass + ( + -- * Compilation + -- $compilation + module Text.Sass.Compilation + -- * Options + -- $options + , module Text.Sass.Options + -- * Values + -- $values + , module Text.Sass.Values + -- * Functions, headers, importers + -- $functions_basic + + -- ** Functions + -- $functions + + -- ** Headers and importers + -- $headers_and_importers + + , module Text.Sass.Functions + , module Data.Default.Class + ) where + +import Data.Default.Class (def) +import Text.Sass.Compilation +import Text.Sass.Functions +import Text.Sass.Options +import Text.Sass.Values + +-- $compilation +-- Compilation of Sass source is very easy - you only have to use 'compileFile' +-- or 'compileString' and leave the work to hsass. 'compileFile' takes path to +-- the file as first parameter, while 'compileString' takes source code. +-- Both functions take 'SassOptions' as second parameter, so if you want to +-- customize compilation behaviour, you may use it. +-- +-- The result of both functions is 'Either' @Left 'SassError'@, indicating that +-- something went wrong, or @Right 'String'@ with resulting code. +-- You can examine 'SassError' to gain more knowledge about the error. +-- +-- 'SassOptions' is instance of 'Default' class, so you may use 'def' function +-- to get defaults. +-- +-- For example, this code: +-- +-- > compileString "foo { margin: 2 * 14px; }" def +-- +-- Will result in something like +-- +-- > "foo { margin: 28px; }" +-- +-- When you want to compile source code instead of file, consider setting +-- 'sassIncludePaths' - it will allow to resolve @includes without custom +-- importers. + +-- $options +-- 'SassOptions' wraps context options. It does not +-- try to be smarter than libsass, so it is mostly 1-1 mapping. See +-- "Text.Sass.Options" documentation for more info. + +-- $values +-- "Text.Sass.Values" module wraps native values that libsass uses. It provides +-- easy way to manage them in pure Haskell code. + +-- $functions_basic +-- This is the most advanced stuff in the library (even though it is quite +-- simple). It allows you to define functions in Haskell and use them from Sass +-- source, provide custom resolution for @import statements and include custom +-- headers in files. + +-- $functions +-- Let's start with explanation of functions. For example, assume that we want to +-- use function @max3@, that takes three numbers and returns the largest. In +-- Haskell, we would write it like this: +-- +-- > max3 :: Int -> Int -> Int -> Int +-- > max3 a b c = max a $ max b c +-- +-- Unfortunately, sass would not be able to use that. We must rewrite this +-- function so that it operates on 'SassValue's. If we want to use function +-- in sass, it has to have following signature: +-- +-- > func :: SassValue -> IO SassValue +-- +-- It takes an argument that is 'SassList' with all of arguments passed in sass +-- code and returns computed 'SassValue'. With this in mind, we may write +-- following code: +-- +-- > max3 (SassList (SassNumber a _:SassNumber b _:SassNumber c _:_) _) = +-- > return $ SassNumber (max a $ max b c) "px" +-- > max3 _ = SassError "invalid arguments" +-- +-- Having this function, we may proceed and define its signature: +-- +-- > max3sig = SassFunction "max3($a, $b, $c)" max3 +-- +-- This description allows compiler to map Haskell function (@max3@) to a form +-- that may be used in sass. Signature consists of function name (@max3@), +-- opening parenthesis, list of arguments (dollar sign and its name) separated +-- by comma and closing parenthesis. It is the same as function definition in +-- sass code. +-- +-- With this code we may tell compiler to use this function. In order to do +-- this, we must replace 'sassFunctions' field in 'SassOptions': +-- +-- > opts = def { sassFunctions = Just [max3sig] } +-- +-- Now, we may compile code that uses function max3: +-- +-- > compileString "foo { margin: max3(1px, 2px, 3px); }" opts +-- +-- And we will get +-- +-- > "foo { margin: 3px; }" +-- +-- There exist several functions that are special: +-- +-- * @*@ - fallback implementation +-- * @@warn@ - overload warn statement +-- * @@error@ - overload error statement +-- * @@debug@ - overload debug statement +-- +-- See +-- documentation for more information. + +-- $headers_and_importers +-- Importers are functions that override default behaviour of @import statement +-- behaviour. For example, you may implement rewrite rules or even download +-- stylesheets from remote server. +-- +-- Headers leverage the same infrastructure as importers - they are just used +-- not for @imports, but for every file being loaded. They allow you to inject +-- arbitrary sass source in the file. +-- +-- Let's say that we want to inject path to currently compiled file. We may write +-- following header: +-- +-- > header src = return [makeSourceImport $ "$file: " ++ src ++ ";"] +-- +-- It simply returns sass code that defines @$file@ variable set to path to +-- current file (first argument of function). +-- Then, we must define header signature and options: +-- +-- > headerSig = SassImporter 1 header +-- > opts = def { sassHeaders = Just [headerSig], sassInputPath = Just "path" } +-- +-- We set 'sassInputPath', because we will be compiling string and it won't be +-- set automatically. +-- Now, executing +-- +-- > compileString "foo { prop: $file; }" opts +-- +-- Will produce following result: +-- +-- > "foo { prop: path; }" +-- +-- Importers are defined and act similarly - they just take path to file being +-- imported instead of file being processed and are injected using +-- 'sassImporters'. +-- +-- Additionally importers support priorities - if two importers return source +-- for some file, the one with higher priority wins. For example +-- +-- > importer1 src = return [makeSourceImport $ "$file: " ++ src ++ "1;"] +-- > importer2 src = return [makeSourceImport $ "$file: " ++ src ++ "2;"] +-- > importerSigs = [SassImporter 0.5 importer1, SassImporter 1 importer2] +-- > opts = def { sassImporters = Just importerSigs } +-- > compileString "@import \"file\";\nfoo { prop: $file; }" opts +-- +-- Will result in +-- +-- > "foo { prop: file2; }" +-- +-- Instead of providing source code for imports, you may provide path to file +-- and leave loading to library. This is done by settings only 'importPath' and +-- 'importBase' in 'SassImport' or using 'makePathImport' instead of +-- 'makeSourceImport'. This may be useful to implement just rewrite rules and +-- not full loading. diff --git a/Text/Sass/Compilation.hs b/Text/Sass/Compilation.hs new file mode 100644 --- /dev/null +++ b/Text/Sass/Compilation.hs @@ -0,0 +1,137 @@ +-- | Compilation of sass source or sass files. +{-# LANGUAGE BangPatterns #-} +module Text.Sass.Compilation + ( + -- * Compilation + compileFile + , compileString + -- * Error reporting + , SassError (errorStatus) + , errorJson + , errorText + , errorMessage + , errorFile + , errorSource + , errorLine + , errorColumn + ) where + +import qualified Bindings.Libsass as Lib +import Control.Monad ((>=>)) +import Foreign +import Foreign.C +import Text.Sass.Internal +import Text.Sass.Options + +-- | Represents compilation error. +data SassError = SassError { + errorStatus :: Int, -- ^ Compilation satus code. + errorContext :: ForeignPtr Lib.SassContext +} + +instance Show SassError where + show (SassError s _) = + "SassError: cannot compile provided source, error status: " ++ show s + +instance Eq SassError where + (SassError s1 _) == (SassError s2 _) = s1 == s2 + +-- | Loads specified property from context and converts it to desired type. +loadFromError :: (Ptr Lib.SassContext -> IO a) -- ^ Accessor function. + -> (a -> IO b) -- ^ Conversion method. + -> SassError -- ^ Pointer to context. + -> IO b -- ^ Result. +loadFromError get conv err = withForeignPtr ptr $ get >=> conv + where ptr = errorContext err + +-- | Equivalent to @'loadFromError' 'get' 'peekCString' 'err'@. +loadStringFromError :: (Ptr Lib.SassContext -> IO CString) -- ^ Accessor function. + -> SassError -- ^ Pointer to context. + -> IO String -- ^ Result. +loadStringFromError get = loadFromError get peekCString + +-- | Equivalent to @'loadFromError' 'get' 'fromInteger' 'err'@. +loadIntFromError :: (Integral a) + => (Ptr Lib.SassContext -> IO a) -- ^ Accessor function. + -> SassError -- ^ Pointer to context. + -> IO Int -- ^ Result. +loadIntFromError get = loadFromError get (return.fromIntegral) + +-- | Loads information about error as JSON. +errorJson :: SassError -> IO String +errorJson = loadStringFromError Lib.sass_context_get_error_json + +-- | Loads error text. +errorText :: SassError -> IO String +errorText = loadStringFromError Lib.sass_context_get_error_text + +-- | Loads user-friendly error message. +errorMessage :: SassError -> IO String +errorMessage = loadStringFromError Lib.sass_context_get_error_message + +-- | Loads file where problem occured. +errorFile :: SassError -> IO String +errorFile = loadStringFromError Lib.sass_context_get_error_file + +-- | Loads error source. +errorSource :: SassError -> IO String +errorSource = loadStringFromError Lib.sass_context_get_error_src + +-- | Loads line in the file where problem occured. +errorLine :: SassError -> IO Int +errorLine = loadIntFromError Lib.sass_context_get_error_line + +-- | Loads line in the file where problem occured. +errorColumn :: SassError -> IO Int +errorColumn = loadIntFromError Lib.sass_context_get_error_column + +-- | Common code for 'compileFile' and 'compileString'. +compileInternal :: CString -- ^ String that will be passed to 'make context'. + -> SassOptions + -> (CString -> IO (Ptr a)) -- ^ Make context. + -> (Ptr a -> IO CInt) -- ^ Compile context. + -> (Ptr a -> IO ()) -- ^ Delete context. + -> FinalizerPtr a -- ^ Context finalizer. + -> IO (Either SassError String) +compileInternal str opts make compile delete finalizer = do + -- Makes an assumption, that Sass_*_Context inherits from Sass_Context + -- and Sass_Options. + context <- make str + let context' = castPtr context + let opts' = castPtr context + copyOptionsToNative opts opts' + status <- withFunctions opts opts' $ compile context + if status /= 0 + then do + fptr <- newForeignPtr finalizer context + return $ Left $ + SassError (fromIntegral status) (castForeignPtr fptr) + else do + result <- Lib.sass_context_get_output_string context' + !result' <- peekCString result + delete context + return $ Right result' + + +-- | Compiles file using specified options. +compileFile :: FilePath -- ^ Path to the file. + -> SassOptions -- ^ Compilation options. + -> IO (Either SassError String) -- ^ Error or output string. +compileFile path opts = withCString path $ \cpath -> + compileInternal cpath opts + Lib.sass_make_file_context + Lib.sass_compile_file_context + Lib.sass_delete_file_context + Lib.p_sass_delete_file_context + +-- | Compiles raw Sass content using specified options. +compileString :: String -- ^ String to compile. + -> SassOptions -- ^ Compilation options. + -> IO (Either SassError String) -- ^ Error or output string. +compileString str opts = do + cdata <- newCString str + compileInternal cdata opts + Lib.sass_make_data_context + Lib.sass_compile_data_context + Lib.sass_delete_data_context + Lib.p_sass_delete_data_context diff --git a/Text/Sass/Functions.hs b/Text/Sass/Functions.hs new file mode 100644 --- /dev/null +++ b/Text/Sass/Functions.hs @@ -0,0 +1,67 @@ +-- | Provides support for user-defined functions, importers and headers. +module Text.Sass.Functions + ( + -- * Functions + SassFunctionType + , SassFunction (..) + -- * Imports and headers + , SassImport (..) + , SassImporterType + , SassImporter (..) + , makeSourceImport + , makePathImport + ) where + +import Text.Sass.Values + +-- | Type of the function that may be used in sass source. +type SassFunctionType = + SassValue -- ^ Arguments of the function ('SassList'). + -> IO SassValue -- ^ Result of the computation. + +-- | Description of the function that may be used in sass source. +data SassFunction = SassFunction { + -- | Signature of the function, parsable by libsass. + funcSignature :: String + -- | Main function. + , funcComputation :: SassFunctionType +} + +-- | Represents a sass import - a sass content with additional metadata. +-- +-- Even though this ADT has four fields, you may just provide either +-- 'importPath' and 'importBase' and leave loading to the library, or provide +-- 'importSource' and do not provide 'importPath' nor 'importBase'. +-- Nevertheless, you are free to provide all of the fields. +data SassImport = SassImport { + importPath :: Maybe FilePath, -- ^ Path to the import, relative to base. + importBase :: Maybe FilePath, -- ^ Base path. + importSource :: Maybe String, -- ^ Import's source. + importSourceMap :: Maybe String -- ^ Source map of the import. +} + +-- | Type of the function that acts like importer/header. +-- +-- You may return empty list in order to tell libsass to handle the import by +-- itself or not insert any header. +type SassImporterType = + String + -- ^ Path to the import that needs to be loaded or file that is being + -- processed when used as a header. + -> IO [SassImport] -- ^ Imports. + +-- | Description of the importer. +data SassImporter = SassImporter { + importerPriority :: Double -- ^ Priority of the importer. + , importerFunction :: SassImporterType -- ^ Main function. +} + +-- | 'makeSourceImport' @s@ is equivalent to 'SassImport' +-- @Nothing Nothing (Just s) Nothing@. +makeSourceImport :: String -> SassImport +makeSourceImport s = SassImport Nothing Nothing (Just s) Nothing + +-- | 'makePathImport' @p b@ is equivalent to 'SassImport' +-- @(Just p) (Just b) Nothing Nothing@. +makePathImport :: String -> String -> SassImport +makePathImport p b = SassImport (Just p) (Just b) Nothing Nothing diff --git a/Text/Sass/Functions/Internal.hs b/Text/Sass/Functions/Internal.hs new file mode 100644 --- /dev/null +++ b/Text/Sass/Functions/Internal.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE LambdaCase #-} +module Text.Sass.Functions.Internal + ( + -- * Functions + wrapFunction + , makeNativeFunction + , clearNativeFunction + , freeNativeFunction + , makeNativeFunctionList + , clearNativeFunctionList + , freeNativeFunctionList + -- * Imports and headers + , wrapImporter + , makeNativeImport + , freeNativeImport + , makeNativeImportList + , freeNativeImportList + , makeNativeImporter + , freeNativeImporter + , makeNativeImporterList + , freeNativeImporterList + ) where + +import qualified Bindings.Libsass as Lib +import Foreign +import Foreign.C +import Text.Sass.Functions +import Text.Sass.Utils +import Text.Sass.Values.Internal + +-- | Wraps function of type 'SassFunctionType' into function that may be passed +-- to native library. +wrapFunction :: SassFunctionType -> Lib.SassFunctionFnType +wrapFunction fn args _ _ = fromNativeValue args >>= fn >>= toNativeValue + +-- | Converts 'SassFunction' into native representation. +-- +-- Freeing native representation is not a pleasant process - libsass frees +-- the 'Lib.SassFunctionEntry', but does not free signature. Because of that, +-- special care must be taken in order to properly deallocate the object. +-- If you don't want to pass the resulting object to Sass_Options, +-- call both 'clearNativeFunction' and then 'freeNativeFunction'. Otherwise, +-- you should call 'clearNativeFunction' BEFORE you deallocate context. +makeNativeFunction :: SassFunction -> IO Lib.SassFunctionEntry +makeNativeFunction (SassFunction sig' fn) = do + sig <- newCString sig' + wrapped <- Lib.mkSassFunctionFn $ wrapFunction fn + Lib.sass_make_function sig wrapped nullPtr + +-- | Releases the signature of a function entry. +clearNativeFunction :: Lib.SassFunctionEntry -> IO () +clearNativeFunction entry = do + sig <- Lib.sass_function_get_signature entry + free sig + +-- | Deallocates the object, but does not deallocate signature. +freeNativeFunction :: Lib.SassFunctionEntry -> IO () +freeNativeFunction = free + +-- | Converts list of 'SassFunction's into native representation. +-- +-- There is analogous problem in relation to deallocation of the result as +-- with 'makeNativeFunction'. See documentation above for explanation. +makeNativeFunctionList :: [SassFunction] -> IO Lib.SassFunctionList +makeNativeFunctionList = + copyToCList Lib.sass_make_function_list makeNativeFunction pokeElemOff + +-- | Releases signatures of entries in the list. +clearNativeFunctionList :: Lib.SassFunctionList -> IO () +clearNativeFunctionList = loopCList clearNativeFunction + +-- | Frees the list and entries, without releasing signatures. +freeNativeFunctionList :: Lib.SassFunctionList -> IO () +freeNativeFunctionList = loopCList freeNativeFunction + +-- | Wraps function of type 'SassImporterType'. +wrapImporter :: SassImporterType -> Lib.SassImporterFnType +wrapImporter fn url _ _ = peekCString url >>= fn >>= \case + [] -> return nullPtr + xs -> makeNativeImportList xs + +-- | Converts 'SassImport' into native representation. +makeNativeImport :: SassImport -> IO Lib.SassImportEntry +makeNativeImport el = do + path <- maybeNew newCString $ importPath el + base <- maybeNew newCString $ importPath el + source <- maybeNew newCString $ importSource el + srcmap <- maybeNew newCString $ importSourceMap el + Lib.sass_make_import path base source srcmap + +-- | Frees native representation of 'SassImport'. +freeNativeImport :: Lib.SassImportEntry -> IO () +freeNativeImport = Lib.sass_delete_import + +-- | Converts list of 'SassImport's into native representation. +makeNativeImportList :: [SassImport] -> IO Lib.SassImportList +makeNativeImportList = + copyToCList Lib.sass_make_import_list makeNativeImport pokeElemOff + +-- | Frees native representation of list of 'SassEntry', including entries. +freeNativeImportList :: Lib.SassImportList -> IO () +freeNativeImportList = Lib.sass_delete_import_list + +-- | Converts 'SassImporter' into native representation. +makeNativeImporter :: SassImporter -> IO Lib.SassImporterEntry +makeNativeImporter (SassImporter p func) = do + func' <- Lib.mkSassImporterFn $ wrapImporter func + Lib.sass_make_importer func' (realToFrac p) nullPtr + +-- | Frees native representation of 'SassImporter'. +freeNativeImporter :: Lib.SassImporterEntry -> IO () +freeNativeImporter = Lib.sass_delete_importer + +-- | Makes native representation of list of 'SassImporter's. +makeNativeImporterList :: [SassImporter] -> IO Lib.SassImporterList +makeNativeImporterList = + copyToCList Lib.sass_make_importer_list makeNativeImporter pokeElemOff + +-- | Frees list of native representations of 'SassImporter's. +-- +-- Libsass does not provide function to free this kind of objects, but we +-- provide it just in case. +freeNativeImporterList :: Lib.SassImporterList -> IO () +freeNativeImporterList lst = (loopCList freeNativeImporter lst) >> free lst diff --git a/Text/Sass/Internal.hs b/Text/Sass/Internal.hs new file mode 100644 --- /dev/null +++ b/Text/Sass/Internal.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_HADDOCK hide #-} +module Text.Sass.Internal + ( + module I + ) where + +import Text.Sass.Functions.Internal as I +import Text.Sass.Options.Internal as I +import Text.Sass.Utils as I +import Text.Sass.Values.Internal as I diff --git a/Text/Sass/Options.hs b/Text/Sass/Options.hs new file mode 100644 --- /dev/null +++ b/Text/Sass/Options.hs @@ -0,0 +1,78 @@ +-- | Compilation options. +module Text.Sass.Options + ( + SassOptions (..) + , Lib.SassOutputStyle (..) + ) where + +import qualified Bindings.Libsass as Lib +import Data.Default.Class +import Text.Sass.Functions + +-- | Describes options used by libsass during compilation. +data SassOptions = SassOptions { + -- | Precision of fractional numbers. + sassPrecision :: Int + -- | Output style for the generated css code. + , sassOutputStyle :: Lib.SassOutputStyle + -- | Emit comments in the generated CSS indicating the corresponding source + -- line. + , sassSourceComments :: Bool + -- | Embed sourceMappingUrl as data uri. + , sassSourceMapEmbed :: Bool + -- | Embed include contents in maps. + , sassSourceMapContents :: Bool + -- | Disable sourceMappingUrl in css output. + , sassOmitSourceMapUrl :: Bool + -- | Treat source_string as sass (as opposed to scss). + , sassIsIndentedSyntax :: Bool + -- | String to be used for indentation. + , sassIndent :: String + -- | String to be used to for line feeds. + , sassLinefeed :: String + -- | The input path used for source map generation. It can be used to + -- define something with string compilation or to overload the input file + -- path. + , sassInputPath :: Maybe FilePath + -- | The output path used for source map generation. + , sassOutputPath :: Maybe FilePath + -- | Paths used to load plugins by libsass. + , sassPluginPaths :: Maybe [FilePath] + -- | Paths used to resolve @include. + , sassIncludePaths :: Maybe [FilePath] + -- | Path to source map file. Enables source map generation and is used to + -- create sourceMappingUrl + , sassSourceMapFile :: Maybe FilePath + -- | Directly inserted in source maps. + , sassSourceMapRoot :: Maybe String + -- | List of user-supplied functions that may be used in sass files. + , sassFunctions :: Maybe [SassFunction] + -- | List of user-supplied functions that provide "headers" for sass files. + -- Header is injected at the beginning of a file which name is passed as + -- the first argument of importer. + , sassHeaders :: Maybe [SassImporter] + -- | List of user-supplied functions that resolve @import directives. + , sassImporters :: Maybe [SassImporter] +} + +instance Default SassOptions where + def = SassOptions { + sassPrecision = 5 + , sassOutputStyle = Lib.SassStyleNested + , sassSourceComments = False + , sassSourceMapEmbed = False + , sassSourceMapContents = False + , sassOmitSourceMapUrl = False + , sassIsIndentedSyntax = False + , sassIndent = " " + , sassLinefeed = "\n" + , sassInputPath = Nothing + , sassOutputPath = Nothing + , sassPluginPaths = Nothing + , sassIncludePaths = Nothing + , sassSourceMapFile = Nothing + , sassSourceMapRoot = Nothing + , sassFunctions = Nothing + , sassHeaders = Nothing + , sassImporters = Nothing + } diff --git a/Text/Sass/Options/Internal.hs b/Text/Sass/Options/Internal.hs new file mode 100644 --- /dev/null +++ b/Text/Sass/Options/Internal.hs @@ -0,0 +1,65 @@ +-- | Copying 'SassOptions' into native context. This module is internal and +-- should not be considered stable. +{-# LANGUAGE BangPatterns #-} +module Text.Sass.Options.Internal + ( + copyOptionsToNative + , withFunctions + ) where + +import qualified Bindings.Libsass as Lib +import Control.Applicative ((<$>)) +import Control.Monad ((>=>)) +import Foreign +import Foreign.C +import Text.Sass.Functions.Internal +import Text.Sass.Options +import Text.Sass.Utils + +-- | Copies 'SassOptions' to native object, excluding 'sassFunctions'. +copyOptionsToNative :: SassOptions -> Ptr Lib.SassOptions -> IO () +copyOptionsToNative opt ptr = do + Lib.sass_option_set_precision ptr (fromIntegral $ sassPrecision opt) + Lib.sass_option_set_output_style ptr + (fromIntegral $ fromEnum $ sassOutputStyle opt) + Lib.sass_option_set_source_comments ptr (sassSourceComments opt) + Lib.sass_option_set_source_map_embed ptr (sassSourceMapEmbed opt) + Lib.sass_option_set_source_map_contents ptr (sassSourceMapContents opt) + Lib.sass_option_set_omit_source_map_url ptr (sassOmitSourceMapUrl opt) + Lib.sass_option_set_is_indented_syntax_src ptr (sassIsIndentedSyntax opt) + withCString (sassIndent opt) (Lib.sass_option_set_indent ptr) + withCString (sassLinefeed opt) (Lib.sass_option_set_linefeed ptr) + withOptionalCString (sassInputPath opt) + (Lib.sass_option_set_input_path ptr) + withOptionalCString (sassOutputPath opt) + (Lib.sass_option_set_output_path ptr) + withOptionalCString (concatPaths <$> sassPluginPaths opt) + (Lib.sass_option_set_plugin_path ptr) + withOptionalCString (concatPaths <$> sassIncludePaths opt) + (Lib.sass_option_set_include_path ptr) + withOptionalCString (sassSourceMapFile opt) + (Lib.sass_option_set_source_map_file ptr) + withOptionalCString (sassSourceMapRoot opt) + (Lib.sass_option_set_source_map_root ptr) + maybe (return ()) + (makeNativeImporterList >=> Lib.sass_option_set_c_headers ptr) + (sassHeaders opt) + maybe (return ()) + (makeNativeImporterList >=> Lib.sass_option_set_c_importers ptr) + (sassImporters opt) + +-- | Copies 'sassFunctions' to native object, executes action, clears leftovers +-- (see documentation of 'makeNativeFunction') and returns action result. +withFunctions :: SassOptions -- ^ Options. + -> Ptr Lib.SassOptions -- ^ Native options. + -> IO a -- ^ Action. + -> IO a -- ^ Result +withFunctions opt ptr action = + case (sassFunctions opt) of + Nothing -> action + Just lst -> do + nativeFnList <- makeNativeFunctionList lst + Lib.sass_option_set_c_functions ptr nativeFnList + !result <- action + clearNativeFunctionList nativeFnList + return result diff --git a/Text/Sass/Utils.hs b/Text/Sass/Utils.hs new file mode 100644 --- /dev/null +++ b/Text/Sass/Utils.hs @@ -0,0 +1,68 @@ +-- | Helper functions. This module is internal and should not be used in +-- production code. +{-# LANGUAGE ViewPatterns #-} +module Text.Sass.Utils + ( + -- * Interoperation with C API + withOptionalCString + , listEntryNotNull + , loopCList + , copyToCList + -- * Other helpers + , concatPaths + , arrayRange + ) where + +import Control.Monad.Loops (whileM_) +import Control.Monad.State.Strict +import Data.List (intercalate) +import Foreign +import Foreign.C +import System.FilePath (searchPathSeparator) + +-- | 'withOptionalCString' @str action@, if @str@ is 'Nothing', @action@ is not +-- invoked, otherwise behaves like 'withCString'. +withOptionalCString :: Maybe String -> (CString -> IO ()) -> IO () +withOptionalCString (Just str) action = withCString str action +withOptionalCString Nothing _ = return () + +-- | Checks if the pointer in state points to non-null location. +listEntryNotNull :: (Monad m, MonadIO m) => StateT (Ptr (Ptr a)) m Bool +listEntryNotNull = do + ptr <- get + val <- liftIO $ peek ptr + return $ val /= nullPtr + +-- | 'loopCArray' @action list@ calls @action@ over each element of @list@ that +-- is C array with NULL signifying end of array. +loopCList :: (Monad m, MonadIO m) => (Ptr a -> m ()) -> Ptr (Ptr a) -> m () +loopCList action list = + flip evalStateT list $ whileM_ listEntryNotNull $ do + ptr <- get + val <- liftIO $ peek ptr + modify' (`plusPtr` sizeOf val) + lift $ action val + +-- | Copies converted list of elements to new C array. +copyToCList :: (Num size, Enum size) + => (CSize -> IO list) -- ^ List creator. + -> (a -> IO element) -- ^ Conversion function. + -> (list -> size -> element -> IO ()) -- ^ Set element function. + -> [a] -- ^ Elements. + -> IO list +copyToCList create convert set list = do + let len = length list + result <- create $ fromIntegral len + zipWithM_ (addToList result) [0..(fromIntegral len) - 1] list + return result + where + addToList lst idx = convert >=> set lst idx + +-- | Concatenates list of paths, separating entries with appropriate character. +concatPaths :: [FilePath] -> FilePath +concatPaths = intercalate [searchPathSeparator] + +-- | Generates array indices for array of specified length. +arrayRange :: (Num a, Integral a, Enum a) => a -> [a] +arrayRange 0 = [] +arrayRange l = [0..l - 1] diff --git a/Text/Sass/Values.hs b/Text/Sass/Values.hs new file mode 100644 --- /dev/null +++ b/Text/Sass/Values.hs @@ -0,0 +1,31 @@ +-- | Provides API for managing values that may be extracter from or injected to +-- sass source file. +module Text.Sass.Values + ( + SassMapEntry + , SassValue (..) + , Lib.SassSeparator (..) + ) where + +import qualified Bindings.Libsass as Lib + +-- | Entry of 'SassMap'. +type SassMapEntry = (SassValue, SassValue) + +-- | Represents value used by libsass. +data SassValue = SassBool Bool -- ^ Boolean value. + | SassNumber Double String -- ^ Number (value and unit). + | SassColor { + sassColorR :: Double, + sassColorG :: Double, + sassColorB :: Double, + sassColorA :: Double + } -- ^ RGBA color. + | SassString String -- ^ String + | SassList [SassValue] Lib.SassSeparator + -- ^ List of 'SassValue's. + | SassMap [SassMapEntry] -- ^ Map. + | SassNull -- ^ Null value. + | SassWarning String -- ^ Warning with message. + | SassError String -- ^ Error with message. + deriving (Eq) diff --git a/Text/Sass/Values/Internal.hs b/Text/Sass/Values/Internal.hs new file mode 100644 --- /dev/null +++ b/Text/Sass/Values/Internal.hs @@ -0,0 +1,95 @@ +-- | Conversion of 'SassValue' or list of 'SassValue's into native +-- representation. This module is internal and should not be considered stable. +module Text.Sass.Values.Internal + ( + toNativeValue + , fromNativeValue + , deleteNativeValue + , makeValueForeignPtr + ) where + +import qualified Bindings.Libsass as Lib +import Control.Applicative ((<$>)) +import Control.Monad (forM, (>=>)) +import Foreign +import Foreign.C +import Text.Sass.Utils +import Text.Sass.Values + +-- | Converts a 'SassValue' to native type. +toNativeValue :: SassValue -> IO (Ptr Lib.SassValue) +toNativeValue (SassBool val) = Lib.sass_make_boolean val +toNativeValue (SassNumber val unit) = withCString unit $ + Lib.sass_make_number (realToFrac val) +toNativeValue (SassColor r g b a) = Lib.sass_make_color r' g' b' a' + where r' = realToFrac r + g' = realToFrac g + b' = realToFrac b + a' = realToFrac a +toNativeValue (SassString str) = withCString str Lib.sass_make_string +toNativeValue SassNull = Lib.sass_make_null +toNativeValue (SassWarning str) = withCString str Lib.sass_make_warning +toNativeValue (SassError str) = withCString str Lib.sass_make_error +toNativeValue (SassList lst sep') = + copyToCList (flip Lib.sass_make_list sep) toNativeValue + Lib.sass_list_set_value lst + where sep = fromIntegral $ fromEnum sep' + +toNativeValue (SassMap lst) = copyToCList Lib.sass_make_map makeVal setVal lst + where + makeVal (key, val) = do + nativeKey <- toNativeValue key + nativeVal <- toNativeValue val + return (nativeKey, nativeVal) + setVal list idx (key, val) = do + Lib.sass_map_set_key list idx key + Lib.sass_map_set_value list idx val + +-- | Converts native value to 'SassValue'. +fromNativeValue :: Ptr Lib.SassValue -> IO SassValue +fromNativeValue ptr = do + tag <- Lib.sass_value_get_tag ptr + fromNativeValue' (toEnum $ fromIntegral tag) ptr + +-- | Real code for 'fromNativeValue'. +fromNativeValue' :: Lib.SassTag -> Ptr Lib.SassValue -> IO SassValue +fromNativeValue' Lib.SassBoolean ptr = + SassBool <$> Lib.sass_boolean_get_value ptr +fromNativeValue' Lib.SassNumber ptr = do + val <- Lib.sass_number_get_value ptr + unit <- Lib.sass_number_get_unit ptr >>= peekCString + return $ SassNumber (realToFrac val) unit +fromNativeValue' Lib.SassColor ptr = do + r <- realToFrac <$> Lib.sass_color_get_r ptr + g <- realToFrac <$> Lib.sass_color_get_g ptr + b <- realToFrac <$> Lib.sass_color_get_b ptr + a <- realToFrac <$> Lib.sass_color_get_a ptr + return $ SassColor r g b a +fromNativeValue' Lib.SassString ptr = + SassString <$> (Lib.sass_string_get_value ptr >>= peekCString) +fromNativeValue' Lib.SassNull _ = return SassNull +fromNativeValue' Lib.SassWarning ptr = do + SassWarning <$> (Lib.sass_warning_get_message ptr >>= peekCString) +fromNativeValue' Lib.SassError ptr = do + SassError <$> (Lib.sass_error_get_message ptr >>= peekCString) +fromNativeValue' Lib.SassList ptr = do + len <- Lib.sass_list_get_length ptr + sep <- fromIntegral <$> Lib.sass_list_get_separator ptr + lst <- forM (arrayRange len) + (Lib.sass_list_get_value ptr >=> fromNativeValue) + return $ SassList lst (toEnum sep) +fromNativeValue' Lib.SassMap ptr = do + len <- Lib.sass_map_get_length ptr + lst <- forM (arrayRange len) $ \idx -> do + key <- Lib.sass_map_get_key ptr idx >>= fromNativeValue + val <- Lib.sass_map_get_value ptr idx >>= fromNativeValue + return (key, val) + return $ SassMap lst + +-- | Frees native representation of 'SassValue'. +deleteNativeValue :: Ptr Lib.SassValue -> IO () +deleteNativeValue = Lib.sass_delete_value + +-- | Makes 'ForeignPtr' from 'Ptr' to native representation of 'SassValue'. +makeValueForeignPtr :: Ptr Lib.SassValue -> IO (ForeignPtr Lib.SassValue) +makeValueForeignPtr = newForeignPtr Lib.p_sass_delete_value diff --git a/hsass.cabal b/hsass.cabal new file mode 100644 --- /dev/null +++ b/hsass.cabal @@ -0,0 +1,71 @@ +name: hsass +version: 0.1.0 +license: MIT +license-file: LICENSE +author: Jakub Fijałkowski +maintainer: fiolek94@gmail.com +homepage: https://github.com/jakubfijalkowski/hsass +category: Text +build-type: Simple +cabal-version: >= 1.10 +stability: experimental +synopsis: Integrating Sass into Haskell applications. +description: + This package provides quite simple (but not too simple) API for + compilation of code. It uses + (hlibsass) underneath, so the code it + parses/generates should be compatible with original Sass implementation (or at + least ). + + This package tries to minimize C API usage, so the only place where it is used + is in the 'compileFile' / 'compileString' methods. This allows us to stay pure + as long as we can and not waste performance for going back and forth. + + If you feel that compilation options constrain you too much, you may use rest + of modules without it. With them, you can use Haskell types and mechanisms to + manage libsass's data(eg. importers, options, values) and modify compilation + process as you like. + +extra-source-files: + CHANGELOG.md + +source-repository head + type: git + location: git://github.com/jakubfijalkowski/hsass.git + +library + exposed-modules: + Text.Sass + , Text.Sass.Compilation + , Text.Sass.Functions + , Text.Sass.Options + , Text.Sass.Values + , Text.Sass.Internal + , Text.Sass.Functions.Internal + , Text.Sass.Options.Internal + , Text.Sass.Values.Internal + , Text.Sass.Utils + build-depends: + base >= 4.7 && <4.8, + hlibsass >= 0.1.1, + data-default-class, + filepath >= 1.0, + mtl >= 2.2, + monad-loops >= 0.3 + hs-source-dirs: . + default-language: Haskell2010 + ghc-options: -Wall + +test-suite test + hs-source-dirs: test + main-is: Spec.hs + type: exitcode-stdio-1.0 + ghc-options: -Wall + build-depends: + base >= 4.7 && < 5 + , hspec >= 2.1.5 + , hspec-discover >= 2.1.5 + , temporary >= 1.1 + , hsass + , data-default-class + default-language: Haskell2010 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}