packages feed

Win32-shortcut (empty) → 0.0.1

raw patch · 7 files changed

+1205/−0 lines, 7 filesdep +Win32dep +basedep +mtlsetup-changed

Dependencies added: Win32, base, mtl, th-utilities

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Piotr Latanowicz++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 name of Piotr Latanowicz nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ Win32-shortcut.cabal view
@@ -0,0 +1,38 @@+name:                Win32-shortcut+version:             0.0.1+synopsis:            Support for manipulating shortcuts (.lnk files) on Windows+description:+  This package provides mechanism for reading and+  writing Windows shortcuts a.k.a. shell links.+  It uses COM library under the hood.+license:             BSD3+license-file:        LICENSE+author:              Piotr Latanowicz+maintainer:          piotr.latanowicz@gmail.com+category:            System+copyright:           2017 Piotr Latanowicz+Homepage:            https://github.com/opasly-wieprz/Win32-shortcut+build-type:          Simple+cabal-version:       >=1.10+stability:           experimental+extra-source-files:+  include/windows_cconv.h++library+  default-language:  Haskell2010+  ghc-options:       -Wall -funbox-strict-fields+  cc-options:        -fno-strict-aliasing+  extra-libraries:   ole32, uuid+  exposed-modules:   System.Win32.Shortcut+  other-modules:     System.Win32.Shortcut.Error,+                     System.Win32.Shortcut.Internal+  hs-source-dirs:    src+  include-dirs:      include+  build-depends:     base >= 4.9 && < 5,+                     Win32,+                     mtl,+                     th-utilities++source-repository head+  type:              git+  location:          git://github.com/opasly-wieprz/Win32-shortcut.git
+ include/windows_cconv.h view
@@ -0,0 +1,16 @@+/* Taken from Win32. 64-bit Windows uses the 'ccall' calling convention+   instead of 'stdcall'+*/++#ifndef __WINDOWS_CCONV_H+#define __WINDOWS_CCONV_H++#if defined(i386_HOST_ARCH)+# define WINDOWS_CCONV stdcall+#elif defined(x86_64_HOST_ARCH)+# define WINDOWS_CCONV ccall+#else+# error Unknown mingw32 arch+#endif++#endif
+ src/System/Win32/Shortcut.hs view
@@ -0,0 +1,397 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Working with @.lnk@ format should be a matter of serializing.+-- This library takes simpler approach, utilizing @Component Object Model@+-- (@COM@) library. Even though @COM@ provides some means of serialization,+-- they cannot be used in a pure fashion - the library needs+-- to be initialized and some @COM@ functions still query the+-- system for data. For this reason this library sticks to 'IO'.+--+-- Before calling 'writeShortcut' or 'readShortcut', @COM@ library+-- must be initialized with 'initialize'.+--+-- Library does not support shortcut's @IDList@s, so creating or+-- reading links to devices or network connections is not possible.+--+-- === Example+-- @+-- import Control.Monad.Except+--+-- main = print . runExceptT $ do+--   let link = empty { targetPath = "notepad.exe" }+--+--   ExceptT initialize+--   ExceptT $ writeShortcut link "c:\\\\link.lnk"+--   ret <- ExceptT $ readShortcut "c:\\\\link.lnk"+--   liftIO $ uninitialize+--+--   return ret+-- @+-- @+-- >>> main+-- Right (Shortcut {targetPath = "C:\\\\Windows\\\\system32\\\\notepad.exe",+-- arguments = "", workingDirectory = "", showCmd = ShowNormal,+-- description = "", iconLocation = ("",0), hotkey = 0})+-- @+module System.Win32.Shortcut (++  Shortcut (..),+  empty,+  ShowCmd (..),++  -- * Basic operations+  writeShortcut,+  unsafeWriteShortcut,+  readShortcut,++  -- * COM initialization+  initialize,+  uninitialize,++  -- * Errors+  ShortcutError (..),++  -- ** File IO Errors+  LoadError (..),+  SaveError (..),++  -- ** Argument errors+  PathError (..),+  ArgumentsError (..),+  WorkingDirectoryError (..),+  DescriptionError (..),+  IconLocationError (..),++  -- ** Other errors+  CoCreateInstanceError (..),+  CoInitializeError (..),+  HRESULTError (..),+  OrHRESULTError (..)+)+where++import Control.Monad (when, void)+import Control.Monad.Cont (ContT (..))+import Control.Monad.Except (ExceptT (..), withExceptT, runExceptT, throwError)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans (lift)+import Foreign (allocaArray)+import Foreign.C (peekCWString)++import System.Win32.Shortcut.Error+import System.Win32.Shortcut.Internal+++-- | Defines how a window will be opened when a link is executed.+data ShowCmd+  = ShowNormal+  -- ^ Start normally.+  | ShowMaximized+  -- ^ Start maximized.+  | ShowMinimized+  -- ^ Start minimized.+  deriving (Show)++fromShowCmd :: ShowCmd -> CInt+fromShowCmd = \case+  ShowNormal    -> sW_SHOWNORMAL+  ShowMaximized -> sW_SHOWMAXIMIZED+  ShowMinimized -> sW_SHOWMINNOACTIVE++toShowCmd :: CInt -> ShowCmd+toShowCmd x+  | x == sW_SHOWNORMAL      = ShowNormal+  | x == sW_SHOWMAXIMIZED   = ShowMaximized+  | x == sW_SHOWMINNOACTIVE = ShowMinimized+  | otherwise               = ShowNormal+++-- | A shell link.+--+--   It seems that @.lnk@ format permits up to 32767+--   characters in text fields (259 for 'targetPath'), however+--   if 'workingDirectory', 'description' or 'iconLocation' is+--   longer then 259 characters @COM@ won't be able to read the+--   shortcut corectly ('readShortcut' will return faulty link without+--   raising any error, and @explorer.exe@ may not interpret it properly).+--   For this reason two write functions are provided. 'unsafeWriteShortcut'+--   will allow long fields and 'writeShortcut' which will raise+--   error if 'workingDirectory', 'description' or 'iconLocation'+--   is longer then 259 characters.+data Shortcut = Shortcut {+  targetPath :: FilePath,+  -- ^ Path to target.+  arguments :: String,+  -- ^ Arguments for target.+  workingDirectory :: FilePath,+  -- ^ Path to working directory.+  showCmd :: ShowCmd,+  description :: String,+  iconLocation :: (FilePath, Int),+  -- ^ Path to icon container (e.g. @.exe@, @.dll@, or @.ico@ file)+  --   and icon index.+  hotkey :: WORD+  -- ^ The virtual key code is in the low-order byte,+  --   and the modifier flags are in the high-order byte.+  --   @'hotkey' == 0@ means no hotkey will be used.+} deriving (Show)+++type Callee struct vtbl fun = vtbl -> VtblPtrFun struct fun++newtype Caller struct vtbl = Call {+  call :: forall fun . Callee struct vtbl fun -> fun+}++makeMethodCaller+  :: (Storable vtbl, Storable struct)+  => (struct -> Ptr vtbl)+  -> Ptr (Ptr struct)+  -> IO (Caller struct vtbl)+makeMethodCaller getVtbl structPtrPtr = do+  structPtr  <- peek structPtrPtr+  structVtbl <- peek structPtr >>= peek . getVtbl+  return $ Call $ \getMtd -> getMtd structVtbl structPtr+++type IShellLinkWCallee fun = Callee IShellLinkW IShellLinkWVtbl fun++type IShellLinkWCaller = Caller IShellLinkW IShellLinkWVtbl++ishQueryInterface' :: IShellLinkWCallee (REFIID -> Ptr (Ptr ()) -> IO HRESULT)+ishQueryInterface' = dynIshQueryInterface . ishQueryInterface++getPath' :: IShellLinkWCallee (LPWSTR -> CInt -> Ptr WIN32_FIND_DATAW -> DWORD -> IO HRESULT)+getPath' = dynGetPath . getPath++setPath' :: IShellLinkWCallee (LPCWSTR -> IO HRESULT)+setPath' = dynSetPath . setPath++getArguments' :: IShellLinkWCallee (LPWSTR -> CInt -> IO HRESULT)+getArguments' = dynGetArguments . getArguments++setArguments' :: IShellLinkWCallee (LPCWSTR -> IO HRESULT)+setArguments' = dynSetArguments . setArguments++getWorkingDirectory' :: IShellLinkWCallee (LPWSTR -> CInt -> IO HRESULT)+getWorkingDirectory' = dynGetWorkingDirectory . getWorkingDirectory++setWorkingDirectory' :: IShellLinkWCallee (LPCWSTR -> IO HRESULT)+setWorkingDirectory' = dynSetWorkingDirectory . setWorkingDirectory++getShowCmd' :: IShellLinkWCallee (Ptr CInt -> IO HRESULT)+getShowCmd' = dynGetShowCmd . getShowCmd++setShowCmd' :: IShellLinkWCallee (CInt -> IO HRESULT)+setShowCmd' = dynSetShowCmd . setShowCmd++getDescription' :: IShellLinkWCallee (LPWSTR -> CInt -> IO HRESULT)+getDescription' = dynGetDescription . getDescription++setDescription' :: IShellLinkWCallee (LPCWSTR -> IO HRESULT)+setDescription' = dynSetDescription . setDescription++getHotkey' :: IShellLinkWCallee (Ptr WORD -> IO HRESULT)+getHotkey' = dynGetHotkey . getHotkey++setHotkey' :: IShellLinkWCallee (WORD -> IO HRESULT)+setHotkey' = dynSetHotkey . setHotkey++getIconLocation' :: IShellLinkWCallee (LPWSTR -> CInt -> Ptr CInt -> IO HRESULT)+getIconLocation' = dynGetIconLocation . getIconLocation++setIconLocation' :: IShellLinkWCallee (LPCWSTR -> CInt -> IO HRESULT)+setIconLocation' = dynSetIconLocation . setIconLocation++ishRelease' :: IShellLinkWCallee (IO ULONG)+ishRelease' = dynIshRelease . ishRelease+++type IPersistFileCallee fun = Callee IPersistFile IPersistFileVtbl fun++type IPersistFileCaller = Caller IPersistFile IPersistFileVtbl++save' :: IPersistFileCallee (LPCOLESTR -> WINBOOL -> IO HRESULT)+save' = dynSave . save++load' :: IPersistFileCallee (LPCOLESTR -> DWORD -> IO HRESULT)+load' = dynLoad . load++ipRelease' :: IPersistFileCallee (IO ULONG)+ipRelease' = dynIpRelease . ipRelease+++withCaller+  :: (Storable struct, Storable vtbl)+  => (Ptr (Ptr ()) -> IO HRESULT)+  -> (struct -> Ptr vtbl)+  -> Callee struct vtbl (IO ULONG)+  -> ExceptT (OrHRESULTError CoCreateInstanceError) (ContT r IO) (Caller struct vtbl)+withCaller new getVtbl release = do+  structPtr <- lift . ContT . with $ nullPtr+  res <- liftIO $ new (castPtr structPtr)+  case succeeded' toCoCreateInstanceError res of+    Left err -> throwError err+    Right _ -> lift . ContT $ \k -> do+      caller <- makeMethodCaller getVtbl structPtr+      ret <- k caller+      void $ call caller release+      return ret++withIShellLinkCaller :: ExceptT (OrHRESULTError CoCreateInstanceError) (ContT r IO) IShellLinkWCaller+withIShellLinkCaller =+  withCaller+    (c_CoCreateInstance c_CLSID_ShellLink nullPtr cLSCTX_ALL c_IID_IShellLinkW)+    ishlpVtbl+    ishRelease'++withIPersistFileCaller+  :: IShellLinkWCaller+  -> ExceptT (OrHRESULTError CoCreateInstanceError) (ContT r IO) IPersistFileCaller+withIPersistFileCaller shellLinkCaller =+  withCaller+    (call shellLinkCaller ishQueryInterface' c_IID_IPersistFile)+    iplpVtbl+    ipRelease'+++-- Max length of a CString fields, including terminator+longFieldLength, shortFieldLength :: CInt+longFieldLength = 32768+shortFieldLength = mAX_PATH + 1 -- does not apply to targetPath+++-- | Create a shortcut under specified location. 'initialize' must be+--   called beforehand. 'targetPath' will be resolved with+--   respect to whatever is found in @PATH@ variable or desktop+--   if saved path is not absolute.+writeShortcut:: Shortcut -> FilePath -> IO (Either ShortcutError ())+writeShortcut = writeShortcutGeneric True++-- | Same as 'writeShortcut', but allows long 'description',+--   'workingDirectory' and 'iconLocation' fields. @COM@ and @explorer.exe@+--   may not interpret created link correctly.+unsafeWriteShortcut :: Shortcut -> FilePath -> IO (Either ShortcutError ())+unsafeWriteShortcut = writeShortcutGeneric False++writeShortcutGeneric :: Bool -> Shortcut -> FilePath -> IO (Either ShortcutError ())+writeShortcutGeneric safeRead shortcut path = flip runContT return . runExceptT $ do++  let throwIfTooLong f maxLength err = when (length (f shortcut) >= fromIntegral maxLength) (throwError err)+      throwIfTooLong' f = throwIfTooLong f (if safeRead then shortFieldLength else longFieldLength) in+    do throwIfTooLong targetPath mAX_PATH        (InvalidPath      $ OtherError PathTooLong)+       throwIfTooLong arguments  longFieldLength (InvalidArguments $ OtherError ArgumentsTooLong)++       throwIfTooLong' workingDirectory     (InvalidWorkingDirectory $ OtherError WorkingDirectoryTooLong)+       throwIfTooLong' description          (InvalidDescription      $ OtherError DescriptionTooLong)+       throwIfTooLong' (fst . iconLocation) (InvalidIconLocation     $ OtherError IconLocationTooLong)++  shellLinkCaller <- withExceptT CreateIShellLinkInterfaceError withIShellLinkCaller++  withExcept' (Left . InvalidPath . HRESULTError) $+    call shellLinkCaller setPath' <$> ContT (withCWString $ targetPath shortcut)++  withExcept' (Left . InvalidArguments . HRESULTError) $+    call shellLinkCaller setArguments' <$> ContT (withCWString $ arguments shortcut)++  withExcept' (Left . InvalidWorkingDirectory . HRESULTError) $+    call shellLinkCaller setWorkingDirectory' <$> ContT (withCWString $ workingDirectory shortcut)++  withExcept' (Left . InvalidShowCmd) $+    call shellLinkCaller setShowCmd' <$> pure (fromShowCmd $ showCmd shortcut)++  withExcept' (Left . InvalidDescription . HRESULTError) $+    call shellLinkCaller setDescription' <$> ContT (withCWString $ description shortcut)++  let (iconLocation', iconIndex) = iconLocation shortcut+  withExcept' (Left . InvalidIconLocation . HRESULTError) $+    call shellLinkCaller setIconLocation' <$> ContT (withCWString iconLocation') <*> pure (fromIntegral iconIndex)++  withExcept' (Left . InvalidHotkey) . pure $+    call shellLinkCaller setHotkey' (hotkey shortcut)++  iPersistFileCaller <- withExceptT CreateIPersistFileInterfaceError $+    withIPersistFileCaller shellLinkCaller++  withExcept' (overLeft SaveError . toSaveError) $+    call iPersistFileCaller save' <$> ContT (withCWString path) <*> pure tRUE+++-- | Read a shortcut from the supplied location. 'initialize' must be+--   called beforehand.+readShortcut :: FilePath -> IO (Either ShortcutError Shortcut)+readShortcut path = flip runContT return . runExceptT $ do++  shellLinkCaller <- withExceptT CreateIShellLinkInterfaceError withIShellLinkCaller++  iPersistFileCaller <- withExceptT CreateIPersistFileInterfaceError $+    withIPersistFileCaller shellLinkCaller++  withExcept' (overLeft LoadError . toLoadError) $+    call iPersistFileCaller load' <$> ContT (withCWString path) <*> pure sTGM_READ++  pathPtr <- lift . ContT $ allocaArray (fromIntegral mAX_PATH)+  withExcept' (overLeft InvalidPath . toPathError) . pure $+    call shellLinkCaller getPath' pathPtr mAX_PATH nullPtr sLGP_RAWPATH++  argumentsPtr <- lift . ContT $ allocaArray (fromIntegral longFieldLength)+  withExcept' (Left . InvalidArguments . HRESULTError) . pure $+    call shellLinkCaller getArguments' argumentsPtr longFieldLength++  workingDirectoryPtr <- lift . ContT $ allocaArray (fromIntegral shortFieldLength)+  withExcept' (Left . InvalidWorkingDirectory . HRESULTError) . pure $+    call shellLinkCaller getWorkingDirectory' workingDirectoryPtr shortFieldLength++  showCmdPtr <- lift . ContT $ with 0+  withExcept' (Left . InvalidShowCmd) . pure $+    call shellLinkCaller getShowCmd' showCmdPtr++  descriptionPtr <- lift . ContT $ allocaArray (fromIntegral shortFieldLength)+  withExcept' (Left . InvalidDescription . HRESULTError) . pure $+    call shellLinkCaller getDescription' descriptionPtr shortFieldLength++  iconLocationPtr <- lift . ContT $ allocaArray (fromIntegral shortFieldLength)+  iconIndexPtr <- lift . ContT $ with 0+  withExcept' (Left . InvalidIconLocation . HRESULTError) . pure $+    call shellLinkCaller getIconLocation' iconLocationPtr shortFieldLength iconIndexPtr++  hotkeyPtr <- lift . ContT $ with 0+  withExcept' (Left . InvalidHotkey) . pure $+    call shellLinkCaller getHotkey' hotkeyPtr++  liftIO $+    Shortcut <$> peekCWString pathPtr+             <*> peekCWString argumentsPtr+             <*> peekCWString workingDirectoryPtr+             <*> (toShowCmd <$> peek showCmdPtr)+             <*> peekCWString descriptionPtr+             <*> ((,) <$> peekCWString iconLocationPtr+                      <*> (fromIntegral <$> peek iconIndexPtr))+             <*> peek hotkeyPtr+++-- | Initialize @COM@ library for current thread.+--   Wraps <https://msdn.microsoft.com/en-us/library/windows/desktop/ms695279(v=vs.85).aspx CoInitializeEx>+--   function.+initialize :: IO (Either ShortcutError ())+initialize = succeeded' (overLeft InitializationError . toCoInitializeError)+  <$> c_CoInitializeEx nullPtr cOINIT_MULTITHREADED++-- | Uninitialize @COM@ library for current thread.+uninitialize :: IO ()+uninitialize = c_CoUninitialize+++-- | An empty link. All fields are set to empty/default values.+empty :: Shortcut+empty = Shortcut {+  targetPath = "",+  arguments = "",+  workingDirectory = "",+  showCmd = ShowNormal,+  description = "",+  iconLocation = ("", 0),+  hotkey = 0+}
+ src/System/Win32/Shortcut/Error.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE LambdaCase #-}++module System.Win32.Shortcut.Error+where++import Control.Monad (join)+import Control.Monad.Except (ExceptT (..))+import Control.Monad.Trans (MonadTrans, lift)++import System.Win32.Shortcut.Internal++-- | In @Win32 API@ 'HRESULT' is used to indicate error and warning+--   conditions. 'HRESULTError' wraps 'HRESULT' to give it some meaning.+data HRESULTError+  = E_ABORT+  -- ^ Operation aborted.+  | E_ACCESSDENIED+  -- ^ General access denied error.+  | E_FAIL+  -- ^ Unspecified failure.+  | E_HANDLE+  -- ^ Handle that is not valid.+  | E_INVALIDARG+  -- ^ One or more arguments are not valid.+  | E_NOINTERFACE+  -- ^ No such interface supported.+  | E_NOTIMPL+  -- ^ Not implemented.+  | E_OUTOFMEMORY+  -- ^ Failed to allocate necessary memory.+  | E_POINTER+  -- ^ Pointer that is not valid.+  | E_UNEXPECTED+  -- ^ Unexpected failure.+  | HRESULTUnknown HRESULT+  -- ^ Other, unknown 'HRESULT' value.+  deriving (Show)++succeeded :: HRESULT -> Either HRESULTError ()+succeeded x+  | x == s_OK           = Right ()+  | x == e_ACCESSDENIED = Left E_ACCESSDENIED+  | x == e_FAIL         = Left E_FAIL+  | x == e_HANDLE       = Left E_HANDLE+  | x == e_INVALIDARG   = Left E_INVALIDARG+  | x == e_NOINTERFACE  = Left E_NOINTERFACE+  | x == e_NOTIMPL      = Left E_NOTIMPL+  | x == e_OUTOFMEMORY  = Left E_OUTOFMEMORY+  | x == e_POINTER      = Left E_POINTER+  | x == e_UNEXPECTED   = Left E_UNEXPECTED+  | otherwise           = Left (HRESULTUnknown x)++succeeded' :: (HRESULTError -> Either e ()) -> HRESULT -> Either e ()+succeeded' f = either f Right . succeeded++withExcept'+  :: (MonadTrans t, Monad (t m), Monad m)+  => (HRESULTError -> Either e ())+  -> t m (m HRESULT)+  -> ExceptT e (t m) ()+withExcept' f = ExceptT . fmap (succeeded' f) . join . fmap lift++overLeft :: (e1 -> e2) -> Either e1 a -> Either e2 a+overLeft f = either (Left . f) Right+++-- | Some error that comes from 'HRESULT'.+data OrHRESULTError err+  = OtherError err+  -- ^ 'HRESULT' value was expected and fits @err@.+  | HRESULTError HRESULTError+  -- ^ 'HRESULT' did not fit @err@.+  deriving (Show)++-- | @COM@ cannot create specified interface.+data CoCreateInstanceError+  = CCI_REGDB_E_CLASSNOTREG+  -- ^ A specified class is not registered in the registration database.+  --   Also can indicate that the type of server you requested+  --   in the CLSCTX enumeration is not registered or the values+  --   for the server types in the registry are corrupt.+  | CCI_CLASS_E_NOAGGREGATION+  -- ^ This class cannot be created as part of an aggregate.+  | CCI_E_NOINTERFACE+  -- ^ The specified class does not implement the requested interface,+  --   or the controlling IUnknown does not expose the requested interface.+  | CCI_E_POINTER+  -- ^ The ppv parameter is NULL.+  | CCI_CO_E_NOTINITIALIZED+  -- ^ @COM@ library was not initialized.+  deriving (Show)++toCoCreateInstanceError :: HRESULTError -> Either (OrHRESULTError CoCreateInstanceError) ()+toCoCreateInstanceError = Left . \case+  HRESULTUnknown x+    | x == -2147221164 -- 0x80040154+      -> OtherError CCI_REGDB_E_CLASSNOTREG+    | x == -2147221232 -- 0x80040110+      -> OtherError CCI_CLASS_E_NOAGGREGATION+    | x == -2147221008 -- 0x800401f0+      -> OtherError CCI_CO_E_NOTINITIALIZED+  E_NOINTERFACE -> OtherError CCI_E_NOINTERFACE+  E_POINTER     -> OtherError CCI_E_POINTER+  other         -> HRESULTError other+++-- | @COM@ failed to initialize.+data CoInitializeError+  = CI_RPC_E_CHANGED_MODE+  -- ^ A previous call to CoInitializeEx specified the concurrency model+  --   for this thread as multithread apartment (MTA).+  --   This could also indicate that a change from neutral-threaded+  --   apartment to single-threaded apartment has occurred.+  | CI_CO_E_NOTINITIALIZED+  -- ^ You need to initialize the @COM@ library on a thread+  --   before you call any of the library functions.+  --   Otherwise, the @COM@ function will return 'CI_CO_E_NOTINITIALIZED'.+  deriving (Show)++toCoInitializeError :: HRESULTError -> Either (OrHRESULTError CoInitializeError) ()+toCoInitializeError = Left . \case+  HRESULTUnknown x+    | x == -2147417850 -- 0x80010106+      -> OtherError CI_RPC_E_CHANGED_MODE+    | x == -2147221008 -- 0x800401F0+      -> OtherError CI_CO_E_NOTINITIALIZED+  other -> HRESULTError other+++-- | @IPersistFile@ interface failed to save a file.+data SaveError+  = SE_S_FALSE+  -- ^ The object was not successfully saved.+  deriving (Show)++toSaveError :: HRESULTError -> Either (OrHRESULTError SaveError) ()+toSaveError = \case+  HRESULTUnknown x+    | x == s_FALSE -> Left (OtherError SE_S_FALSE)+  other -> Left (HRESULTError other)+++-- | @IPersistFile@ interface failed to load a file.+data LoadError+  = LE_E_OUTOFMEMORY+  -- ^ The object could not be loaded due to a lack of memory.+  | LE_E_FAIL+  -- ^ The object could not be loaded for some reason+  --   other than a lack of memory.+  deriving (Show)++toLoadError :: HRESULTError -> Either (OrHRESULTError LoadError) ()+toLoadError = Left . \case+  E_OUTOFMEMORY -> OtherError LE_E_OUTOFMEMORY+  E_FAIL -> OtherError LE_E_FAIL+  other -> HRESULTError other+++data PathError+  = Path_S_FALSE+  -- ^ The operation is successful but no path is retrieved.+  | PathTooLong+  -- ^ Path length >= 260 characters.+  deriving (Show)++toPathError :: HRESULTError -> Either (OrHRESULTError PathError) ()+toPathError = \case+  HRESULTUnknown x+    | x == s_FALSE -> Left (OtherError Path_S_FALSE)+  other -> Left (HRESULTError other)+++data ArgumentsError+  = ArgumentsTooLong+  -- ^ Arguments length >= 32768 characters.+  deriving (Show)+++data WorkingDirectoryError+  = WorkingDirectoryTooLong+  deriving (Show)+++data DescriptionError+  = DescriptionTooLong+  deriving (Show)+++data IconLocationError+  = IconLocationTooLong+  deriving (Show)+++-- | Catch-all type for errors.+data ShortcutError+  = InitializationError              (OrHRESULTError CoInitializeError)+  | CreateIShellLinkInterfaceError   (OrHRESULTError CoCreateInstanceError)+  | CreateIPersistFileInterfaceError (OrHRESULTError CoCreateInstanceError)+  | LoadError                        (OrHRESULTError LoadError)+  | SaveError                        (OrHRESULTError SaveError)+  | InvalidPath                      (OrHRESULTError PathError)+  | InvalidArguments                 (OrHRESULTError ArgumentsError)+  | InvalidWorkingDirectory          (OrHRESULTError WorkingDirectoryError)+  | InvalidDescription               (OrHRESULTError DescriptionError)+  | InvalidIconLocation              (OrHRESULTError IconLocationError)+  | InvalidHotkey  HRESULTError+  | InvalidShowCmd HRESULTError+  deriving (Show)
+ src/System/Win32/Shortcut/Internal.hs view
@@ -0,0 +1,514 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}++module System.Win32.Shortcut.Internal (+  module Foreign,+  module Foreign.C,+  module System.Win32,+  ULONG,+  OLECHAR,+  LPCOLESTR,+  LPOLESTR,+  WINBOOL,+  tRUE,+  fALSE,+  mAX_PATH,+  GUID (..),+  CLSID,+  IID,+  REFIID,+  REFCLSID,+  WIN32_FIND_DATAW (..),+  SHITEMID (..),+  ITEMIDLIST (..),+  LPITEMIDLIST,+  PIDLIST_ABSOLUTE,+  LPCITEMIDLIST,+  PCIDLIST_ABSOLUTE,+  HWND__ (..),+  HWND,+  VtblPtrFun,+  VtblMethod,+  MethodCast,+  IShellLinkWMethod,+  IShellLinkW (..),+  IShellLinkWVtbl (..),+  IShellLinkWMethodCast,+  dynIshQueryInterface,+  dynIshAddRef,+  dynIshRelease,+  dynGetPath,+  dynGetIDList,+  dynSetIDList,+  dynGetDescription,+  dynSetDescription,+  dynGetWorkingDirectory,+  dynSetWorkingDirectory,+  dynGetArguments,+  dynSetArguments,+  dynGetHotkey,+  dynSetHotkey,+  dynGetShowCmd,+  dynSetShowCmd,+  dynGetIconLocation,+  dynSetIconLocation,+  dynSetRelativePath,+  dynResolve,+  dynSetPath,+  IUnknownMethod,+  IUnknown (..),+  IUnknownVtbl (..),+  IUnknownMethodCast,+  dynIuQueryInterface,+  dynIuAddRef,+  dynIuRelease,+  LPUNKNOWN,+  IPersistFileMethod,+  IPersistFile (..),+  IPersistFileVtbl (..),+  IPersistFileMethodCast,+  dynIpQueryInterface,+  dynIpAddRef,+  dynIpRelease,+  dynGetClassID,+  dynIsDirty,+  dynLoad,+  dynSave,+  dynSaveCompleted,+  dynGetCurFile,+  cLSCTX_INPROC_HANDLER,+  cLSCTX_INPROC_SERVER,+  cLSCTX_LOCAL_SERVER,+  cLSCTX_REMOTE_SERVER,+  cLSCTX_ALL,+  sW_SHOWNORMAL,+  sW_SHOWMAXIMIZED,+  sW_SHOWMINNOACTIVE,+  s_OK,+  s_FALSE,+  e_ABORT,+  e_ACCESSDENIED,+  e_FAIL,+  e_HANDLE,+  e_INVALIDARG,+  e_NOINTERFACE,+  e_NOTIMPL,+  e_OUTOFMEMORY,+  e_POINTER,+  e_UNEXPECTED,+  SLGP_FLAGS,+  sLGP_SHORTPATH,+  sLGP_UNCPRIORITY,+  sLGP_RAWPATH,+  sLGP_RELATIVEPRIORITY,+  sTGM_READ,+  COINITBASE,+  cOINITBASE_MULTITHREADED,+  COINIT,+  cOINIT_APARTMENTTHREADED,+  cOINIT_MULTITHREADED,+  cOINIT_DISABLE_OLE1DDE,+  cOINIT_SPEED_OVER_MEMORY,+  c_CoInitializeEx,+  c_CoUninitialize,+  c_CoCreateInstance,+  c_CLSID_ShellLink,+  c_IID_IShellLinkW,+  c_IID_IPersistFile+)+where++import Foreign (+  Storable(..),+  Ptr,+  FunPtr,+  nullPtr,+  castPtr,+  with,+  (.|.))+import Foreign.C (+  CInt (..),+  CWchar,+  withCWString)+import System.Win32 (+  UCHAR,+  USHORT,+  BYTE,+  WORD,+  DWORD,+  LPVOID,+  LPCWSTR,+  LPWSTR,+  FILETIME,+  HRESULT)+import TH.Derive (+  Deriving,+  derive)++#include "windows_cconv.h"++type ULONG = DWORD++type OLECHAR = CWchar++type LPCOLESTR = Ptr OLECHAR++type LPOLESTR = Ptr OLECHAR++type WINBOOL = CInt++tRUE, fALSE :: WINBOOL+tRUE  = 1+fALSE = 0++mAX_PATH :: CInt+mAX_PATH = 260++data GUID = GUID {+  data1 :: !ULONG,+  data2 :: !USHORT,+  data3 :: !USHORT,+  data4 :: !(Ptr UCHAR) -- uchar[8]+} deriving (Show)++$($(derive [d| instance Deriving (Storable GUID) |]))++type CLSID = GUID++type IID = GUID++type REFIID = Ptr IID++type REFCLSID = Ptr IID+++data WIN32_FIND_DATAW = WIN32_FIND_DATAW {+  dwFileAttributes   :: !DWORD,+  ftCreationTime     :: !FILETIME,+  ftLastAccessTime   :: !FILETIME,+  ftLastWriteTime    :: !FILETIME,+  nFileSizeHigh      :: !DWORD,+  nFileSizeLow       :: !DWORD,+  dwReserved0        :: !DWORD,+  dwReserved1        :: !DWORD,+  cFileName          :: !(Ptr CWchar), -- char[max_path]+  cAlternateFileName :: !(Ptr CWchar)  -- char[14]+} deriving (Show)++$($(derive [d| instance Deriving (Storable WIN32_FIND_DATAW) |]))+++data SHITEMID = SHITEMID {+  cb   :: !USHORT,+  abID :: !(Ptr BYTE) -- BYTE[1]+} deriving (Show)++$($(derive [d| instance Deriving (Storable SHITEMID) |]))+++newtype ITEMIDLIST = ITEMIDLIST {+  mkid :: SHITEMID+} deriving (Show)++$($(derive [d| instance Deriving (Storable ITEMIDLIST) |]))++type LPITEMIDLIST = Ptr ITEMIDLIST++type PIDLIST_ABSOLUTE = LPITEMIDLIST++type LPCITEMIDLIST = Ptr ITEMIDLIST++type PCIDLIST_ABSOLUTE = LPCITEMIDLIST+++newtype HWND__ = HWND__ {+  unused :: CInt+} deriving (Show)++$($(derive [d| instance Deriving (Storable HWND__) |]))++type HWND = Ptr HWND__+++type VtblPtrFun struct fun = Ptr struct -> fun++type VtblMethod struct fun = FunPtr (VtblPtrFun struct fun)++type MethodCast struct fun = VtblMethod struct fun -> VtblPtrFun struct fun+++type IShellLinkWMethod fun = VtblMethod IShellLinkW fun++newtype IShellLinkW = IShellLinkW {+  ishlpVtbl :: Ptr IShellLinkWVtbl+} deriving (Show)++data IShellLinkWVtbl = IShellLinkWVtbl {+  ishQueryInterface   :: !(IShellLinkWMethod (REFIID -> Ptr (Ptr ()) -> IO HRESULT)),+  ishAddRef           :: !(IShellLinkWMethod (IO ULONG)),+  ishRelease          :: !(IShellLinkWMethod (IO ULONG)),+  getPath             :: !(IShellLinkWMethod (LPWSTR -> CInt -> Ptr WIN32_FIND_DATAW -> DWORD -> IO HRESULT)),+  getIDList           :: !(IShellLinkWMethod (Ptr PIDLIST_ABSOLUTE -> IO HRESULT)),+  setIDList           :: !(IShellLinkWMethod (PCIDLIST_ABSOLUTE -> IO HRESULT)),+  getDescription      :: !(IShellLinkWMethod (LPWSTR -> CInt -> IO HRESULT)),+  setDescription      :: !(IShellLinkWMethod (LPCWSTR -> IO HRESULT)),+  getWorkingDirectory :: !(IShellLinkWMethod (LPWSTR -> CInt -> IO HRESULT)),+  setWorkingDirectory :: !(IShellLinkWMethod (LPCWSTR -> IO HRESULT)),+  getArguments        :: !(IShellLinkWMethod (LPWSTR -> CInt -> IO HRESULT)),+  setArguments        :: !(IShellLinkWMethod (LPCWSTR -> IO HRESULT)),+  getHotkey           :: !(IShellLinkWMethod (Ptr WORD -> IO HRESULT)),+  setHotkey           :: !(IShellLinkWMethod (WORD -> IO HRESULT)),+  getShowCmd          :: !(IShellLinkWMethod (Ptr CInt -> IO HRESULT)),+  setShowCmd          :: !(IShellLinkWMethod (CInt -> IO HRESULT)),+  getIconLocation     :: !(IShellLinkWMethod (LPWSTR -> CInt -> Ptr CInt -> IO HRESULT)),+  setIconLocation     :: !(IShellLinkWMethod (LPCWSTR -> CInt -> IO HRESULT)),+  setRelativePath     :: !(IShellLinkWMethod (LPCWSTR -> DWORD -> IO HRESULT)),+  resolve             :: !(IShellLinkWMethod (HWND -> DWORD -> IO HRESULT)),+  setPath             :: !(IShellLinkWMethod (LPCWSTR -> IO HRESULT))+} deriving (Show)++$($(derive [d| instance Deriving (Storable IShellLinkW) |]))+$($(derive [d| instance Deriving (Storable IShellLinkWVtbl) |]))++type IShellLinkWMethodCast fun = MethodCast IShellLinkW fun++foreign import WINDOWS_CCONV "dynamic"+  dynIshQueryInterface   :: IShellLinkWMethodCast (REFIID -> Ptr (Ptr ()) -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynIshAddRef           :: IShellLinkWMethodCast (IO ULONG)++foreign import WINDOWS_CCONV "dynamic"+  dynIshRelease          :: IShellLinkWMethodCast (IO ULONG)++foreign import WINDOWS_CCONV "dynamic"+  dynGetPath             :: IShellLinkWMethodCast (LPWSTR -> CInt -> Ptr WIN32_FIND_DATAW -> DWORD -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynGetIDList           :: IShellLinkWMethodCast (Ptr PIDLIST_ABSOLUTE -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSetIDList           :: IShellLinkWMethodCast (PCIDLIST_ABSOLUTE -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynGetDescription      :: IShellLinkWMethodCast (LPWSTR -> CInt -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSetDescription      :: IShellLinkWMethodCast (LPCWSTR -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynGetWorkingDirectory :: IShellLinkWMethodCast (LPWSTR -> CInt -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSetWorkingDirectory :: IShellLinkWMethodCast (LPCWSTR -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynGetArguments        :: IShellLinkWMethodCast (LPWSTR -> CInt -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSetArguments        :: IShellLinkWMethodCast (LPCWSTR -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynGetHotkey           :: IShellLinkWMethodCast (Ptr WORD -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSetHotkey           :: IShellLinkWMethodCast (WORD -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynGetShowCmd          :: IShellLinkWMethodCast (Ptr CInt -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSetShowCmd          :: IShellLinkWMethodCast (CInt -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynGetIconLocation     :: IShellLinkWMethodCast (LPWSTR -> CInt -> Ptr CInt -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSetIconLocation     :: IShellLinkWMethodCast (LPCWSTR -> CInt -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSetRelativePath     :: IShellLinkWMethodCast (LPCWSTR -> DWORD -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynResolve             :: IShellLinkWMethodCast (HWND -> DWORD -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSetPath             :: IShellLinkWMethodCast (LPCWSTR -> IO HRESULT)+++type IUnknownMethod fun = VtblMethod IUnknown fun++newtype IUnknown = IUnknown {+  iunklpVtbl :: Ptr IUnknownVtbl+} deriving (Show)++data IUnknownVtbl = IUnknownVtbl {+  iuQueryInterface :: !(IUnknownMethod (REFIID -> Ptr (Ptr ()) -> IO HRESULT)),+  iuAddRef         :: !(IUnknownMethod (IO ULONG)),+  iuRelease        :: !(IUnknownMethod (IO ULONG))+} deriving (Show)++$($(derive [d| instance Deriving (Storable IUnknown) |]))+$($(derive [d| instance Deriving (Storable IUnknownVtbl) |]))++type IUnknownMethodCast fun = MethodCast IUnknown fun++foreign import WINDOWS_CCONV "dynamic"+  dynIuQueryInterface :: IUnknownMethodCast (REFIID -> Ptr (Ptr ()) -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynIuAddRef         :: IUnknownMethodCast (IO ULONG)++foreign import WINDOWS_CCONV "dynamic"+  dynIuRelease        :: IUnknownMethodCast (IO ULONG)++type LPUNKNOWN = Ptr IUnknown+++type IPersistFileMethod fun = VtblMethod IPersistFile fun++newtype IPersistFile = IPersistFile {+  iplpVtbl :: Ptr IPersistFileVtbl+} deriving (Show)++data IPersistFileVtbl = IPersistFileVtbl {+  ipQueryInterface :: !(IPersistFileMethod (REFIID -> Ptr (Ptr ()) -> IO HRESULT)),+  ipAddRef         :: !(IPersistFileMethod (IO ULONG)),+  ipRelease        :: !(IPersistFileMethod (IO ULONG)),+  getClassID       :: !(IPersistFileMethod (Ptr CLSID -> IO HRESULT)),+  isDirty          :: !(IPersistFileMethod (IO HRESULT)),+  load             :: !(IPersistFileMethod (LPCOLESTR -> DWORD -> IO HRESULT)),+  save             :: !(IPersistFileMethod (LPCOLESTR -> WINBOOL -> IO HRESULT)),+  saveCompleted    :: !(IPersistFileMethod (LPCOLESTR -> IO HRESULT)),+  getCurFile       :: !(IPersistFileMethod (Ptr LPOLESTR -> IO HRESULT))+} deriving (Show)++$($(derive [d| instance Deriving (Storable IPersistFile) |]))+$($(derive [d| instance Deriving (Storable IPersistFileVtbl) |]))++type IPersistFileMethodCast fun = MethodCast IPersistFile fun++foreign import WINDOWS_CCONV "dynamic"+  dynIpQueryInterface :: IPersistFileMethodCast (REFIID -> Ptr (Ptr ()) -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynIpAddRef         :: IPersistFileMethodCast (IO ULONG)++foreign import WINDOWS_CCONV "dynamic"+  dynIpRelease        :: IPersistFileMethodCast (IO ULONG)++foreign import WINDOWS_CCONV "dynamic"+  dynGetClassID       :: IPersistFileMethodCast (Ptr CLSID -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynIsDirty          :: IPersistFileMethodCast (IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynLoad             :: IPersistFileMethodCast (LPCOLESTR -> DWORD -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSave             :: IPersistFileMethodCast (LPCOLESTR -> WINBOOL -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynSaveCompleted    :: IPersistFileMethodCast (LPCOLESTR -> IO HRESULT)++foreign import WINDOWS_CCONV "dynamic"+  dynGetCurFile       :: IPersistFileMethodCast (Ptr LPOLESTR -> IO HRESULT)+++cLSCTX_INPROC_SERVER, cLSCTX_INPROC_HANDLER           :: DWORD+cLSCTX_LOCAL_SERVER, cLSCTX_REMOTE_SERVER, cLSCTX_ALL :: DWORD+cLSCTX_INPROC_SERVER  = 0x1+cLSCTX_INPROC_HANDLER = 0x2+cLSCTX_LOCAL_SERVER   = 0x4+cLSCTX_REMOTE_SERVER  = 0x10+cLSCTX_ALL = cLSCTX_INPROC_SERVER+         .|. cLSCTX_INPROC_HANDLER+         .|. cLSCTX_LOCAL_SERVER+         .|. cLSCTX_REMOTE_SERVER+++sW_SHOWNORMAL :: CInt+sW_SHOWNORMAL = 1++sW_SHOWMAXIMIZED :: CInt+sW_SHOWMAXIMIZED = 3++sW_SHOWMINNOACTIVE :: CInt+sW_SHOWMINNOACTIVE = 7+++s_OK, s_FALSE, e_ABORT, e_ACCESSDENIED, e_FAIL, e_HANDLE, e_INVALIDARG :: HRESULT+e_NOINTERFACE, e_NOTIMPL, e_OUTOFMEMORY, e_POINTER, e_UNEXPECTED       :: HRESULT+s_OK                  =           0 -- 0x00000000 - negative hex literals+s_FALSE               =           1 -- 0x00000001   trigger a warning+e_ABORT               = -2147467260 -- 0x80004004+e_ACCESSDENIED        = -2147024891 -- 0x80070005+e_FAIL                = -2147467259 -- 0x80004005+e_HANDLE              = -2147024890 -- 0x80070006+e_INVALIDARG          = -2147024809 -- 0x80070057+e_NOINTERFACE         = -2147467262 -- 0x80004002+e_NOTIMPL             = -2147467263 -- 0x80004001+e_OUTOFMEMORY         = -2147024882 -- 0x8007000E+e_POINTER             = -2147467261 -- 0x80004003+e_UNEXPECTED          = -2147418113 -- 0x8000FFFF+++type SLGP_FLAGS = DWORD++sLGP_SHORTPATH :: SLGP_FLAGS+sLGP_SHORTPATH = 0x1++sLGP_UNCPRIORITY :: SLGP_FLAGS+sLGP_UNCPRIORITY = 0x2++sLGP_RAWPATH :: SLGP_FLAGS+sLGP_RAWPATH = 0x4++sLGP_RELATIVEPRIORITY :: SLGP_FLAGS+sLGP_RELATIVEPRIORITY = 0x8+++sTGM_READ :: DWORD+sTGM_READ = 0x00000000+++type COINITBASE = DWORD++cOINITBASE_MULTITHREADED :: COINITBASE+cOINITBASE_MULTITHREADED = 0x0++type COINIT = DWORD++cOINIT_APARTMENTTHREADED :: COINIT+cOINIT_APARTMENTTHREADED = 0x2++cOINIT_MULTITHREADED :: COINIT+cOINIT_MULTITHREADED = cOINITBASE_MULTITHREADED++cOINIT_DISABLE_OLE1DDE :: COINIT+cOINIT_DISABLE_OLE1DDE = 0x4++cOINIT_SPEED_OVER_MEMORY :: COINIT+cOINIT_SPEED_OVER_MEMORY  = 0x8+++foreign import WINDOWS_CCONV "objbase.h CoInitializeEx"+  c_CoInitializeEx :: LPVOID -> DWORD -> IO HRESULT++foreign import WINDOWS_CCONV "objbase.h CoUninitialize"+  c_CoUninitialize :: IO ()+++foreign import WINDOWS_CCONV "combaseapi.h CoCreateInstance"+  c_CoCreateInstance :: REFCLSID -> LPUNKNOWN -> DWORD -> REFIID -> Ptr LPVOID -> IO HRESULT+++foreign import WINDOWS_CCONV "shobjidl.h &CLSID_ShellLink"+  c_CLSID_ShellLink :: Ptr GUID++foreign import WINDOWS_CCONV "shobjidl.h &IID_IShellLinkW"+  c_IID_IShellLinkW :: Ptr GUID++foreign import WINDOWS_CCONV "shobjidl.h &IID_IPersistFile"+  c_IID_IPersistFile :: Ptr GUID