semantic money: clean up code; separate monetary types out

Author: hellwolf

packages/spec-haskell/Makefile

@@ -32,7 +32,7 @@ build:
 build-test:
 	$(CABAL_TEST) v2-build all
 
-build-wasm: 
+build-wasm:
 	$(CABAL_WASM) v2-build -v --with-compiler wasm32-wasi-ghc --with-hc-pkg wasm32-wasi-ghc-pkg semantic-money
 	wasm32-wasi-ghc \
 		-odir $(PWD)/$(WASM_BUILDDIR)/wasm -hidir $(PWD)/$(WASM_BUILDDIR)/wasm -stubdir $(PWD)/$(WASM_BUILDDIR)/wasm \
@@ -58,6 +58,10 @@ test:
 	$(CABAL_TEST) v2-test all --enable-tests \
 		$(TEST_OPTIONS)
 
+test-sm:
+	$(CABAL_TEST) v2-test semantic-money --enable-tests \
+		$(TEST_OPTIONS)
+
 test-coverage:
 	$(CABAL_COVERAGE) v2-build all --enable-tests --enable-coverage
 	$(CABAL_COVERAGE) v2-test all --enable-tests --enable-coverage \

…ckages/spec-haskell/cabal.project.freeze …c-haskell/all.ghc94.cabal.project.freezepackages/spec-haskell/cabal.project.freeze renamed to packages/spec-haskell/all.ghc94.cabal.project.freeze packages/spec-haskell/cabal.project.freeze renamed to packages/spec-haskell/all.ghc94.cabal.project.freeze

@@ -22,6 +22,7 @@ library
     import:           optiongs
     hs-source-dirs:   src
     exposed-modules:
+        Money.Theory.MonetaryTypes
         Money.Theory.SemanticMoney
     -- other-modules:
     -- other-extensions:

packages/spec-haskell/pkgs/semantic-money/semantic-money.cabal

@@ -0,0 +1,45 @@
+{-# LANGUAGE DefaultSignatures      #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+module Money.Theory.MonetaryTypes where
+-- base
+import           Data.Kind (Type)
+
+
+-- | Type system trite: types used in semantic money
+--
+-- Note:
+--   * Index related types through associated type families.
+--   * Use type family dependencies to make these types to the index type injective.
+class ( Eq (MT_TIME mt), Ord (MT_TIME mt), Num (MT_TIME mt)
+      , Eq (MT_VALUE mt), Ord (MT_VALUE mt), Num (MT_VALUE mt)
+      , Eq (MT_UNIT mt), Ord (MT_UNIT mt), Num (MT_UNIT mt)
+      ) =>
+      MonetaryTypes mt where
+    mt_v_mul_t :: MT_VALUE mt -> MT_TIME mt -> MT_VALUE mt
+    default mt_v_mul_t ::
+        Integral (MT_TIME mt) =>
+        MT_VALUE mt -> MT_TIME mt -> MT_VALUE mt
+    mt_v_mul_t v t = v * (fromInteger . toInteger) t
+
+    mt_v_mul_u :: MT_VALUE mt -> MT_UNIT mt -> MT_VALUE mt
+    default mt_v_mul_u ::
+        Integral (MT_UNIT mt) =>
+        MT_VALUE mt -> MT_UNIT mt -> MT_VALUE mt
+    mt_v_mul_u v u = v * (fromInteger . toInteger) u
+
+    mt_v_div_u :: MT_VALUE mt -> MT_UNIT mt -> MT_VALUE mt
+    default mt_v_div_u ::
+        (Integral (MT_VALUE mt), Integral (MT_UNIT mt)) =>
+        MT_VALUE mt -> MT_UNIT mt -> MT_VALUE mt
+    mt_v_div_u v u = let u' = (fromInteger . toInteger) u in v `div` u'
+
+    mt_v_mul_u_qr_u :: MT_VALUE mt -> (MT_UNIT mt, MT_UNIT mt) -> (MT_VALUE mt, MT_VALUE mt)
+    default mt_v_mul_u_qr_u ::
+        (Integral (MT_VALUE mt), Integral (MT_UNIT mt)) =>
+        MT_VALUE mt -> (MT_UNIT mt, MT_UNIT mt) -> (MT_VALUE mt, MT_VALUE mt)
+    mt_v_mul_u_qr_u v (u1, u2) = (v * (fromInteger . toInteger) u1) `quotRem` (fromInteger . toInteger) u2
+
+    type family MT_TIME  mt = (t :: Type) | t -> mt
+    type family MT_VALUE mt = (v :: Type) | v -> mt
+    type family MT_UNIT  mt = (u :: Type) | u -> mt
+    -- TODO: Do we need FlowRate type?