MonoidMusician · June 6, 2022 15:10 · Jun 6, 2022
diff --git a/Metalanguage.purs b/Metalanguage.purs
@@ -0,0 +1,73 @@
+module Metalanguage where
+
+import Prelude
+
+import Data.Array as Array
+import Data.Maybe (Maybe(..))
+import Data.Traversable (sequence, traverse)
+
+data Value = ScalarValue String | VectorValue (Array Value)
+data Sization = NonEmpty | Any
+derive instance eqSization :: Eq Sization
+derive instance ordSization :: Ord Sization
+
+data BasicSubsetF a
+  = Singleton String
+  | AnyScalar Sization
+  | ListOf Sization a
+  | ListLike (Array a)
+
+newtype BasicSubset = BasicSubset (BasicSubsetF BasicSubset)
+data Subset
+  = Basic (BasicSubsetF Subset)
+  | Union Subset
+
+singleton :: Value -> BasicSubset
+singleton = BasicSubset <<< case _ of
+  ScalarValue s -> Singleton s
+  VectorValue vs -> ListLike (singleton <$> vs)
+
+demonstrate :: BasicSubset -> Value
+demonstrate (BasicSubset bs) = case bs of
+  Singleton s -> ScalarValue s
+  AnyScalar Any -> ScalarValue ""
+  AnyScalar NonEmpty -> ScalarValue "0"
+  ListOf Any _ -> VectorValue []
+  ListOf NonEmpty bs' -> VectorValue [demonstrate bs']
+  ListLike vs -> VectorValue (demonstrate <$> vs)
+
+overlap :: BasicSubset -> BasicSubset -> Maybe BasicSubset
+overlap = case _, _ of
+  BasicSubset s1, BasicSubset s2 -> BasicSubset <$> case s1, s2 of
+    Singleton v1, Singleton v2 ->
+      if v1 == v2 then Just (Singleton v1) else Nothing
+    Singleton "", AnyScalar Any -> Just (Singleton "")
+    AnyScalar Any, Singleton "" -> Just (Singleton "")
+    Singleton "", AnyScalar NonEmpty -> Nothing
+    AnyScalar NonEmpty, Singleton "" -> Nothing
+    AnyScalar _, Singleton s -> Just (Singleton s)
+    Singleton s, AnyScalar _ -> Just (Singleton s)
+    AnyScalar z1, AnyScalar z2 -> Just $ AnyScalar (min z1 z2)
+
+    Singleton _, ListOf _ _ -> Nothing
+    ListOf _ _, Singleton _ -> Nothing
+    Singleton _, ListLike _ -> Nothing
+    ListLike _, Singleton _ -> Nothing
+    AnyScalar _, ListOf _ _ -> Nothing
+    ListOf _ _, AnyScalar _ -> Nothing
+    AnyScalar _, ListLike _ -> Nothing
+    ListLike _, AnyScalar _ -> Nothing
+
+    ListOf NonEmpty _, ListLike [] -> Nothing
+    ListLike [], ListOf NonEmpty _ -> Nothing
+    ListOf _ p_, ListLike ps ->
+      ListLike <$> traverse (overlap p_) ps
+    ListLike ps, ListOf _ p_ ->
+      ListLike <$> traverse (flip overlap p_) ps
+
+    ListOf z1 p1_, ListOf z2 p2_ ->
+      ListOf (min z1 z2) <$> overlap p1_ p2_
+    ListLike ps1, ListLike ps2 ->
+      if Array.length ps1 == Array.length ps2
+      then ListLike <$> sequence (Array.zipWith overlap ps1 ps2)
+      else Nothing
No results found