Moja wersja jest podobna do tego, co Nicolas zrobił, ale zawierają odniesienie do sąsiedniej komórce w Boundary dokonać przesuwny wykres. Moje typy danych są
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
data Material = Rock | Air
data WallFeature = Lever | Picture | Button deriving Show
type family Other (t :: Material) :: Material
type instance Other Air = Rock
type instance Other Rock = Air
data Tile :: Material -> * where
RockTile :: Tile Rock
AirTile :: Tile Air
data Cell mat where
Cell
:: Tile mat
-> Maybe (Boundary mat n)
-> Maybe (Boundary mat s)
-> Maybe (Boundary mat e)
-> Maybe (Boundary mat w)
-> Cell mat
data Boundary (src :: Material) (dst :: Material) where
Same :: Cell mat -> Boundary mat mat
Diff :: WallFeature -> Cell (Other mat) -> Boundary mat (Other mat)
postanowiłem zrobić mapa ograniczona, więc każda komórka może lub nie może mieć sąsiadów (stąd Maybe typy na granicach).Typ danych Boundary to sparametryzowany na materiałach dwóch sąsiednich komórek i zawiera odniesienie do docelowej komórki, a cechy ścian są strukturalnie ograniczone do granic łączących komórki z różnych materiałów.
ten jest zasadniczo skierowany wykres tak między sobą adjancent komórki A i B jest granica typu Boundary matA matB od A do B, a granica typu Boundary matB matA z B do A. To umożliwia względem przylegania być asymetryczny, ale w praktyce możesz zdecydować w swoim kodzie, aby wszystkie relacje były symetryczne.
Teraz wszystko jest w porządku i dandy na poziomie teoretycznym, ale skonstruowanie rzeczywistego wykresu Cell jest dość uciążliwe. Tak więc, dla zabawy, przygotujmy DSL do definitywnego zdefiniowania relacji komórek, a następnie "zawiąż węzeł", aby uzyskać końcowy wykres.
Ponieważ komórki mają różne typy, nie można po prostu zapisać ich na liście tymczasowej lub Data.Map dla wiązania węzłów, więc zamierzam użyć pakietu vault. A Vault to bezpieczny dla rodzaju, polimorficzny pojemnik, w którym można przechowywać wszelkiego rodzaju dane i pobierać je w bezpieczny sposób, stosując kodowany typ. Tak więc, na przykład, jeśli masz Key String, możesz pobrać String z Vault, a jeśli masz Key Int, możesz pobrać wartość Int.
Zacznijmy od zdefiniowania operacji w DSL.
data Gen a
new :: Tile a -> Gen (Key (Cell a))
connectSame :: Connection a a -> Key (Cell a) -> Key (Cell a) -> Gen()
connectDiff
:: (b ~ Other a, a ~ Other b)
=> Connection a b -> WallFeature
-> Key (Cell a) -> Key (Cell b) -> Gen()
startFrom :: Key (Cell a) -> Gen (Cell a)
Typ Connection określa kierunki kardynalne gdzie jesteśmy łączące komórek i jest zdefiniowany następująco:
type Setter a b = Maybe (Boundary a b) -> Cell a -> Cell a
type Connection b a = (Setter a b, Setter b a)
north :: Setter a b
south :: Setter a b
east :: Setter a b
west :: Setter a b
Teraz możemy skonstruować prosty test mapę za pomocą naszych operacji:
testMap :: Gen (Cell Rock)
testMap = do
nw <- new RockTile
ne <- new AirTile
se <- new AirTile
sw <- new AirTile
connectDiff (west,east) Lever nw ne
connectSame (north,south) ne se
connectSame (east,west) se sw
connectDiff (south,north) Button sw nw
startFrom nw
Mimo że nie wdrożyliśmy jeszcze funkcji, widzimy, że tego typu kontrole. Ponadto, jeśli spróbujesz umieścić niespójne typy (np. Łącząc te same typy płytek za pomocą funkcji ściany), pojawi się błąd typu.
typu beton mam zamiar używać do Gen jest
type Gen = ReaderT Vault (StateT Vault IO)
monady baza jest IO dlatego, że jest to wymagane do tworzenia nowych Vault kluczy (możemy również użyć ST ale jest to nieco prostsze). Używamy State Vault do przechowywania nowo utworzonych komórek i dodawania do nich nowych granic, używając klucza Vault, aby jednoznacznie identyfikować komórkę i odnosić się do niej w operacjach DSL.
Trzecią monadą stosu jest Reader Vault, która służy do uzyskania dostępu do skarbca w jego całkowicie skonstruowanym stanie. To znaczy. podczas budowania skarbca w State możemy użyć Reader do "zobaczenia w przyszłość", gdzie skarbiec zawiera już wszystkie komórki z ich ostatecznymi granicami. W praktyce osiąga się to przez użycie mfix, aby uzyskać "monadyczny stały punkt" (więcej szczegółów można znaleźć na przykład w dokumencie "Value Recursion in Monadic Computations" lub MonadFix wiki page).
Tak, aby uruchomić naszej mapie konstruktora, definiujemy
import Control.Monad.State
import Control.Monad.Reader
import Data.Vault.Lazy as V
runGen :: Gen a -> IO a
runGen g = fmap fst $ mfix $ \(~(_, v)) -> runStateT (runReaderT g v) V.empty
Tutaj prowadzimy pełnostanowego obliczeń i wyjść wartość typu (a, Vault) tj wyniku z obliczeń i skarbca, który zawiera wszystkie nasze komórki. Przez mfix możemy uzyskać dostęp do wyniku przed jego obliczeniem, więc możemy wprowadzić przechowalnię wyników jako parametr do runReaderT. W związku z tym wewnątrz monady możemy użyć get (od MonadState), aby uzyskać dostęp do niekompletnego skarbca, który jest tworzony i ask (od MonadReader), aby uzyskać dostęp do w pełni zakończonego skarbca.
Teraz reszta wdrożenia jest prosta:
new :: Tile a -> Gen (Key (Cell a))
new t = do
k <- liftIO $ newKey
modify $ V.insert k $ Cell t Nothing Nothing Nothing Nothing
return k
new tworzy nowy klucz przechowalni i używa go, aby wstawić nową komórkę bez granic.
connectSame :: Connection a a -> Key (Cell a) -> Key (Cell a) -> Gen()
connectSame (s2,s1) ka kb = do
v <- ask
let b1 = fmap Same $ V.lookup kb v
b2 = fmap Same $ V.lookup ka v
modify $ adjust (s1 b1) ka . adjust (s2 b2) kb
connectSame dostęp do skarbca „przyszłą” via ask więc możemy spojrzeć na sąsiednią komórkę stamtąd i przechowywać go w granicy.
connectDiff
:: (b ~ Other a, a ~ Other b)
=> Connection a b -> WallFeature
-> Key (Cell a) -> Key (Cell b) -> Gen()
connectDiff (s2, s1) wf ka kb = do
v <- ask
let b1 = fmap (Diff wf) $ V.lookup kb v
b2 = fmap (Diff wf) $ V.lookup ka v
modify $ adjust (s1 b1) ka . adjust (s2 b2) kb
connectDiff jest niemal tak samo z tym że możemy zapewnić dodatkową funkcję ściana. Potrzebujemy również wyraźnego ograniczenia: (b ~ Other a, a ~ Other b) do skonstruować dwie symetryczne granice.
startFrom :: Key (Cell a) -> Gen (Cell a)
startFrom k = fmap (fromJust . V.lookup k) ask
startFrom tylko pobiera zakończone komórka z danym kluczu więc możemy wrócić go jako wynik z naszego generatora.
Oto pełna przykład źródło dodatkowe Show przypadkach do debugowania, więc można spróbować samemu:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Monad.State
import Control.Monad.Reader
import Data.Vault.Lazy as V
import Data.Maybe
data Material = Rock | Air
data WallFeature = Lever | Picture | Button deriving Show
type family Other (t :: Material) :: Material
type instance Other Air = Rock
type instance Other Rock = Air
data Tile :: Material -> * where
RockTile :: Tile Rock
AirTile :: Tile Air
data Cell mat where
Cell
:: Tile mat
-> Maybe (Boundary mat n)
-> Maybe (Boundary mat s)
-> Maybe (Boundary mat e)
-> Maybe (Boundary mat w)
-> Cell mat
data Boundary (a :: Material) (b :: Material) where
Same :: Cell mat -> Boundary mat mat
Diff :: WallFeature -> Cell (Other mat) -> Boundary mat (Other mat)
type Gen = ReaderT Vault (StateT Vault IO)
type Setter a b = Maybe (Boundary a b) -> Cell a -> Cell a
type Connection b a = (Setter a b, Setter b a)
-- Boundary setters
north :: Setter a b
north n (Cell t _ s e w) = Cell t n s e w
south :: Setter a b
south s (Cell t n _ e w) = Cell t n s e w
east :: Setter a b
east e (Cell t n s _ w) = Cell t n s e w
west :: Setter a b
west w (Cell t n s e _) = Cell t n s e w
new :: Tile a -> Gen (Key (Cell a))
new t = do
k <- liftIO $ newKey
modify $ V.insert k $ Cell t Nothing Nothing Nothing Nothing
return k
connectSame :: Connection a a -> Key (Cell a) -> Key (Cell a) -> Gen()
connectSame (s2,s1) ka kb = do
v <- ask
let b1 = fmap Same $ V.lookup kb v
b2 = fmap Same $ V.lookup ka v
modify $ adjust (s1 b1) ka . adjust (s2 b2) kb
connectDiff
:: (b ~ Other a, a ~ Other b)
=> Connection a b -> WallFeature
-> Key (Cell a) -> Key (Cell b) -> Gen()
connectDiff (s2, s1) wf ka kb = do
v <- ask
let b1 = fmap (Diff wf) $ V.lookup kb v
b2 = fmap (Diff wf) $ V.lookup ka v
modify $ adjust (s1 b1) ka . adjust (s2 b2) kb
startFrom :: Key (Cell a) -> Gen (Cell a)
startFrom k = fmap (fromJust . V.lookup k) ask
runGen :: Gen a -> IO a
runGen g = fmap fst $ mfix $ \(~(_, v)) -> runStateT (runReaderT g v) V.empty
testMap :: Gen (Cell Rock)
testMap = do
nw <- new RockTile
ne <- new AirTile
se <- new AirTile
sw <- new AirTile
connectDiff (west,east) Lever nw ne
connectSame (north,south) ne se
connectSame (east,west) se sw
connectDiff (south,north) Button sw nw
startFrom nw
main :: IO()
main = do
c <- runGen testMap
print c
-- Show Instances
instance Show (Cell mat) where
show (Cell t n s e w)
= unwords ["Cell", show t, show n, show s, show e, show w]
instance Show (Boundary a b) where
show (Same _) = "<Same>"
show (Diff wf _) = "<Diff with " ++ show wf ++ ">"
instance Show (Tile mat) where
show RockTile = "RockTile"
show AirTile = "AirTile"
jest mapa skończony? Czy powinien być wcześniej zdefiniowany? – Nicolas
Cieszę się, że mapa jest skończona, nieskończona lub torus, cokolwiek możesz zrobić. – fadedbee
Może być predefiniowany, ale struktura powinna być strukturalnie niezdolna do trzymania "cechy" w granicach między dwiema komórkami tego samego typu. – fadedbee