diff --git a/Data/DEVS/Devs.hs b/Data/DEVS/Devs.hs --- a/Data/DEVS/Devs.hs +++ b/Data/DEVS/Devs.hs @@ -153,7 +153,8 @@ -> Z i j IntCoup :: ((Y i) -> (X j)) -> Z i j - OutCoup :: ((Y i) -> (Y j)) -> Z i j + OutCoup :: ((Y i) -> (Y j)) + -> Z i j -- $references diff --git a/Example.hs b/Example.hs deleted file mode 100644 --- a/Example.hs +++ /dev/null @@ -1,137 +0,0 @@ -module Main where - -import Data.DEVS.Simulation -import Example.Ship - - - -{- - --- --- SHIP --- -data Ship = Ship { - ship_mass :: Mass Double, - ship_init_x :: Length Double, - ship_init_y :: Length Double, - ship_engine :: Engine -} deriving (Typeable) - -data ShipCmd = ShipSetSpeed (Velocity Double) | ShipSetHeading (PlaneAngle Double) - deriving (Eq, Ord) -data ShipEvent = ShipEventEngines Bool - -instance Model Ship where - type X Ship = ShipCmd - type Y Ship = ShipEvent - data S Ship = - ShipState { - ship_x :: Length Double, - ship_y :: Length Double, - ship_bearing :: PlaneAngle Double, - ship_vx :: Velocity Double, - ship_vy :: Velocity Double, - ship_thrust :: Thrust Double, - ship_set_hdg :: PlaneAngle Double, - ship_set_v :: Velocity Double - } - s0 ship = ShipState - { ship_x = ship_init_x ship - , ship_y = ship_init_y ship - , ship_bearing = 0 *~ degree - , ship_vx = 0 *~ (meter / second) - , ship_vy = 0 *~ (meter / second) - , ship_thrust = 0 *~ (newton) - , ship_set_hdg = 0 *~ degree - , ship_set_v = 0 *~ (meter / second) - } - -instance DEVS Ship where - lambda m s = undefined --ShipEventEngines (ship_v s == ship_set_v s) - ta m s = t_infinity - delta_int m s = s - delta_ext m s t xs = - let a = ((ship_thrust s) / (ship_mass m)) - ax = a * cos (ship_bearing s) - ay = a * sin (ship_bearing s) - s' = s { ship_vx = ship_vx s + (ax * t) - , ship_vy = ship_vy s + (ay * t) - , ship_x = ship_x s + (ship_vx s * t) - , ship_y = ship_y s + (ship_vy s * t) - } - in s - delta_con m s xs = undefined - - - ---x = f / m - -eng1 = Engine { engine_a = 1000 *~ newton, engine_rate = 13 *~ (liter / minute)} -eng1_sim = engineSim eng1 - -instance CoupledModel Ship - --- --- TANK --- - - - -instance DEVS Tank where - - - - - - - -instance ProcessorModel Tank where --- --- ENGINE --- - -data Engine = Engine { - engine_a :: Thrust Double, - engine_rate :: FlowRate Double - } deriving (Typeable) - -data EngineCmd = EngineEnable | EngineDisable - deriving (Ord, Eq) - -instance Binary EngineCmd where - -data EngineEvent = EngineEventThrust (Thrust Double) - deriving (Typeable) - -instance Binary EngineEvent where - -instance Model Engine where - type X Engine = EngineCmd - type Y Engine = EngineEvent - data S Engine = - EngineState { - engine_enabled :: Bool - } - s0 _ = EngineState { engine_enabled = False } - -instance DEVS Engine where - lambda m s = EngineEventThrust $ - if (engine_enabled s) - then engine_a m - else 0 *~ newton - delta_int _ s = s - delta_ext m s t xs = delta_con m s xs - delta_con m s xs = - let es = engine_enabled s - sw = Set.member (if es then EngineDisable else EngineEnable) xs - es' = if sw then not es else es - in s { engine_enabled = es' } - ta m _ = t_infinity - -instance ProcessorModel Engine where - - -engineSim :: Engine -> Simulator Engine -engineSim = mkSimulator - --} diff --git a/Example/Example.hs b/Example/Example.hs new file mode 100644 --- /dev/null +++ b/Example/Example.hs @@ -0,0 +1,9 @@ +module Main (main) where + +import Data.DEVS.Simulation +import Example.Ship + +main :: IO () +main = do + return () + diff --git a/Test/Tests.hs b/Test/Tests.hs new file mode 100644 --- /dev/null +++ b/Test/Tests.hs @@ -0,0 +1,21 @@ +module Main (main) where + +import Data.Monoid +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 +import Test.HUnit +import Test.QuickCheck + +main :: IO () +main = defaultMainWithOpts + [ testCase "rev" testRev + , testProperty "listRevRevId" propListRevRevId + ] mempty + +testRev :: Assertion +testRev = reverse [1, 2, 3] @?= [3, 2, 1] + +propListRevRevId :: [Int] -> Property +propListRevRevId xs = not (null xs) ==> reverse (reverse xs) == xs + diff --git a/lambda-devs.cabal b/lambda-devs.cabal --- a/lambda-devs.cabal +++ b/lambda-devs.cabal @@ -1,78 +1,34 @@ --- Initial lambda-devs.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - --- The name of the package. name: lambda-devs - --- The package version. See the Haskell package versioning policy (PVP) --- for standards guiding when and how versions should be incremented. --- http://www.haskell.org/haskellwiki/Package_versioning_policy --- PVP summary: +-+------- breaking API changes --- | | +----- non-breaking API additions --- | | | +--- code changes with no API change -version: 0.3.1 +version: 0.4.0 stability: alpha - --- A short (one-line) description of the package. synopsis: a Paralell-DEVS implementaion based on distributed-process description: The Discrete Event System Sepcification (DEVS) formalism defines discrete event simulation models in a hierachical, modular manner. --- A longer description of the package. --- description: - --- URL for the project homepage or repository. homepage: http://github.com/alios/lambda-devs - --- The license under which the package is released. license: BSD3 - --- The file containing the license text. license-file: LICENSE - --- The package author(s). author: Markus Barenhoff - --- An email address to which users can send suggestions, bug reports, and --- patches. maintainer: alios@alios.org - --- A copyright notice. --- copyright: - category: Control, Simulation - build-type: Simple - --- Extra files to be distributed with the package, such as examples or a --- README. extra-source-files: README.md, LICENSE - --- Constraint on the version of Cabal needed to build this package. cabal-version: >=1.10 - tested-with: GHC == 7.6.3 - source-repository head type: git location: https://github.com/alios/lambda-devs.git library - -- Modules exported by the library. exposed-modules: Data.DEVS, Data.DEVS.Devs Data.DEVS.Simulation Data.DEVS.Simulation.Processor Data.DEVS.Simulation.Simulator - Data.DEVS.Simulation.Coordinator - - -- Modules included in this library but not exported. + Data.DEVS.Simulation.Coordinator other-modules: Data.DEVS.Simulation.Infinite - - - -- LANGUAGE extensions used by modules in this package. other-extensions: MultiParamTypeClasses, DeriveDataTypeable, GADTs, @@ -82,31 +38,44 @@ UndecidableInstances, ExistentialQuantification, FunctionalDependencies + build-depends: base >=4.6 && < 5, + binary >=0.5, + containers >=0.5, + distributed-process >=0.4, + dimensional >= 0.12 + default-language: Haskell2010 + ghc-options: -Wall - - -- Other library packages from which modules are imported. - build-depends: base >=4.6 && <= 5, +Test-suite lambda-devs-tests + hs-source-dirs: Test, . + main-is: Tests.hs + type: exitcode-stdio-1.0 + build-depends: base >=4.6 && < 5, binary >=0.5, containers >=0.5, distributed-process >=0.4, - dimensional >= 0.12 - - -- Directories containing source files. - -- hs-source-dirs: - - -- Base language which the package is written in. + dimensional >= 0.12 default-language: Haskell2010 - + ghc-options: -Wall + other-extensions: MultiParamTypeClasses, + DeriveDataTypeable, + TypeFamilies + build-depends: test-framework, + test-framework-hunit, + test-framework-quickcheck2, + HUnit, + QuickCheck + executable lambda-devs-example main-is: Example.hs - build-depends: base >= 4.6 && <= 5, + hs-source-dirs: Example + build-depends: base >= 4.6 && < 5, binary >= 0.5, containers >= 0.5, distributed-process >= 0.4, - lambda-devs >= 0.3, + lambda-devs >= 0.4, numtype >= 1.0, dimensional >= 0.12 - - - default-language: Haskell2010 + default-language: Haskell2010 + ghc-options: -Wall