language-c-inline (empty) → 0.3.0.0
raw patch · 22 files changed
+1277/−0 lines, 22 filesdep +arraydep +basedep +filepathsetup-changedbinary-added
Dependencies added: array, base, filepath, language-c-inline, language-c-quote, mainland-pretty, template-haskell
Files
- LICENSE +23/−0
- Language/C/Inline/Error.hs +71/−0
- Language/C/Inline/ObjC.hs +320/−0
- Language/C/Inline/ObjC/Marshal.hs +194/−0
- Language/C/Inline/State.hs +105/−0
- README.md +24/−0
- Setup.hs +2/−0
- language-c-inline.cabal +86/−0
- tests/objc/app/App.hs +20/−0
- tests/objc/app/AppDelegate.hs +128/−0
- tests/objc/app/HSApp.app/Contents/Info.plist +50/−0
- tests/objc/app/HSApp.app/Contents/MacOS/.gitkeep +0/−0
- tests/objc/app/HSApp.app/Contents/Resources/en.lproj/Credits.rtf +12/−0
- tests/objc/app/HSApp.app/Contents/Resources/en.lproj/InfoPlist.strings binary
- tests/objc/app/HSApp.app/Contents/Resources/en.lproj/MainMenu.nib binary
- tests/objc/app/Interpreter.hs +138/−0
- tests/objc/app/Main.hs +14/−0
- tests/objc/app/Makefile +32/−0
- tests/objc/app/Readme.md +5/−0
- tests/objc/concept/MainInlineObjC.hs +8/−0
- tests/objc/concept/Makefile +23/−0
- tests/objc/concept/TestInlineObjC.hs +22/−0
+ LICENSE view
@@ -0,0 +1,23 @@+Copyright (c) [2013] Manuel M T Chakravarty. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * 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.+ * Neither the names of the contributors nor of their affiliations 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 ''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 COPYRIGHT HOLDERS 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.
+ Language/C/Inline/Error.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++-- |+-- Module : Language.C.Inline.Error+-- Copyright : [2013] Manuel M T Chakravarty+-- License : BSD3+--+-- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- This module provides support for error reporting.++module Language.C.Inline.Error (+ -- * Error reporting+ reportErrorAndFail,++ -- * Exception handling+ tryWithPlaceholder,++ -- * Pretty printing for error messages+ prettyQC+) where++import Language.Haskell.TH as TH+import Language.Haskell.TH.Syntax as TH++ -- quasi-quotation libraries+import Language.C.Quote as QC+import Language.C.Quote.ObjC as QC+import Text.PrettyPrint.Mainland as QC+++reportErrorAndFail :: QC.Extensions -> String -> Q a+reportErrorAndFail lang msg+ = do+ { reportError' lang msg+ ; fail "Failure"+ }++-- reportErrorAndBail :: String -> Q TH.Exp+-- reportErrorAndBail msg+-- = do+-- { reportError msg+-- ; Just undefinedName <- TH.lookupValueName "Prelude.undefined"+-- ; return $ VarE undefinedName+-- }++reportError' :: QC.Extensions -> String -> Q ()+reportError' lang msg+ = do+ { loc <- location+ -- FIXME: define a Show instance for 'Loc' and use it to prefix position to error+ ; TH.reportError $ "Inline " ++ showLang lang ++ ": " ++ msg+ }+ where+ showLang QC.Antiquotation = "C"+ showLang QC.Gcc = "GCC C"+ showLang QC.CUDA = "CUDA C"+ showLang QC.OpenCL = "OpenCL"+ showLang QC.ObjC = "Objective-C"++-- If the tried computation fails, insert a placeholder expression.+--+-- We report all errors explicitly. Failing would just duplicate errors.+--+tryWithPlaceholder :: Q TH.Exp -> Q TH.Exp+tryWithPlaceholder = ([| error "language-c-quote: internal error: tryWithPlaceholder" |] `recover`)++prettyQC :: QC.Pretty a => a -> String+prettyQC = QC.pretty 80 . QC.ppr
+ Language/C/Inline/ObjC.hs view
@@ -0,0 +1,320 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++-- |+-- Module : Language.C.Inline.ObjC+-- Copyright : [2013] Manuel M T Chakravarty+-- License : BSD3+--+-- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- This module exports the principal API for inline Objective-C.++module Language.C.Inline.ObjC (+ objc_import, objc_interface, objc_implementation, objc, objc_emit+) where++ -- common libraries+import Control.Applicative+import Control.Monad+import Data.Array+import Data.Dynamic+import Data.IORef+import Data.List+import Foreign.C as C+import Foreign.C.String as C+import Foreign.Marshal as C+import Language.Haskell.TH as TH+import Language.Haskell.TH.Syntax as TH+import System.FilePath+import System.IO.Unsafe (unsafePerformIO)++ -- quasi-quotation libraries+import Language.C.Quote as QC+import Language.C.Quote.ObjC as QC+import Text.PrettyPrint.Mainland as QC++ -- friends+import Language.C.Inline.Error+import Language.C.Inline.State+import Language.C.Inline.ObjC.Marshal+++-- |Specify imported Objective-C files. Needs to be spliced where an import declaration can appear. (Just put it+-- straight after all the import statements in the module.)+--+-- FIXME: need to use TH.addDependentFile on each of the imported ObjC files & read headers+--+objc_import :: [FilePath] -> Q [TH.Dec]+objc_import headers+ = do+ { mapM_ stashHeader headers+ ; objc_jumptable <- newName "objc_jumptable"+ ; setForeignTable $ varE objc_jumptable+ ; sequence $ [ sigD objc_jumptable [t|IORef (Array Int Dynamic)|]+ , pragInlD objc_jumptable NoInline FunLike AllPhases -- reqs template-haskell 2.8.0.0+ -- , pragInlD objc_jumptable (inlineSpecNoPhase False False)+ , valD (varP objc_jumptable) (normalB [|unsafePerformIO $ newIORef (array (0, 0) [])|]) []+ ]+ -- ; return $ [d|import Language.C.Quote as ObjC;+ -- import Language.C.Quote.ObjC as ObjC;+ -- import Foreign.C as C+ -- |]+ }+ -- FIXME: Should this also add the Language.C.Quote imports? (We might not need to generate any imports at all?!?)++-- |Inline Objective-C top-level definitions for a header file ('.h').+--+objc_interface :: [QC.Definition] -> Q [TH.Dec]+objc_interface defs+ = do+ { stashObjC_h defs+ ; return []+ }++-- |Inline Objective-C top-level definitions for an implementation file ('.m').+--+-- The top-level Haskell variables given in the first argument will be foreign exported to be accessed from the+-- generated Objective-C code. In C, these Haskell variables will always be represented as functions. (In particular, if+-- the Haskell variable refers to a CAF, it will be a nullary function in C — after all, a thunk may still need to be+-- evaluated.)+--+objc_implementation :: [TH.Name] -> [QC.Definition] -> Q [TH.Dec]+objc_implementation vars defs+ = do+ { mapM_ exportVar vars+ ; stashObjC_m defs+ ; return []+ }+ where+ exportVar var+ = do+ { -- Determine the argument and result types of the exported Haskell function+ ; (argTys, inIO, resTy) <- splitHaskellType <$> determineVarType var++ -- Determine C types+ ; cArgTys <- mapM (haskellTypeToCType ObjC) argTys+ ; cResTy <- haskellTypeToCType ObjC resTy++ -- Determine the bridging type and the marshalling code+ ; (bridgeArgTys, cBridgeArgTys, hsArgMarshallers, cArgMarshallers) <-+ unzip4 <$> zipWithM generateCToHaskellMarshaller argTys cArgTys+ ; (bridgeResTy, cBridgeResTy, hsResMarshaller, cResMarshaller) <- generateHaskellToCMarshaller resTy cResTy++ -- Haskell type of the foreign wrapper function+ ; let hsWrapperTy = haskellWrapperType bridgeArgTys bridgeResTy++ -- Generate the Haskell wrapper+ ; let cwrapperName = mkName . nameBase $ var+ ; hswrapperName <- newName (nameBase var ++ "_hswrapper")+ ; hsArgVars <- mapM (const $ newName "arg") bridgeArgTys+ ; stashHS+ [ forExpD CCall (show hswrapperName) hswrapperName hsWrapperTy+ , sigD hswrapperName hsWrapperTy+ , funD hswrapperName+ [ clause (map varP hsArgVars)+ (normalB $ generateHSCall hsArgVars hsArgMarshallers (varE var) hsResMarshaller inIO)+ []+ ]+ ]++ -- Generate the C wrapper code (both prototype and definition)+ ; cArgVars <- mapM (\n -> newName $ "arg" ++ show n) [1..length cBridgeArgTys]+ ; let cArgVarExps = [ [cexp| $id:(nameBase var) |] | var <- cArgVars]+ call = [cexp| $id:(show hswrapperName) ( $args:cArgVarExps ) |]+ (_wrapperProto, wrapperDef)+ = generateCWrapper cwrapperName cBridgeArgTys cArgVars cArgMarshallers cArgTys cArgVars+ call+ resTy cBridgeResTy cResMarshaller cResTy+ ; stashObjC_m $+ -- C prototype of the foreign exported Haskell-side wrapper+ [cunit|+ $ty:cBridgeResTy $id:(show hswrapperName) ($params:(cParams cBridgeArgTys cArgVars));+ |]+ +++ wrapperDef+ }++ splitHaskellType (ArrowT `AppT` arg `AppT` res)+ = let (args, inIO, res') = splitHaskellType res+ in+ (arg:args, inIO, res')+ splitHaskellType (ConT io `AppT` res) | io == ''IO+ = ([], True, res)+ splitHaskellType res+ = ([], False, res)++forExpD :: Callconv -> String -> Name -> TypeQ -> DecQ+forExpD cc str n ty+ = do+ { ty' <- ty+ ; return $ ForeignD (ExportF cc str n ty')+ }++-- |Inline Objective-C expression.+--+-- The inline expression will be wrapped in a C function whose arguments are marshalled versions of the Haskell+-- variables given in the first argument and whose return value will be marshalled to the Haskell type given by the+-- second argument.+--+objc :: [TH.Name] -> TH.Name -> QC.Exp -> Q TH.Exp+objc vars resTy e+ = {- tryWithPlaceholder $ -} do -- FIXME: catching the 'fail' purges all reported errors :(+ { -- Sanity check of arguments+ ; varTys <- mapM determineVarType vars+ ; checkTypeName resTy++ -- Determine C types+ ; cArgTys <- mapM (haskellTypeToCType ObjC) varTys+ ; cResTy <- haskellTypeNameToCType ObjC resTy++ -- Determine the bridging type and the marshalling code+ ; (bridgeArgTys, cBridgeArgTys, hsArgMarshallers, cArgMarshallers) <-+ unzip4 <$> zipWithM generateHaskellToCMarshaller varTys cArgTys+ ; (bridgeResTy, cBridgeResTy, hsResMarshaller, cResMarshaller) <-+ generateCToHaskellMarshaller (ConT resTy) cResTy++ -- Haskell type of the foreign wrapper function+ ; let hsWrapperTy = haskellWrapperType bridgeArgTys bridgeResTy++ -- FFI setup for the C wrapper+ ; cwrapperName <- newName "cwrapper"+ ; stashHS+ [ forImpD CCall Safe (show cwrapperName) cwrapperName hsWrapperTy+ ]+ ; idx <- extendJumpTable cwrapperName++ -- Generate the C wrapper code (both prototype and definition)+ ; cArgVars <- mapM (newName . nameBase) vars+ ; let (wrapperProto, wrapperDef)+ = generateCWrapper cwrapperName cArgTys vars cArgMarshallers cBridgeArgTys cArgVars+ e+ (ConT resTy) cResTy cResMarshaller cBridgeResTy+ ; stashObjC_h wrapperProto+ ; stashObjC_m wrapperDef++ -- Generate invocation of the C wrapper sandwiched into Haskell-side marshalling+ ; generateHSCall vars hsArgMarshallers (callThroughTable idx hsWrapperTy) hsResMarshaller True+ }+ where+ callThroughTable idx ty+ = do { jumptable <- getForeignTable+ ; [|fromDyn+ ((unsafePerformIO $ readIORef $jumptable) ! $(TH.lift idx))+ (error "InlineObjC: INTERNAL ERROR: type mismatch in jumptable")+ :: $ty |]+ }++-- Turn a list of argument types and a result type into a Haskell wrapper signature.+--+-- > haskellWrapperType [a1, .., an] r = [| a1 -> .. -> an -> IO r |]+--+haskellWrapperType :: [TH.TypeQ] -> TH.TypeQ -> TH.TypeQ+haskellWrapperType [] resTy = [t| IO $resTy |]+haskellWrapperType (argTy:argTys) resTy = [t| $argTy -> $(haskellWrapperType argTys resTy) |]++-- Generate the prototype of and function definition of a C marshalling wrapper.+--+-- Given a C expression to be executed, this generator produces a C function that executes the expression with all+-- arguments and the result marshalled using the provided marshallers.+--+generateCWrapper :: TH.Name+ -> [QC.Type]+ -> [TH.Name] -- name of arguments after marshalling (will be the original name without unique)+ -> [CMarshaller]+ -> [QC.Type]+ -> [TH.Name]+ -> QC.Exp -- C expression containing occurences of the arguments (using names without uniques)+ -> TH.Type+ -> QC.Type+ -> CMarshaller+ -> QC.Type+ -> ([QC.Definition], [QC.Definition])+generateCWrapper cwrapperName argTys vars argMarshallers cWrapperArgTys argVars e hsResTy resTy resMarshaller cWrapperResTy+ = let cMarshalling = [ [citem| $ty:argTy $id:(nameBase var) = $exp:(argMarshaller argVar); |]+ | (argTy, var, argMarshaller, argVar) <- zip4 argTys vars argMarshallers argVars]+ resultName = mkName "result"+ cInvocation | hsResTy == (ConT ''()) = [citem| $exp:e; |] -- void result+ | otherwise = [citem| {+ $ty:resTy $id:(show resultName) = $exp:e; // non-void result...+ return $exp:(resMarshaller resultName); // ...marshalled to Haskell+ }|]+ in+ ([cunit|+ $ty:cWrapperResTy $id:(show cwrapperName) ($params:(cParams cWrapperArgTys argVars));+ |],+ [cunit|+ $ty:cWrapperResTy $id:(show cwrapperName) ($params:(cParams cWrapperArgTys argVars))+ {+ $items:cMarshalling+ $item:cInvocation+ }+ |])++-- cParams [a1, .., an] [v1, .., vn] = [[cparam| a1 v1 |], .., [cparam| an vn |]]+--+cParams :: [QC.Type] -> [TH.Name] -> [QC.Param]+cParams [] [] = []+cParams (argTy:argTys) (var:vars) = [cparam| $ty:argTy $id:(show var) |] : cParams argTys vars++-- Produce a Haskell expression that calls a function with all arguments and the result marshalled with the supplied+-- marshallers.+--+generateHSCall :: [TH.Name]+ -> [HaskellMarshaller]+ -> TH.ExpQ+ -> HaskellMarshaller+ -> Bool+ -> TH.ExpQ+generateHSCall vars hsArgMarshallers f hsResMarshaller inIO+ = invoke [hsArgMarshaller (varE var) | (var, hsArgMarshaller) <- zip vars hsArgMarshallers]+ f+ (if inIO then [| \call -> do { cresult <- call ; $(hsResMarshaller [|cresult|] [|return|]) } |]+ else [| \call -> do { let {cresult = call}; $(hsResMarshaller [|cresult|] [|return|]) } |])+ where+ -- invoke [v1, .., vn] [a1, .., an] call r = [| a1 (\v1 -> .. -> an (\vn -> r (call v1 .. vn))..) |]+ invoke :: [TH.ExpQ -> TH.ExpQ] -> TH.ExpQ -> TH.ExpQ -> TH.ExpQ+ invoke [] call ret = [| $ret $call |]+ invoke (arg:args) call ret = arg [| \name -> $(invoke args [| $call name |] ret)|]++-- |Emit the Objective-C file and return the foreign declarations. Needs to be the last use of an 'objc...' function.+-- (Just put it at the end of the Haskell module.)+--+objc_emit :: Q [TH.Dec]+objc_emit+ = do+ { loc <- location+ ; let origFname = loc_filename loc+ objcFname = dropExtension origFname ++ "_objc"+ objcFname_h = objcFname `addExtension` "h"+ objcFname_m = objcFname `addExtension` "m"+ ; headers <- getHeaders+ ; (objc_h, objc_m) <- getHoistedObjC+ ; runIO $+ do+ { writeFile objcFname_h (info origFname)+ ; appendFile objcFname_h (unlines (map mkImport headers) ++ "\n")+ ; appendFile objcFname_h (show $ QC.ppr objc_h)+ ; writeFile objcFname_m (info origFname)+ ; appendFile objcFname_m ("#import \"" ++ objcFname_h ++ "\"\n\n")+ ; appendFile objcFname_m (show $ QC.ppr objc_m)+ }+ ; objc_jumptable <- getForeignTable+ ; labels <- getForeignLabels+ ; initialize <- [d|objc_initialise :: IO ()+ objc_initialise+ = -- unsafePerformIO $+ writeIORef $objc_jumptable $+ listArray ($(lift (1::Int)), $(lift $ length labels)) $+ $(listE [ [|toDyn $(varE label)|] | label <- labels])+ |]+ ; (initialize ++) <$> getHoistedHS+ }+ where+ mkImport h@('<':_) = "#import " ++ h ++ ""+ mkImport h = "#import \"" ++ h ++ "\""++ info fname = "// Generated code: DO NOT EDIT\n\+ \// generated from '" ++ fname ++ "'\n\+ \// by package 'language-c-inline'\n\n"
+ Language/C/Inline/ObjC/Marshal.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++-- |+-- Module : Language.C.Inline.ObjC.Marshal+-- Copyright : [2013] Manuel M T Chakravarty+-- License : BSD3+--+-- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- Objective-C-specific marshalling functions.+--+-- FIXME: Some of the code can go into a module for general marshalling, as only some of it is ObjC-specific.++module Language.C.Inline.ObjC.Marshal (+ -- * Auxilliary functions+ determineVarType, checkTypeName,+ + -- * Determine corresponding foreign types of Haskell types+ haskellTypeToCType, haskellTypeNameToCType,+ + -- * Marshaller types+ HaskellMarshaller, CMarshaller,+ + -- * Compute bridging types and marshallers+ generateHaskellToCMarshaller, generateCToHaskellMarshaller+) where++ -- common libraries+import Foreign.C as C+import Foreign.C.String as C+import Foreign.Marshal as C+import Foreign.StablePtr as C+import Language.Haskell.TH as TH+import Language.Haskell.TH.Syntax as TH++ -- quasi-quotation libraries+import Language.C.Quote as QC+import Language.C.Quote.ObjC as QC+import Text.PrettyPrint.Mainland as QC++ -- friends+import Language.C.Inline.Error+++-- Auxilliary functions+-- --------------------++-- Check that the given TH name is that of a Haskell variable and determine its type.+--+determineVarType :: TH.Name -> Q TH.Type+determineVarType vname+ = do+ { vinfo <- reify vname+ ; case vinfo of+ VarI _ ty _ _ -> return ty+ nonVarInfo -> + do+ { reportErrorAndFail QC.ObjC $ + "expected '" ++ show vname ++ "' to be a variable name, but it is " ++ + show (TH.ppr nonVarInfo)+ }+ }++-- Check that the given TH name is that of a Haskell type constructor.+--+checkTypeName :: TH.Name -> Q ()+checkTypeName tyname+ = do+ { tyinfo <- reify tyname+ ; case tyinfo of+ TyConI (DataD {}) -> return ()+ TyConI (NewtypeD {}) -> return ()+ TyConI (TySynD {}) -> return ()+ nonTyInfo -> + do+ { reportErrorAndFail QC.ObjC $ + "expected '" ++ show tyname ++ "' to be a type name, but it is " ++ + show (TH.ppr nonTyInfo)+ }+ }+++-- Determine foreign types+-- -----------------------++-- Determine the C type that we map a given Haskell type to.+--+haskellTypeToCType :: QC.Extensions -> TH.Type -> Q QC.Type+haskellTypeToCType lang (ListT `AppT` (ConT char))+ | char == ''Char + = haskellTypeNameToCType lang ''String+haskellTypeToCType lang (ConT tc)+ = haskellTypeNameToCType lang tc+haskellTypeToCType _lang ty+ = return [cty| typename HsStablePtr |]++-- Determine the C type that we map a given Haskell type constructor to — i.e., we map all Haskell+-- whose outermost constructor is the given type constructor to the returned C type..+--+haskellTypeNameToCType :: QC.Extensions -> TH.Name -> Q QC.Type+haskellTypeNameToCType ObjC tyname+ | tyname == ''String = return [cty| typename NSString * |]+ | tyname == ''() = return [cty| void |]+haskellTypeNameToCType _lang tyname+ = return [cty| typename HsStablePtr |]+++-- Determine marshallers and their bridging types+-- ----------------------------------------------++-- Constructs Haskell code to marshal a value (used to marshal arguments and results).+--+-- * The first argument is the code referring to the value to be marshalled.+-- * The second argument is the continuation that gets the marshalled value as an argument.+--+type HaskellMarshaller = TH.ExpQ -> TH.ExpQ -> TH.ExpQ++-- Constructs C code to marshal an argument (used to marshal arguments and results).+--+-- * The argument is the identifier of the value to be marshalled.+-- * The result of the generated expression is the marshalled value.+--+type CMarshaller = TH.Name -> QC.Exp++-- Generate the type-specific marshalling code for Haskell to C land marshalling for a Haskell-C type pair.+--+-- The result has the following components:+--+-- * Haskell type after Haskell-side marshalling.+-- * C type before C-side marshalling.+-- * Generator for the Haskell-side marshalling code.+-- * Generator for the C-side marshalling code.+--+generateHaskellToCMarshaller :: TH.Type -> QC.Type -> Q (TH.TypeQ, QC.Type, HaskellMarshaller, CMarshaller)+generateHaskellToCMarshaller hsTy cTy+ | cTy == [cty| typename NSString * |] + = return ( [t| C.CString |]+ , [cty| char * |]+ , \val cont -> [| C.withCString $val $cont |]+ , \argName -> [cexp| [NSString stringWithUTF8String: $id:(show argName)] |]+ )+ | cTy == [cty| typename HsStablePtr |] + = return ( [t| C.StablePtr $(return hsTy) |]+ , cTy+ , \val cont -> [| do { C.newStablePtr $val >>= $cont } |]+ , \argName -> [cexp| $id:(show argName) |]+ )+ | otherwise+ = reportErrorAndFail ObjC $ "cannot marshal '" ++ TH.pprint hsTy ++ "' to '" ++ prettyQC cTy ++ "'"++-- Generate the type-specific marshalling code for Haskell to C land marshalling for a C-Haskell type pair.+--+-- The result has the following components:+--+-- * Haskell type after Haskell-side marshalling.+-- * C type before C-side marshalling.+-- * Generator for the Haskell-side marshalling code.+-- * Generator for the C-side marshalling code.+--+generateCToHaskellMarshaller :: TH.Type -> QC.Type -> Q (TH.TypeQ, QC.Type, HaskellMarshaller, CMarshaller)+generateCToHaskellMarshaller hsTy cTy+ | cTy == [cty| typename NSString * |]+ = return ( [t| C.CString |]+ , [cty| char * |]+ , \val cont -> [| do { str <- C.peekCString $val; C.free $val; $cont str } |]+ , \argName -> + let arg = show argName + in+ [cexp|+ ({ typename NSUInteger maxLen = [$id:arg maximumLengthOfBytesUsingEncoding:NSUTF8StringEncoding] + 1;+ char *buffer = malloc (maxLen);+ if (![$id:arg getCString:buffer maxLength:maxLen encoding:NSUTF8StringEncoding])+ *buffer = '\0';+ buffer;+ })+ |]+ )+ | cTy == [cty| typename HsStablePtr |] + = return ( [t| C.StablePtr $(return hsTy) |]+ , cTy+ , \val cont -> [| do { C.deRefStablePtr $val >>= $cont } |]+ , \argName -> [cexp| $id:(show argName) |]+ )+ | cTy == [cty| void |]+ = return ( [t| () |]+ , [cty| void |]+ , \val cont -> [| $cont $val |]+ , \argName -> [cexp| $id:(show argName) |]+ )+ | otherwise+ = reportErrorAndFail ObjC $ "cannot marshall '" ++ prettyQC cTy ++ "' to '" ++ TH.pprint hsTy ++ "'" +
+ Language/C/Inline/State.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++-- |+-- Module : Language.C.Inline.State+-- Copyright : [2013] Manuel M T Chakravarty+-- License : BSD3+--+-- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- This module manages the state accumulated during the compilation of one module.++module Language.C.Inline.State (+ -- * Abstract application state+ State,+ + -- * State query and update operations+ setForeignTable, stashHeader, stashObjC_h, stashObjC_m, stashHS, + extendJumpTable,+ getForeignTable, getForeignLabels, getHeaders, getHoistedObjC, getHoistedHS+) where++ -- common libraries+import Control.Applicative+import Data.IORef+import Foreign.C as C+import Language.Haskell.TH as TH+import Language.Haskell.TH.Syntax as TH+import System.IO.Unsafe (unsafePerformIO)++ -- quasi-quotation libraries+import Language.C.Quote as QC+++data State + = State+ { foreignTable :: Q TH.Exp -- table of foreign labels+ , foreignLabels :: [Name] -- list of foreign imported names to populate 'foreignTable'+ , headers :: [String] -- imported Objective-C headers+ , hoistedObjC_h :: [QC.Definition] -- Objective-C that goes into the .h+ , hoistedObjC_m :: [QC.Definition] -- Objective-C that goes into the .m+ , hoistedHS :: [TH.Dec] -- Haskell that goes at the end of the module+ }++state :: IORef State+{-# NOINLINE state #-}+state = unsafePerformIO $ + newIORef $ + State+ { foreignTable = error "InlineObjC: internal error: 'foreignTable' undefined"+ , foreignLabels = []+ , headers = []+ , hoistedObjC_h = []+ , hoistedObjC_m = []+ , hoistedHS = []+ }++readState :: (State -> a) -> Q a+readState read = runIO $ read <$> readIORef state++modifyState :: (State -> State) -> Q ()+modifyState modify = runIO $ modifyIORef state modify+ -- atomic???++setForeignTable :: Q TH.Exp -> Q ()+setForeignTable e = modifyState (\s -> s {foreignTable = e})++stashHeader :: String -> Q ()+stashHeader header = modifyState (\s -> s {headers = header : headers s})++stashObjC_h :: [QC.Definition] -> Q ()+stashObjC_h defs = modifyState (\s -> s {hoistedObjC_h = hoistedObjC_h s ++ defs})++stashObjC_m :: [QC.Definition] -> Q ()+stashObjC_m defs = modifyState (\s -> s {hoistedObjC_m = hoistedObjC_m s ++ defs})++stashHS :: [TH.DecQ] -> Q ()+stashHS decQs+ = do+ { decs <- sequence decQs+ ; modifyState (\s -> s {hoistedHS = hoistedHS s ++ decs})+ }++extendJumpTable :: Name -> Q Int+extendJumpTable foreignName+ = do+ { modifyState (\s -> s {foreignLabels = foreignLabels s ++ [foreignName]}) -- FIXME: *urgh*+ ; length <$> readState foreignLabels+ }++getForeignTable :: Q (Q TH.Exp)+getForeignTable = readState foreignTable++getForeignLabels :: Q [Name]+getForeignLabels = readState foreignLabels++getHeaders :: Q [String]+getHeaders = reverse <$> readState headers++getHoistedObjC :: Q ([QC.Definition], [QC.Definition])+getHoistedObjC = (,) <$> readState hoistedObjC_h <*> readState hoistedObjC_m++getHoistedHS :: Q [TH.Dec]+getHoistedHS = readState hoistedHS
+ README.md view
@@ -0,0 +1,24 @@+Inline C & Objective-C in Haskell+=====================================++This library uses Template Haskell and `language-c-quote`, a quasi-quotation library for C-like languages, to provide inline C and Objective-C in Haskell. It extracts the C/Objective-C code automatically, when compiling the Haskell program, and generates marshalling code for common types. The wiki on GitHub details the [motivation](https://github.com/mchakravarty/language-c-inline/wiki/Motivation) for this approach.++Building+--------++To build the library, just use `cabal install` as usual. To build the proof of concept example, do the following++* Execute `cd tests/objc/concept; make`.+* Now run the demo executable with `./InlineObjC`.++To build the more complex Haskell interpreter app:++* Execute `cd tests/objc/app; make`.+* Now `open -a HSApp.app`.++I tested it with Haskell Platform 2013.2.0.0 (which includes GHC 7.6.3) and it requires the latest version of `language-c-quote`, which is 0.7.6.++Status+======++The library is still in its early stages. At the moment automatic marshalling support is limited to strings and boxed Haskell values represented as stable pointers in C land. However, it is quite easy to add more types, and I do welcome pull request!
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ language-c-inline.cabal view
@@ -0,0 +1,86 @@+Name: language-c-inline+Version: 0.3.0.0+Cabal-version: >= 1.9.2+Tested-with: GHC == 7.6.3+Build-type: Simple++Synopsis: Inline C & Objective-C code in Haskell for language interoperability+Description: This library provides inline C & Objective-C code using GHC's support for+ quasi-quotation. In particular, it enables the use of foreign libraries+ without a dedicated bridge or binding. Here is a tiny example:+ .+ > log :: String -> IO ()+ > log msg = $(objc 'msg [cexp| NSLog (@"Here is a message from Haskell: %@", msg) |])+ .+ For more information, see <https://github.com/mchakravarty/language-c-inline/wiki>.+ .+ Known bugs: <https://github.com/mchakravarty/language-c-inline/issues>+ .+ * New in 0.3.0.0: Boxed Haskell types without a dedicated type mapping are marshalled using stable+ pointers.+ .+ * New in 0.2.0.0: Support for multiple free variables in one inline expression as well+ as for inline code returning 'void'.+ .+ * New in 0.1.0.0: We are just getting started! This is just a ROUGH AND+ HIGHLY EXPERIMENTAL PROTOTYPE.+License: BSD3+License-file: LICENSE+Author: Manuel M T Chakravarty+Maintainer: Manuel M T Chakravarty <chak@justtesting.org>+Homepage: https://github.com/mchakravarty/language-c-inline/+Bug-reports: https://github.com/mchakravarty/language-c-inline/issues++Category: Language, Foreign+Stability: Experimental++Extra-source-files: README.md+ tests/objc/concept/Makefile+ tests/objc/app/App.hs+ tests/objc/app/AppDelegate.hs+ tests/objc/app/Interpreter.hs+ tests/objc/app/Main.hs+ tests/objc/app/Makefile+ tests/objc/app/Readme.md+ tests/objc/app/HSApp.app/Contents/Info.plist+ tests/objc/app/HSApp.app/Contents/MacOS/.gitkeep+ tests/objc/app/HSApp.app/Contents/Resources/en.lproj/Credits.rtf+ tests/objc/app/HSApp.app/Contents/Resources/en.lproj/InfoPlist.strings+ tests/objc/app/HSApp.app/Contents/Resources/en.lproj/MainMenu.nib++Source-repository head+ Type: git+ Location: git://github.com/mchakravarty/language-c-inline.git++Library+ Build-depends: array,+ base >= 4.0 && < 5,+ filepath >= 1.2,+ language-c-quote >= 0.7,+ mainland-pretty >= 0.2.5,+ template-haskell++ Exposed-modules: Language.C.Inline.ObjC++ Other-modules: Language.C.Inline.Error+ Language.C.Inline.State+ Language.C.Inline.ObjC.Marshal++ Extensions: TemplateHaskell, QuasiQuotes++-- Doesn't work!!! Use the Makefile in the tests/ instead. (How can we get cabal to compile & link the generated ObjC files?)+Test-Suite concept+ Build-depends: base >= 4.0 && < 5,+ language-c-quote,+ language-c-inline+ + Frameworks: Foundation++ Type: exitcode-stdio-1.0++ Hs-source-dirs: tests/objc/concept++ Main-is: MainInlineObjC.hs++ Other-modules: TestInlineObjC+
+ tests/objc/app/App.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++-- HSApp: a simple Cocoa app in Haskell+--+-- Main application module entering AppKit's application framework++module App (main, objc_initialise) where++import Language.C.Quote.ObjC+import Language.C.Inline.ObjC++objc_import ["<Cocoa/Cocoa.h>"]+++main :: IO ()+main = $(objc [] ''()+ [cexp| NSApplicationMain (0, NULL) |])+ -- 'NSApplicationMain' ignores its argc and argv arguments anyway++objc_emit
+ tests/objc/app/AppDelegate.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++-- HSApp: a simple Cocoa app in Haskell+--+-- Application delegate object, abused as a view controller++module AppDelegate (objc_initialise) where++ -- language-c-inline+import Language.C.Quote.ObjC+import Language.C.Inline.ObjC++ -- friends+import Interpreter++objc_import ["<Cocoa/Cocoa.h>", "HsFFI.h"]+++-- Haskell code used from Objective-C.++launchMsg :: String+launchMsg = "HSApp did finish launching!"++evalExpr :: Session -> String -> IO String+evalExpr _session ""+ = return ""+evalExpr session input@(':' : withCommand)+ = case break (== ' ') withCommand of+ ("type", expr) -> do+ { result <- typeOf session expr+ ; return $ formatResult input result+ }+ (command, _) -> return $ "Haskell> " ++ input ++ "\nUnknown command" ++ command ++ "\n"+evalExpr session expr+ = do + { result <- eval session expr+ ; return $ formatResult expr result+ }+ where++loadModule :: Session -> String -> IO String+loadModule session mname+ = do+ { result <- load session mname+ ; return $ formatResult "" result + }++formatResult :: String -> Result -> String+formatResult input result = (if null input then "" else "Haskell> " ++ input ++ "\n") ++ showResult result ++ "\n"+ where+ showResult (Result res) = res+ showResult (Error err) = "ERROR: " ++ err+++objc_interface [cunit|++@interface AppDelegate : NSResponder <NSApplicationDelegate>++// IBOutlets+@property (weak, nonatomic) typename NSWindow *window;+@property (weak, nonatomic) typename NSScrollView *scrollView;+@property (weak, nonatomic) typename NSTextField *textField;++@end+|]+++objc_implementation ['launchMsg, 'start, 'evalExpr, 'loadModule] [cunit|++@interface AppDelegate ()++// The NSTextView in the UI.+@property (nonatomic) typename NSTextView *textView;++// Reference to the interpreter session in Haskell land.+@property (assign) typename HsStablePtr interpreterSession;++- (void)appendOutput:(typename NSString *)text;++@end++@implementation AppDelegate++- (void)applicationDidFinishLaunching:(typename NSNotification *)aNotification+{+ [[self.textField cell] setPlaceholderString:@"Enter an expression, or use the :type command"];+ self.textView = self.scrollView.documentView;+ self.interpreterSession = start();+ NSLog(@"%@", launchMsg());+}++// IBAction+- (void)textFieldDidSend:(typename NSTextField *)sender+{+ [self appendOutput:evalExpr(self.interpreterSession, [sender stringValue])];+ [sender setStringValue:@""];+}++- (void)appendOutput:(typename NSString *)text+{+ typename NSFont *menlo13 = [NSFont fontWithName:@"Menlo-Regular" size:13];+ typename NSAttributedString *attrText = [[NSAttributedString alloc] initWithString:text + attributes:@{ NSFontAttributeName : menlo13 }];+ [self.textView.textStorage appendAttributedString:attrText];+ [self.textView scrollRangeToVisible:NSMakeRange([self.textView.textStorage length], 0)];+}++- (void)openDocument:(id)sender+{+ typename NSOpenPanel* panel = [NSOpenPanel openPanel];+ [panel setMessage:@"Select a Haskell module to load."];+ [panel setAllowedFileTypes:@[@"hs", @"lhs"]];+ [panel beginSheetModalForWindow:self.window completionHandler:^(typename NSInteger result){+ if (result == NSFileHandlingPanelOKButton) {++ typename NSArray* urls = [panel URLs]; + [self appendOutput:loadModule(self.interpreterSession, [[urls firstObject] path])];+ + }+ + }];+}++@end+|]+++objc_emit
+ tests/objc/app/HSApp.app/Contents/Info.plist view
@@ -0,0 +1,50 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">+<plist version="1.0">+<dict>+ <key>BuildMachineOSBuild</key>+ <string>13B3116</string>+ <key>CFBundleDevelopmentRegion</key>+ <string>en</string>+ <key>CFBundleExecutable</key>+ <string>HSApp</string>+ <key>CFBundleIdentifier</key>+ <string>org.justtesting.HSApp</string>+ <key>CFBundleInfoDictionaryVersion</key>+ <string>6.0</string>+ <key>CFBundleName</key>+ <string>HSApp</string>+ <key>CFBundlePackageType</key>+ <string>APPL</string>+ <key>CFBundleShortVersionString</key>+ <string>1.0</string>+ <key>CFBundleSignature</key>+ <string>????</string>+ <key>CFBundleVersion</key>+ <string>1</string>+ <key>DTCompiler</key>+ <string>com.apple.compilers.llvm.clang.1_0</string>+ <key>DTPlatformBuild</key>+ <string>5A3005</string>+ <key>DTPlatformVersion</key>+ <string>GM</string>+ <key>DTSDKBuild</key>+ <string>13A595</string>+ <key>DTSDKName</key>+ <string>macosx10.9</string>+ <key>DTXcode</key>+ <string>0502</string>+ <key>DTXcodeBuild</key>+ <string>5A3005</string>+ <key>LSApplicationCategoryType</key>+ <string>public.app-category.developer-tools</string>+ <key>LSMinimumSystemVersion</key>+ <string>10.8</string>+ <key>NSHumanReadableCopyright</key>+ <string>Written by Manuel M T Chakravarty.</string>+ <key>NSMainNibFile</key>+ <string>MainMenu</string>+ <key>NSPrincipalClass</key>+ <string>NSApplication</string>+</dict>+</plist>
+ tests/objc/app/HSApp.app/Contents/MacOS/.gitkeep view
+ tests/objc/app/HSApp.app/Contents/Resources/en.lproj/Credits.rtf view
@@ -0,0 +1,12 @@+{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf370+\cocoascreenfonts1{\fonttbl\f0\fswiss\fcharset0 Helvetica;}+{\colortbl;\red255\green255\blue255;}+\paperw11900\paperh16840\vieww9600\viewh8400\viewkind0+\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720++\f0\b\fs24 \cf0 Inline Objective-C in Haskell example app+\b0 \+\+It demonstrates how to use in Objective-C\+in tandem with Haskell to write Cocoa apps.\+}
+ tests/objc/app/HSApp.app/Contents/Resources/en.lproj/InfoPlist.strings view
binary file changed (absent → 92 bytes)
+ tests/objc/app/HSApp.app/Contents/Resources/en.lproj/MainMenu.nib view
binary file changed (absent → 14050 bytes)
+ tests/objc/app/Interpreter.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PackageImports #-}++-- HSApp: a simple Cocoa app in Haskell+--+-- Management of GHC interpreter sessions through the 'hint' package.+--+-- Interpreter sessions run in their own thread. They receive interpreter commands as monadic 'Interpreter' computations+-- via an inlet 'MVar'. These commands return the result of command execution via another 'MVar' specifically used only+-- for this one command.+--++module Interpreter (+ Session, Result(..),+ start, stop, eval, typeOf, load+) where++ -- standard libraries+import Prelude hiding (catch)+import Control.Applicative+import Control.Concurrent+import Control.Exception (SomeException, evaluate)+import Control.Monad+import "MonadCatchIO-mtl" + Control.Monad.CatchIO+import Control.Monad.Error++import System.IO++ -- hint+import qualified Language.Haskell.Interpreter as Interp+++-- |Abstract handle of an interpreter session.+--+newtype Session = Session (MVar (Maybe (Interp.Interpreter ())))++-- |Possible results of executing an interpreter action.+--+data Result = Result String+ | Error String++-- |Start a new interpreter session.+--+start :: IO Session+start+ = do+ { inlet <- newEmptyMVar+ ; forkIO $ void $ Interp.runInterpreter (startSession inlet)+ ; return $ Session inlet+ }+ where+ startSession inlet = Interp.setImports ["Prelude"] >> session inlet+ + session inlet+ = do+ { maybeCommand <- Interp.lift $ takeMVar inlet+ ; case maybeCommand of+ Nothing -> return ()+ Just command -> + do+ { command+ ; session inlet+ }+ }++-- Terminate an interpreter session.+--+stop :: Session -> IO ()+stop (Session inlet) = putMVar inlet Nothing++-- Evaluate a Haskell expression in the given interpreter session, 'show'ing its result.+--+-- If GHC raises an error, we pretty print it.+--+eval :: Session -> String -> IO Result+eval (Session inlet) e+ = do+ { resultMV <- newEmptyMVar+ ; putMVar inlet $ Just $ -- the interpreter command we send over to the interpreter thread+ do+ { -- demand the result to force any contained exceptions+ ; result <- (do { !result <- Interp.eval e+ ; return result }+ `catchError` (return . pprError))+ `catch` (return . (show :: SomeException -> String))+ ; Interp.lift $ putMVar resultMV (Result result)+ }+ ; takeMVar resultMV+ }++-- Infer the type of a Haskell expression in the given interpreter session.+--+-- If GHC raises an error, we pretty print it.+--+typeOf :: Session -> String -> IO Result+typeOf (Session inlet) e+ = do+ { resultMV <- newEmptyMVar+ ; putMVar inlet $ Just $ -- the interpreter command we send over to the interpreter thread+ do+ { -- demand the result to force any contained exceptions+ ; result <- (do { !result <- Interp.typeOf e+ ; return result }+ `catchError` (return . pprError))+ `catch` (return . (show :: SomeException -> String))+ ; Interp.lift $ putMVar resultMV (Result result)+ }+ ; takeMVar resultMV+ }++-- Load a module into in the given interpreter session.+--+-- If GHC raises an error, we pretty print it.+--+load :: Session -> String -> IO Result+load (Session inlet) mname+ = do+ { resultMV <- newEmptyMVar+ ; putMVar inlet $ Just $ -- the interpreter command we send over to the interpreter thread+ do+ { -- demand the result to force any contained exceptions+ ; result <- (do { Interp.loadModules [mname]+ ; mods <- Interp.getLoadedModules+ ; Interp.setTopLevelModules mods+ ; return ("Successfully loaded '" ++ mname ++ "'") }+ `catchError` (return . pprError))+ `catch` (return . (show :: SomeException -> String))+ ; Interp.lift $ putMVar resultMV (Result result)+ }+ ; takeMVar resultMV+ }++pprError :: Interp.InterpreterError -> String+pprError (Interp.UnknownError msg) = msg+pprError (Interp.WontCompile errs) = "Compile time error: \n" ++ concatMap Interp.errMsg errs+pprError (Interp.NotAllowed msg) = "Permission denied: " ++ msg+pprError (Interp.GhcException msg) = "Internal error: " ++ msg
+ tests/objc/app/Main.hs view
@@ -0,0 +1,14 @@+-- HSApp: a simple Cocoa app in Haskell+--+-- Tying all components together++import qualified App as App+import qualified AppDelegate as Delegate++main :: IO ()+main + = do+ { App.objc_initialise+ ; Delegate.objc_initialise+ ; App.main+ }
+ tests/objc/app/Makefile view
@@ -0,0 +1,32 @@+HC = ghc+CFLAGS = -fobjc-arc -I$(shell $(HC) --print-libdir)/include+HCFLAGS =+LDFLAGS = -package template-haskell -package language-c-quote -package language-c-inline -package hint \+ -framework Cocoa -optl-ObjC -threaded++OBJS = Main.o App.o App_objc.o AppDelegate.o AppDelegate_objc.o Interpreter.o++default: HSApp.app/Contents/MacOS/HSApp++%.o: %.hs+ $(HC) -c $< $(HCFLAGS)++Interpreter.o:+AppDelegate.o: Interpreter.o +App.o:+Main.o: App.o AppDelegate.o++App_objc.m: App.o+AppDelegate_objc.m: AppDelegate.o++HSApp: $(OBJS)+ $(HC) -o $@ $^ $(LDFLAGS)++HSApp.app/Contents/MacOS/HSApp: HSApp+ cp $< $@++.PHONY: clean++clean:+ rm -f *.o *.hi App_objc.[hm] AppDelegate_objc.[hm] *_stub.h HSApp HSApp.app/Contents/MacOS/HSApp+
+ tests/objc/app/Readme.md view
@@ -0,0 +1,5 @@+This example application implements a simple GUI around interactive GHC sessions.++The GUI is done with Xcode (via a .xib). The corresponding Xcode project is in the subdirectory `HSApp-xcode-proj`. This, however, is not used to build the project. Instead, we have got a simple Makefile, that invokes GHC and clang to compile the various components, and finally, copies the binary into a pre-populated `.app` bundle.++Currently, if you change the `.xib` in the Xcode project, you need to manually copy it into the appropriate location in the `.app` bundle.
+ tests/objc/concept/MainInlineObjC.hs view
@@ -0,0 +1,8 @@+import TestInlineObjC++main :: IO ()+main+ = do+ { objc_initialise+ ; dumpURL "https://raw.github.com/mchakravarty/language-c-inline/master/tests/objc/TestInlineObjC.hs"+ }
+ tests/objc/concept/Makefile view
@@ -0,0 +1,23 @@+HC = ghc+HCFLAGS = +LDFLAGS = -package template-haskell -package language-c-quote -package language-c-inline -framework Foundation++OBJS = TestInlineObjC.o TestInlineObjC_objc.o MainInlineObjC.o++default: InlineObjC++%.o: %.hs+ $(HC) -c $< $(HCFLAGS)++TestInlineObjC.o:+MainInlineObjC.o: TestInlineObjC.o++TestInlineObjC_objc.m: TestInlineObjC.o++InlineObjC: $(OBJS)+ $(HC) -o $@ $^ $(LDFLAGS)++.PHONY: clean++clean:+ rm -f *.o *.hi TestInlineObjC_objc.[hm] InlineObjC
+ tests/objc/concept/TestInlineObjC.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++module TestInlineObjC (objc_initialise, dumpURL) where++import Language.C.Quote.ObjC+import Language.C.Inline.ObjC++objc_import ["<Foundation/Foundation.h>"]+++dumpURL :: String -> IO ()+dumpURL urlString+ = do+ { urlData <- $(objc ['urlString] ''String [cexp| + [NSString stringWithContentsOfURL:[NSURL URLWithString:urlString]+ encoding:NSUTF8StringEncoding + error:NULL] + |])+ ; putStr urlData+ }++objc_emit