call-alloy 0.1.0.0 → 0.1.0.2
raw patch · 2 files changed
+108/−10 lines, 2 filesdep +Win32dep +unixPVP ok
version bump matches the API change (PVP)
Dependencies added: Win32, unix
API changes (from Hackage documentation)
Files
- call-alloy.cabal +16/−2
- src/Language/Alloy/Call.hs +92/−8
call-alloy.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: cb90623890ff4edd9f37856fc196d7ff619272da4c3519f2c2d1c082670a936a+-- hash: 54c29a66869bf88b9365e7543b6507d23efdcb3cdac0ac437540d41f4ca0e8c0 name: call-alloy-version: 0.1.0.0+version: 0.1.0.2 synopsis: A simple library to call Alloy given a specification description: Please see the README on GitHub at <https://github.com/marcellussiegburg/call-alloy#readme> category: Language@@ -48,6 +48,13 @@ , hashable , process , split+ if os(windows)+ cpp-options: -DWINDOWS+ build-depends:+ Win32+ else+ build-depends:+ unix default-language: Haskell2010 test-suite call-alloy-test@@ -70,4 +77,11 @@ , hspec , process , split+ if os(windows)+ cpp-options: -DWINDOWS+ build-depends:+ Win32+ else+ build-depends:+ unix default-language: Haskell2010
src/Language/Alloy/Call.hs view
@@ -11,6 +11,7 @@ A requirement for this library to work is a Java Runtime Environment (as it is required by Alloy). -}+{-# LANGUAGE CPP #-} module Language.Alloy.Call ( existsInstance, getInstances,@@ -23,18 +24,35 @@ import Data.IORef (IORef, newIORef, readIORef) import Data.List (intercalate) import Data.List.Split (splitOn)-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, isJust) import System.Directory- (XdgDirectory (..), createDirectoryIfMissing, doesFileExist, getXdgDirectory)+ (XdgDirectory (..), createDirectory, doesFileExist, doesDirectoryExist,+ getTemporaryDirectory, getXdgDirectory)+import System.Directory.Internal (setFileMode)+import System.Directory.Internal.Prelude+ (catch, isDoesNotExistError)+import System.Environment (lookupEnv) import System.Exit (ExitCode (..))-import System.FilePath ((</>), (<.>), searchPathSeparator)+import System.FilePath+ ((</>), (<.>), searchPathSeparator, takeDirectory) import System.IO (hClose, hGetLine, hIsEOF, hPutStr) import System.IO.Unsafe (unsafePerformIO) import System.Process+#if defined(mingw32_HOST_OS)+import System.Win32.Info (getUserName)+#else+import System.Posix.User (getLoginName)+#endif import Language.Alloy.RessourceNames (alloyJarName, className, classPackage) import Language.Alloy.Ressources (alloyJar, classFile) +data CallAlloyConfig = Config {+ alloyJarFile :: FilePath,+ alloyClassFile :: FilePath,+ keepFiles :: Bool+ }+ {-# NOINLINE mclassPath #-} {-| 'IORef' for storing the class path.@@ -95,7 +113,59 @@ mclassPath' <- readIORef mclassPath maybe readClassPath return mclassPath' +{-+jarFileEnv :: String+jarFileEnv = "ALLOY_JAR_FILE"++callAlloyEnv :: String+callAlloyEnv = "CALL_ALLOY_CLASS_FILE"++keepFilesEnv :: String+keepFilesEnv = "KEEP_ALLOY_FILES"+ {-|+Lookup environment variables which are to prefer if present.+-}+getEnvironmentInformation :: IO CallAlloyConfig+getEnvironmentInformation = do+ alloy <- lookupEnv jarFileEnv+ callAlloy <- lookupEnv callAlloyEnv+ keep <- lookupEnv keepFilesEnv+ let mconfig = Config <$> alloy <*> callAlloy <*> pure (isJust keep)+ case mconfig of+ Nothing -> do+ dataDir <- getXdgDirectory XdgData $ appName </> "dataDir" + Just c -> return c+-}+{-+getVersionFile :: IO FilePath+getVersionFile = do+ configDir <- getXdgDirectory XdgConfig appName+ let versionFile = configDir </> "version"+ exists <- doesFileExist versionFile+ if exists+ then do+ version <- read <$> readFile versionFile+ unless (version == versionHash) $ createVersionFile configDir versionFile+ else createVersionFile configDir versionFile +-}++fallbackToTempDir :: IO FilePath -> IO FilePath+fallbackToTempDir m = catch m $ \e ->+ if isDoesNotExistError e+ then do+ tmp <- getTemporaryDirectory+#if defined(mingw32_HOST_OS)+ login <- getUserName+#else+ login <- getLoginName+#endif+ let tmpDir = tmp </> show (hash login) </> appName+ createUserDirectoriesIfMissing $ tmpDir+ return tmpDir+ else error $ show e++{-| Read the class path version specified in the user directory, if it is not current or if it does not exist, call 'createVersionFile'. @@ -103,7 +173,7 @@ -} readClassPath :: IO FilePath readClassPath = do- configDir <- getXdgDirectory XdgConfig appName+ configDir <- fallbackToTempDir $ getXdgDirectory XdgConfig appName let versionFile = configDir </> "version" exists <- doesFileExist versionFile if exists@@ -121,7 +191,7 @@ createVersionFile :: FilePath -> FilePath -> IO () createVersionFile configDir versionFile = do createDataDir- createDirectoryIfMissing True configDir+ createUserDirectoriesIfMissing configDir writeFile versionFile $ show versionHash {-|@@ -131,12 +201,26 @@ -} createDataDir :: IO () createDataDir = do- dataDir <- getXdgDirectory XdgData $ appName </> "dataDir"- createDirectoryIfMissing True $ dataDir </> classPackage+ dataDir <- fallbackToTempDir $ getXdgDirectory XdgData $ appName </> "dataDir"+ createUserDirectoriesIfMissing $ dataDir </> classPackage BS.writeFile (dataDir </> classPackage </> className <.> "class") classFile BS.writeFile (dataDir </> alloyJarName) alloyJar {-|+Creates user directories using the file permissions 700.+This function creates the specified directory and all its parent directories as+well (if they are also missing).+-}+createUserDirectoriesIfMissing :: FilePath -> IO ()+createUserDirectoriesIfMissing fp = do+ isDir <- doesDirectoryExist fp+ let parent = takeDirectory fp+ unless (isDir || parent == fp) $ do+ createUserDirectoriesIfMissing parent+ createDirectory fp+ setFileMode fp (7*8*8)++{-| Check if there exists a model for the given specification. This function calls Alloy retrieving one instance. If there is no such instance, it returns false. This function calls 'getInstances'.@@ -145,7 +229,7 @@ :: String -- ^ The Alloy specification which should be loaded. -> IO Bool- -- ^ Whether there exists a instance (within the given scope)+ -- ^ Whether there exists an instance (within the given scope) existsInstance = fmap (not . null) . getInstances (Just 1) {-|