call-alloy 0.4 → 0.4.0.1

raw patch · 5 files changed

+26/−8 lines, 5 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• call-alloy.cabal +3/−1
• src/Language/Alloy/Call.hs +4/−2
• src/Language/Alloy/Internal/Call.hs +1/−1
• src/Language/Alloy/Parser.hs +13/−4

@@ -4,6 +4,11 @@  ## Released changes +### 0.4.0.1++- fix too early abortion of process execution+- show raw output on library parsing issues+ ### 0.4  - provide required Java libraries in package data directory

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           call-alloy-version:        0.4+version:        0.4.0.1 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@@ -61,6 +61,7 @@     , mtl >=2.2 && <2.4     , process ==1.6.*     , split ==0.2.*+    , transformers >=0.5.0.0 && <0.7     , trifecta >=2 && <2.2   default-language: Haskell2010   if os(windows)@@ -102,6 +103,7 @@     , mtl >=2.2 && <2.4     , process ==1.6.*     , split ==0.2.*+    , transformers >=0.5.0.0 && <0.7     , trifecta >=2 && <2.2   default-language: Haskell2010   if os(windows)

@@ -27,6 +27,8 @@ import Language.Alloy.Types             as Types   (AlloyInstance, AlloySig, Entries, Object, Signature) +import Control.Monad.Trans.Except       (runExceptT)+ {-| This function may be used to get all model instances for a given Alloy specification. It calls Alloy via a Java interface and parses the raw instance@@ -55,8 +57,8 @@   -- ^ The Alloy specification which should be loaded.   -> IO [AlloyInstance] getInstancesWith config content =-  map (either (error . show) id . parseInstance)-  <$> getRawInstancesWith config content+  getRawInstancesWith config content+  >>= mapM (fmap (either (error . show) id) . runExceptT . parseInstance)  {-| Check if there exists a model for the given specification. This function calls

@@ -147,11 +147,11 @@         hPutStr hin content         hFlush hin         hClose hin-        printContentOnError ph   withTimeout hin hout herr ph (timeout config) $ do     (out, err) <- fst <$> concurrently       (concurrently (getOutput hout) (getOutput herr))       evaluateAlloy+    printContentOnError ph     let err' = removeInfoLines err     unless (null err') $ fail $ unpack $ BS.unlines err'     return $ fmap (BS.intercalate "\n")

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-| Module      : Language.Alloy.Parser@@ -16,12 +17,14 @@   parseInstance,   ) where +import qualified Data.ByteString.Char8            as BS (putStrLn) import qualified Data.Set                         as S (fromList) import qualified Data.Map                         as M   (alter, empty, insert, singleton)  import Control.Applicative              ((<|>)) import Control.Monad                    (void)+import Control.Monad.IO.Class           (MonadIO (liftIO)) import Control.Monad.Except             (MonadError, throwError) import Data.ByteString                  (ByteString) import Data.Functor                     (($>))@@ -45,15 +48,21 @@ Parse an Alloy instance from a given String. May fail with 'ErrInfo'. -}-parseInstance :: (MonadError ErrInfo m) => ByteString -> m AlloyInstance+parseInstance+  :: (MonadIO m, MonadError ErrInfo m)+  => ByteString+  -> m AlloyInstance parseInstance inst = case parseByteString alloyInstance mempty inst of-  Failure l -> throwError l+  Failure l -> do+    liftIO $ BS.putStrLn "Failed parsing Alloys response as AlloyInstance:"+    liftIO $ BS.putStrLn inst+    throwError l   Success r -> return $ combineEntries r  combineEntries :: [Entries (,)] -> AlloyInstance-combineEntries = foldl createOrInsert M.empty+combineEntries = foldr createOrInsert M.empty   where-    createOrInsert ys (s, e) = M.alter (Just . alterSig e) s ys+    createOrInsert (s, e) ys = M.alter (Just . alterSig e) s ys     alterSig e Nothing  = e { relation = uncurry M.singleton $ relation e}     alterSig e (Just y) = y { relation = uncurry M.insert (relation e) (relation y) }