diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ All notable changes to this project will be documented in this file. This project adheres to [Semantic Versioning](http://semver.org/). +## [0.7.0] - 2018-04-02 +### Changed +- This library uses UTF-8 to encode/decode all `CString`s (paths included!) + ## [0.6.0] - 2018-03-24 ### Changed - Switched to `hLibsass` 0.1.7.0 and `libsass` 3.5.2 @@ -74,3 +78,4 @@ [0.4.2]: https://github.com/jakubfijalkowski/hsass/compare/v0.4.1...v0.4.2 [0.5.0]: https://github.com/jakubfijalkowski/hsass/compare/v0.4.2...v0.5.0 [0.6.0]: https://github.com/jakubfijalkowski/hsass/compare/v0.5.0...v0.6.0 +[0.7.0]: https://github.com/jakubfijalkowski/hsass/compare/v0.6.0...v0.7.0 diff --git a/Text/Sass/Compilation.hs b/Text/Sass/Compilation.hs --- a/Text/Sass/Compilation.hs +++ b/Text/Sass/Compilation.hs @@ -43,8 +43,7 @@ import Control.Monad (forM, (>=>)) import Foreign import Foreign.C -import qualified Text.Sass.Compilation.Internal as CI -import Text.Sass.Internal hiding (newCString) +import Text.Sass.Internal import Text.Sass.Options -- | Represents compilation error. @@ -102,7 +101,7 @@ instance SassResult String where toSassResult stripEncoding ptr = withForeignPtr ptr $ \ctx -> do result <- Lib.sass_context_get_output_string ctx - !result' <- peekCString result + !result' <- peekUTF8CString result return $ if stripEncoding then strip result' else result' where strip s @@ -141,12 +140,12 @@ loadFromError get conv err = withForeignPtr ptr $ get >=> conv where ptr = errorContext err --- | Equivalent of @'loadFromError' 'get' 'peekCString' 'err'@. +-- | Equivalent of @'loadFromError' 'get' 'peekUTF8CString 'err'@. loadStringFromError :: (Ptr Lib.SassContext -> IO CString) -- ^ Accessor function. -> SassError -- ^ Pointer to context. -> IO String -- ^ Result. -loadStringFromError get = loadFromError get peekCString +loadStringFromError get = loadFromError get peekUTF8CString -- | Equivalent of @'loadFromError' 'get' 'fromInteger' 'err'@. loadIntFromError :: (Integral a) @@ -188,7 +187,7 @@ resultIncludes ex = withForeignPtr (resultContext ex) $ \ctx -> do lst <- Lib.sass_context_get_included_files ctx len <- Lib.sass_context_get_included_files_size ctx - forM (arrayRange $ fromIntegral len) (peekElemOff lst >=> peekCString) + forM (arrayRange $ fromIntegral len) (peekElemOff lst >=> peekUTF8CString) -- | Loads a source map if it was generated by libsass. resultSourcemap :: SassExtendedResult a -> IO (Maybe String) @@ -196,7 +195,7 @@ cstr <- Lib.sass_context_get_source_map_string ctx if cstr == nullPtr then return Nothing - else Just <$> peekCString cstr + else Just <$> peekUTF8CString cstr -- | Common code for 'compileFile' and 'compileString'. compileInternal :: (SassResult b) @@ -226,7 +225,7 @@ => FilePath -- ^ Path to the file. -> SassOptions -- ^ Compilation options. -> IO (Either SassError a) -- ^ Error or output string. -compileFile path opts = withCString path $ \cpath -> +compileFile path opts = withUTF8CString path $ \cpath -> compileInternal cpath opts Lib.sass_make_file_context Lib.sass_compile_file_context @@ -238,7 +237,7 @@ -> SassOptions -- ^ Compilation options. -> IO (Either SassError a) -- ^ Error or output string. compileString str opts = do - cdata <- newCString str + cdata <- newUTF8CString str compileInternal cdata opts Lib.sass_make_data_context Lib.sass_compile_data_context @@ -250,7 +249,7 @@ -> SassOptions -- ^ Compilation options. -> IO (Either SassError a) -- ^ Error or output string. compileByteString str opts = do - cdata <- CI.newCString str + cdata <- newCStringFromBS str compileInternal cdata opts Lib.sass_make_data_context Lib.sass_compile_data_context diff --git a/Text/Sass/Compilation/Internal.hs b/Text/Sass/Compilation/Internal.hs deleted file mode 100644 --- a/Text/Sass/Compilation/Internal.hs +++ /dev/null @@ -1,21 +0,0 @@ --- | Helper functions used by Compilation module. -module Text.Sass.Compilation.Internal - ( - newCString - ) where - -import Data.ByteString (ByteString) -import qualified Data.ByteString.Internal as BI -import Foreign -import Foreign.C hiding (newCString) -import Foreign.Marshal.Alloc (mallocBytes) - --- | Copies 'ByteString' to newly allocated 'CString'. The result must be --- | explicitly freed using 'free' or 'finalizerFree'. -newCString :: ByteString -> IO CString -newCString (BI.PS fp o l) = do - buf <- mallocBytes (l + 1) - withForeignPtr fp $ \p -> do - BI.memcpy buf (p `plusPtr` o) (fromIntegral l) - pokeByteOff buf l (0::Word8) - return $ castPtr buf diff --git a/Text/Sass/Functions/Internal.hs b/Text/Sass/Functions/Internal.hs --- a/Text/Sass/Functions/Internal.hs +++ b/Text/Sass/Functions/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} module Text.Sass.Functions.Internal ( -- * Functions @@ -19,10 +18,10 @@ , freeNativeImporterList ) where -import qualified Bindings.Libsass as Lib +import qualified Bindings.Libsass as Lib import Foreign -import Foreign.C import Text.Sass.Functions +import Text.Sass.Marshal.Internal import Text.Sass.Utils import Text.Sass.Values.Internal @@ -37,7 +36,7 @@ -- call 'freeNativeFunction'. makeNativeFunction :: SassFunction -> IO Lib.SassFunctionEntry makeNativeFunction (SassFunction sig' fn) = do - sig <- newCString sig' + sig <- newUTF8CString sig' wrapped <- Lib.mkSassFunctionFn $ wrapFunction fn Lib.sass_make_function sig wrapped nullPtr @@ -61,8 +60,8 @@ wrapImporter :: SassImporterType -> Lib.SassImporterFnType wrapImporter fn url _ compiler = do lastImport <- Lib.sass_compiler_get_last_import compiler - absPath <- Lib.sass_import_get_abs_path lastImport >>= peekCString - url' <- peekCString url + absPath <- Lib.sass_import_get_abs_path lastImport >>= peekUTF8CString + url' <- peekUTF8CString url importList <- fn url' absPath case importList of [] -> return nullPtr @@ -71,10 +70,10 @@ -- | 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 + path <- maybeNew newUTF8CString $ importPath el + base <- maybeNew newUTF8CString $ importPath el + source <- maybeNew newUTF8CString $ importSource el + srcmap <- maybeNew newUTF8CString $ importSourceMap el Lib.sass_make_import path base source srcmap -- | Frees native representation of 'SassImport'. diff --git a/Text/Sass/Internal.hs b/Text/Sass/Internal.hs --- a/Text/Sass/Internal.hs +++ b/Text/Sass/Internal.hs @@ -4,8 +4,8 @@ module I ) where -import Text.Sass.Compilation.Internal as I -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 +import Text.Sass.Functions.Internal as I +import Text.Sass.Marshal.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/Marshal/Internal.hs b/Text/Sass/Marshal/Internal.hs new file mode 100644 --- /dev/null +++ b/Text/Sass/Marshal/Internal.hs @@ -0,0 +1,43 @@ +-- | Helper functions used by Compilation module. +module Text.Sass.Marshal.Internal + ( + peekUTF8CString, + newUTF8CString, + withUTF8CString, + newCStringFromBS + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Internal as BI +import Foreign +import Foreign.C +import Foreign.Marshal.Alloc (mallocBytes) + +import qualified GHC.Foreign as GHC +import qualified GHC.IO.Encoding as E + +-- | Marshal a NUL terminated C string (UTF-8 encoded) into Haskell string. +-- | It is equivalent to 'peekCString' but with different encoding. +peekUTF8CString :: CString -> IO String +peekUTF8CString = GHC.peekCString E.utf8 + +-- | Marshal a Haskell string into a NUL terminated C string (UTF-8 encoded). +-- | It is equivalent to 'newCString' but with different encoding. +newUTF8CString :: String -> IO CString +newUTF8CString = GHC.newCString E.utf8 + +-- | Marshal a Haskell string into a C string (ie, character array) +-- in temporary storage, with explicit length information. +-- | It is equivalent to 'withCString' but with different encoding. +withUTF8CString :: String -> (CString -> IO a) -> IO a +withUTF8CString = GHC.withCString E.utf8 + +-- | Copies 'ByteString' to newly allocated 'CString'. The result must be +-- | explicitly freed using 'free' or 'finalizerFree'. +newCStringFromBS :: ByteString -> IO CString +newCStringFromBS (BI.PS fp o l) = do + buf <- mallocBytes (l + 1) + withForeignPtr fp $ \p -> do + BI.memcpy buf (p `plusPtr` o) (fromIntegral l) + pokeByteOff buf l (0::Word8) + return $ castPtr buf diff --git a/Text/Sass/Options/Internal.hs b/Text/Sass/Options/Internal.hs --- a/Text/Sass/Options/Internal.hs +++ b/Text/Sass/Options/Internal.hs @@ -14,9 +14,9 @@ #endif import Control.Monad ((>=>)) import Foreign -import Foreign.C import Text.Sass.Functions import Text.Sass.Functions.Internal +import Text.Sass.Marshal.Internal import Text.Sass.Options import Text.Sass.Utils @@ -31,19 +31,19 @@ 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) + withUTF8CString (sassIndent opt) (Lib.sass_option_set_indent ptr) + withUTF8CString (sassLinefeed opt) (Lib.sass_option_set_linefeed ptr) + withOptionalUTF8CString (sassInputPath opt) (Lib.sass_option_set_input_path ptr) - withOptionalCString (sassOutputPath opt) + withOptionalUTF8CString (sassOutputPath opt) (Lib.sass_option_set_output_path ptr) - withOptionalCString (concatPaths <$> sassPluginPaths opt) + withOptionalUTF8CString (concatPaths <$> sassPluginPaths opt) (Lib.sass_option_set_plugin_path ptr) - withOptionalCString (concatPaths <$> sassIncludePaths opt) + withOptionalUTF8CString (concatPaths <$> sassIncludePaths opt) (Lib.sass_option_set_include_path ptr) - withOptionalCString (sassSourceMapFile opt) + withOptionalUTF8CString (sassSourceMapFile opt) (Lib.sass_option_set_source_map_file ptr) - withOptionalCString (sassSourceMapRoot opt) + withOptionalUTF8CString (sassSourceMapRoot opt) (Lib.sass_option_set_source_map_root ptr) maybe (return ()) (makeNativeImporterList . fmap fromHeader diff --git a/Text/Sass/Utils.hs b/Text/Sass/Utils.hs --- a/Text/Sass/Utils.hs +++ b/Text/Sass/Utils.hs @@ -4,7 +4,7 @@ module Text.Sass.Utils ( -- * Interoperation with C API - withOptionalCString + withOptionalUTF8CString , listEntryNotNull , loopCList , copyToCList @@ -23,6 +23,8 @@ import Foreign.C import System.FilePath (searchPathSeparator) +import Text.Sass.Marshal.Internal + -- Fix for transformers-0.3.0.0 (used by lts-2.17 in stack). #if !MIN_VERSION_transformers(0,4,0) modify' :: (Monad m) => (s -> s) -> StateT s m () @@ -33,9 +35,9 @@ -- | '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 () +withOptionalUTF8CString :: Maybe String -> (CString -> IO ()) -> IO () +withOptionalUTF8CString (Just str) action = withUTF8CString str action +withOptionalUTF8CString Nothing _ = return () -- | Checks if the pointer in state points to non-null location. listEntryNotNull :: (Monad m, MonadIO m) => StateT (Ptr (Ptr a)) m Bool diff --git a/Text/Sass/Values/Internal.hs b/Text/Sass/Values/Internal.hs --- a/Text/Sass/Values/Internal.hs +++ b/Text/Sass/Values/Internal.hs @@ -9,30 +9,30 @@ , makeValueForeignPtr ) where -import qualified Bindings.Libsass as Lib +import qualified Bindings.Libsass as Lib #if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) +import Control.Applicative ((<$>)) #endif -import Control.Monad (forM, (>=>)) +import Control.Monad (forM, (>=>)) import Foreign -import Foreign.C +import Text.Sass.Marshal.Internal 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 $ +toNativeValue (SassNumber val unit) = withUTF8CString 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 (SassString str) = withUTF8CString 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 (SassWarning str) = withUTF8CString str Lib.sass_make_warning +toNativeValue (SassError str) = withUTF8CString str Lib.sass_make_error toNativeValue (SassList lst sep') = copyToCList (\size -> Lib.sass_make_list size sep False) toNativeValue Lib.sass_list_set_value lst @@ -60,7 +60,7 @@ 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 + unit <- Lib.sass_number_get_unit ptr >>= peekUTF8CString return $ SassNumber (realToFrac val) unit fromNativeValue' Lib.SassColor ptr = do r <- realToFrac <$> Lib.sass_color_get_r ptr @@ -69,12 +69,12 @@ 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) + SassString <$> (Lib.sass_string_get_value ptr >>= peekUTF8CString) fromNativeValue' Lib.SassNull _ = return SassNull fromNativeValue' Lib.SassWarning ptr = - SassWarning <$> (Lib.sass_warning_get_message ptr >>= peekCString) + SassWarning <$> (Lib.sass_warning_get_message ptr >>= peekUTF8CString) fromNativeValue' Lib.SassError ptr = - SassError <$> (Lib.sass_error_get_message ptr >>= peekCString) + SassError <$> (Lib.sass_error_get_message ptr >>= peekUTF8CString) fromNativeValue' Lib.SassList ptr = do len <- Lib.sass_list_get_length ptr sep <- fromIntegral <$> Lib.sass_list_get_separator ptr diff --git a/hsass.cabal b/hsass.cabal --- a/hsass.cabal +++ b/hsass.cabal @@ -1,5 +1,5 @@ name: hsass -version: 0.6.0 +version: 0.7.0 license: MIT license-file: LICENSE author: Jakub Fijałkowski @@ -41,8 +41,8 @@ , Text.Sass.Options , Text.Sass.Values , Text.Sass.Internal - , Text.Sass.Compilation.Internal , Text.Sass.Functions.Internal + , Text.Sass.Marshal.Internal , Text.Sass.Options.Internal , Text.Sass.Values.Internal , Text.Sass.Values.Utils @@ -69,6 +69,7 @@ , Text.Sass.TestingUtils , Text.Sass.TutorialSpec , Text.Sass.ValuesSpec + , Text.Sass.EncodingSpec type: exitcode-stdio-1.0 ghc-options: -Wall build-depends: @@ -77,6 +78,7 @@ , hspec >= 2.1.5 , hspec-discover >= 2.1.5 , temporary >= 1.1 + , text >= 1.2 , hsass , data-default-class default-language: Haskell2010 diff --git a/test/Text/Sass/EncodingSpec.hs b/test/Text/Sass/EncodingSpec.hs new file mode 100644 --- /dev/null +++ b/test/Text/Sass/EncodingSpec.hs @@ -0,0 +1,136 @@ +module Text.Sass.EncodingSpec where + +import Control.Concurrent.MVar +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import GHC.IO.Encoding (setFileSystemEncoding, utf8) +import System.IO +import System.IO.Temp +import Test.Hspec +import Text.Sass +import qualified Text.Sass.Values.Internal as VI + +opts :: SassOptions +opts = def { sassStripEncodingInfo = True } + +testString :: String +testString = "Zażółcić gęślą jaźń" + +testInput :: String +testInput = "a { content: '" ++ testString ++ "'; }" + +expectedResult :: Either a String +expectedResult = Right $ "a {\n content: '" ++ testString ++ "'; }\n" + +main :: IO () +main = hspec spec + +testValue :: SassValue -> Expectation +testValue v = + (VI.toNativeValue v >>= VI.fromNativeValue) `shouldReturn` v + +storeFunc :: MVar String -> SassValue -> IO SassValue +storeFunc m (SassList [SassString s] _) = do + putMVar m s + return $ SassString s +storeFunc _ _ = fail "Unknown value" + +storeFuncSig :: MVar String -> SassFunction +storeFuncSig = SassFunction "store($s)" . storeFunc + +returnFunc :: SassValue -> IO SassValue +returnFunc _ = return $ SassString $ "'" ++ testString ++ "'" + +returnFuncSig :: SassFunction +returnFuncSig = SassFunction "ret()" returnFunc + +nonUTFNameSig :: SassFunction +nonUTFNameSig = SassFunction "zażółcić()" returnFunc + +importFunction :: FilePath -> String -> String -> IO [SassImport] +importFunction _ "src" _ = return [makeSourceImport testInput] +importFunction p "path" _ = return [makePathImport p "."] +importFunction _ _ _ = fail "Unknown import" + +importers :: FilePath -> [SassImporter] +importers p = [SassImporter 1 $ importFunction p] + +withNonASCIIContentFile :: (String -> IO a) -> IO a +withNonASCIIContentFile f = + withSystemTempFile "styles.scss" $ \p h -> do + BS.hPutStr h (TE.encodeUtf8 $ T.pack testInput) + hClose h + f p + +withNonASCIIPathFile :: (String -> IO a) -> IO a +withNonASCIIPathFile f = do + setFileSystemEncoding utf8 + res <- withSystemTempFile "pl-zażółcić.scss" $ \p h -> do + BS.hPutStr h (TE.encodeUtf8 $ T.pack testInput) + hClose h + f p + return res + +spec :: Spec +spec = do + it "should preserve UTF-8 encoding when compiling Strings" $ + compileString testInput opts `shouldReturn` expectedResult + + it "should preserve UTF-8 encoding when compiling files" $ + withNonASCIIContentFile $ \p -> + compileFile p opts `shouldReturn` expectedResult + + it "should correctly encode UTF-8 chars in source paths" $ + withNonASCIIPathFile $ \p -> + compileFile p opts `shouldReturn` expectedResult + + it "should correctly encode UTF-8 chars in included files path" $ + withNonASCIIPathFile $ \p -> + withSystemTempFile "styles.scss" $ \impP impH -> do + let cnt = "@import \"" ++ p ++ "\";" + BS.hPutStr impH $ TE.encodeUtf8 $ T.pack cnt + hClose impH + + Right res <- compileFile impP opts :: ExtendedResult + includes <- resultIncludes res + includes `shouldSatisfy` elem p + + it "should correctly encode/decode UTF-8 SassStrings" $ + testValue $ SassString testString + + it "should correctly encode/decode UTF-8 units in SassNumbers" $ + testValue $ SassNumber 1 testString + + it "should correctly encode/decode UTF-8 SassWarnings" $ + testValue $ SassWarning testString + + it "should correctly encode/decode UTF-8 SassErrors" $ + testValue $ SassError testString + + it "should correctly encode/decode list of UTF-8 SassStrings" $ + testValue $ SassList [SassString "Zażółcić", SassString "gęślą"] SassSeparatorComma + + it "should correctly UTF-8 decode function arguments" $ do + arg <- newEmptyMVar + let fopts = opts { sassFunctions = Just [ storeFuncSig arg ] } + _ <- compileString ("a {foo: store('" ++ testString ++ "');}") fopts :: StringResult + tryTakeMVar arg `shouldReturn` Just testString + + it "should correctly UTF-8 encode function return value" $ do + let fopts = opts { sassFunctions = Just [ returnFuncSig ] } + compileString "a {content: ret(); }" fopts `shouldReturn` expectedResult + + it "should correctly UTF-8 encode function names" $ do + let fopts = opts { sassFunctions = Just [ nonUTFNameSig ] } + compileString "a {content: zażółcić(); }" fopts + `shouldReturn` expectedResult + + it "should correctly encode UTF-8 string from importer" $ + let iopts = opts { sassImporters = Just $ importers "" } + in compileString "@import 'src';" iopts `shouldReturn` expectedResult + + it "should correctly encode UTF-8 path from importer" $ + withNonASCIIPathFile $ \p -> + let iopts = opts { sassImporters = Just $ importers p } + in compileString "@import 'path';" iopts `shouldReturn` expectedResult