motor-reflection 0.2.0.0 → 0.3.0

raw patch · 4 files changed

+34/−30 lines, 4 filesdep +row-typesdep −CTRex

Dependencies added: row-types

Dependencies removed: CTRex

Files

• CHANGELOG.md +10/−0
• motor-reflection.cabal +4/−2
• src/Motor/FSM/Reflection.hs +12/−22
• test/Motor/FSM/ReflectionSpec.hs +8/−6

@@ -1,3 +1,13 @@+* 0.3.0+  - Use row-types instead of CTRex.+  - Rename `:->` operator to `:=`.+  - Provide better default constraints from using `Actions`.+  - Make `Actions` a data type and use it promoted.+  - Add `Remain` action.+  - Add `get` operator, returning the current state of a named+    resource.+  - Add `update` operator, mapping an update function over the current+    state of a named resource. * 0.2.0.0   - Add `motor-reflection` and `motor-diagrams` packages. * 0.1.1.0

@@ -1,5 +1,5 @@ name:                motor-reflection-version:             0.2.0.0+version:             0.3.0 synopsis:   Reflect on Motor FSM typeclasses to obtain runtime representations description:@@ -39,13 +39,15 @@   other-modules:     Motor.FSM.ReflectionSpec   hs-source-dirs:    test   main-is:           Spec.hs+   build-depends:     base                    , indexed-                   , CTRex+                   , row-types                    , hspec                    , hspec-discover                    , motor                    , motor-reflection+  build-tools:       hspec-discover   ghc-options:       -Wall                      -fno-warn-orphans                      -fno-warn-missing-signatures

@@ -58,35 +58,25 @@                 _constraints                 (AppT _ actions))) ->         map (Event (nameBase transitionName)) <$> actionsToTransitions tfName actions-    _ -> do-        reportWarning ("Unsupported type:" ++ show type')-        return []+    _ -> fail ("Unsupported type:" ++ show type')  actionsToTransitions :: Name -> Type -> Q [Transition] actionsToTransitions tfName =     \case-    SigT (AppT (AppT (AppT (AppT (ConT _actions) (VarT _m)) as) (VarT _r)) _) _ ->+    AppT (AppT (AppT (AppT (ConT _actions) (VarT _m)) as) (VarT _r)) _ ->         actionListToTransitions tfName as-    _ -> return []+    t -> fail ("Unsupported actions type: " ++ show t)  actionListToTransitions :: Name -> Type -> Q [Transition] actionListToTransitions tfName =-    \case-    SigT-        (AppT-        (AppT-            PromotedConsT-            action)-        actions)-        (AppT ListT StarT) ->-        mappend-        <$> actionToTransitions tfName action-        <*> actionListToTransitions tfName actions-    SigT PromotedNilT (AppT ListT StarT) ->-        return []-    t -> do-        reportWarning ("Unsupported action type: " ++ show t)-        return []+  \case+    AppT (AppT PromotedConsT action) actions ->+      mappend <$> actionToTransitions tfName action <*>+      actionListToTransitions tfName actions+    PromotedNilT  -> return []+    SigT app (AppT ListT _) ->+      actionListToTransitions tfName app+    t -> fail ("Unsupported action type: " ++ show t)  actionToTransitions :: Name -> Type -> Q [Transition] actionToTransitions tfName =@@ -105,7 +95,7 @@           opS -> fail ("Action infix operator not supported: " ++ opS)      AppT-        (AppT (ConT _assoc) (VarT _n))+        (AppT (PromotedT _assoc) (VarT _n))         (AppT         (AppT (ConT _to) (AppT (AppT (ConT tf1) (VarT _m1)) (ConT from)))         (AppT

@@ -1,9 +1,11 @@+{-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PolyKinds                  #-}+{-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE RebindableSyntax           #-} {-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE TemplateHaskell            #-}@@ -11,12 +13,12 @@ {-# LANGUAGE TypeOperators              #-} module Motor.FSM.ReflectionSpec where -import           Prelude                    hiding (log, (>>))+import           Prelude -import           Data.OpenRecords+import           Data.Row.Records import           Test.Hspec -import           Motor.FSM+import           Motor.FSM                  hiding (Add, Delete) import           Motor.FSM.Reflection import           Motor.FSM.Reflection.Event (Event) @@ -32,10 +34,10 @@     -> Actions m '[n !+ State m Standing] r ()   jump     :: Name n-    -> Actions m '[n :-> State m Standing !--> State m Jumping] r ()+    -> Actions m '[n := State m Standing !--> State m Jumping] r ()   land     :: Name n-    -> Actions m '[n :-> State m Jumping !--> State m Standing] r ()+    -> Actions m '[n := State m Jumping !--> State m Standing] r ()   perish     :: Name n     -> Actions m '[n !- State m Standing] r ()@@ -44,7 +46,7 @@  spec :: Spec spec =-  it "reflects events when using a State type family" $+  it "reflects events when using Actions" $     gameEvents `shouldBe` [ Event "spawn" (Add "Standing")                           , Event "jump" (Transition "Standing" "Jumping")                           , Event "land" (Transition "Jumping" "Standing")