pathfindingcore 1.2.1 → 1.3.0
raw patch · 11 files changed
+196/−50 lines, 11 filesdep +base-nopreludedep +bizzleludedep +textdep −HUnitdep −basedep ~arraydep ~pathfindingcoredep ~splitsetup-changed
Dependencies added: base-noprelude, bizzlelude, text
Dependencies removed: HUnit, base
Dependency ranges changed: array, pathfindingcore, split, tasty, tasty-hunit
Files
- Setup.hs +0/−4
- pathfindingcore.cabal +22/−11
- src/PathFindingCore/PathingMap.hs +14/−21
- src/PathFindingCore/PathingMap/Coordinate.hs +1/−0
- src/PathFindingCore/PathingMap/Interpreter.hs +7/−8
- src/PathFindingCore/PathingMap/Terrain.hs +1/−4
- src/PathFindingTest/TestSet.hs +2/−2
- test/BreadcrumbTests.hs +19/−0
- test/InstanceTests.hs +48/−0
- test/InterpreterTests.hs +42/−0
- test/PathingMapTests.hs +40/−0
− Setup.hs
@@ -1,4 +0,0 @@-import Distribution.Simple--main :: IO ()-main = defaultMainWithHooks simpleUserHooks
pathfindingcore.cabal view
@@ -1,6 +1,6 @@ Name: pathfindingcore-Version: 1.2.1-Cabal-version: >=1.16.0+Version: 1.3.0+Cabal-version: >=1.24.0 License: BSD3 License-File: LICENSE.txt Author: Jason Bertsche@@ -18,24 +18,35 @@ library hs-source-dirs: src exposed-modules: PathFindingCore.PathingMap, PathFindingCore.Status, PathFindingCore.PathingMap.Coordinate, PathFindingCore.PathingMap.Direction, PathFindingCore.PathingMap.Terrain, PathFindingCore.PathingMap.Interpreter, PathFindingTest.TestSet+ default-extensions: OverloadedStrings default-language: Haskell2010 build-depends:- array >= 0.4,- base >= 4.6 && < 5,- split >= 0.2+ array >= 0.5.2 && < 0.6.0,+ base-noprelude >= 4.8 && < 5,+ bizzlelude >= 1.1.0 && < 1.2.0,+ split >= 0.2.3 && < 0.3.0,+ text >= 1.2.3 && < 1.3.0 GHC-Options: -Wall+ -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wmissing-import-lists+ -Wredundant-constraints -fno-warn-name-shadowing+ -funbox-strict-fields test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test+ default-extensions: OverloadedStrings default-language: Haskell2010+ other-modules: BreadcrumbTests, InstanceTests, InterpreterTests, PathingMapTests build-depends:- array >= 0.4,- base >= 4.6 && < 5,- HUnit >= 1.2,- pathfindingcore >= 1.2,- tasty >= 0.10,- tasty-hunit >= 0.9+ array,+ base-noprelude,+ bizzlelude,+ pathfindingcore,+ tasty >= 1.0.1 && < 1.1.0,+ tasty-hunit >= 0.10.0 && < 0.11.0
src/PathFindingCore/PathingMap.hs view
@@ -1,25 +1,18 @@ {-# LANGUAGE FlexibleInstances, TupleSections #-} module PathFindingCore.PathingMap(findDirection, getTerrain, insertPath, markAsGoal, neighborsOf, PrintablePathingGrid(..), step) where -import Control.Arrow((>>>)) import Data.Array.IArray((!), (//), assocs, bounds)-import Data.Foldable(fold)-import Data.List(sortBy)-import Data.List.Split(chunksOf)-import Data.Maybe(fromMaybe)+import Data.List(filter, reverse, sortBy)+import Data.Text(chunksOf, replicate)+ import Text.Printf(printf) -import PathFindingCore.PathingMap.Coordinate(Coordinate(..))+import PathFindingCore.PathingMap.Coordinate(Coordinate(Coord, x)) import PathFindingCore.PathingMap.Direction(Direction(East, North, South, West), directions) import PathFindingCore.PathingMap.Interpreter(PathingGrid) import PathFindingCore.PathingMap.Terrain(isPassable, Terrain(Goal, Path, Query, Self), terrainToChar) -data PrintablePathingGrid- = PPG {- pathingGrid :: PathingGrid- }--a |> f = f a+newtype PrintablePathingGrid = PPG PathingGrid getTerrain :: Coordinate -> PathingGrid -> Maybe Terrain getTerrain coord@(Coord x y) grid = if isInBounds then Just $ grid ! coord else Nothing@@ -53,22 +46,22 @@ | y2 == y1 - 1 = South | x2 == x1 + 1 = East | x2 == x1 - 1 = West- | otherwise = error $ printf "Cannot find direction to non-adjacent coordinates (start: %s, end: %s)" (show startCoord) (show endCoord)+ | otherwise = error $ asText $ printf "Cannot find direction to non-adjacent coordinates (start: %s, end: %s)" (show startCoord) (show endCoord) instance Show PrintablePathingGrid where- show (PPG grid) = fold lines+ show (PPG grid) = asString $ fold lines where maxX = grid |> (bounds >>> snd >>> x >>> (+1))- str = grid |> (assocs >>> (sortBy sillySort) >>> (fmap $ snd >>> terrainToChar))- lines = str |> ((chunksOf maxX) >>> reverse >>> (makeLinesPretty maxX))+ text = grid |> (assocs >>> (sortBy sillySort) >>> (fmap $ snd >>> terrainToChar) >>> asText)+ lines = text |> ((chunksOf maxX) >>> reverse >>> (makeLinesPretty maxX)) -makeLinesPretty :: Int -> [String] -> [String]+makeLinesPretty :: Int -> [Text] -> [Text] makeLinesPretty maxX lines = concat [[topB], linesB, [botB]] where- linesB = fmap (\x -> "|" ++ x ++ "|\n") lines- border = replicate maxX '-'- topB = concat ["+", border, "+", "\n"]- botB = concat ["+", border, "+"]+ linesB = fmap (\x -> "|" <> x <> "|\n") lines+ border = replicate maxX "-"+ topB = "+" <> border <> "+" <> "\n"+ botB = "+" <> border <> "+" sillySort :: (Coordinate, Terrain) -> (Coordinate, Terrain) -> Ordering sillySort (Coord x1 y1, _) (Coord x2 y2, _) =
src/PathFindingCore/PathingMap/Coordinate.hs view
@@ -1,6 +1,7 @@ module PathFindingCore.PathingMap.Coordinate where import Data.Ix(Ix)+import Data.List(reverse) data Coordinate = Coord { x :: Int, y :: Int } deriving (Eq, Ix, Ord, Show)
src/PathFindingCore/PathingMap/Interpreter.hs view
@@ -1,9 +1,7 @@ module PathFindingCore.PathingMap.Interpreter(fromMapString, PathingGrid, PathingMapString(..), PathingMapData(..)) where -import Control.Arrow((>>>)) import Data.Array.IArray(Array, assocs, listArray)-import Data.Foldable(fold)-import Data.List(isSuffixOf)+import Data.List(drop, isSuffixOf, last, reverse, unzip) import Data.List.Split(splitOn) import PathFindingCore.PathingMap.Coordinate(Coordinate(Coord))@@ -13,8 +11,8 @@ data PathingMapString = PathingMapString {- str :: String,- delim :: String+ str :: Text,+ delim :: Text } deriving (Eq) data PathingMapData@@ -24,13 +22,12 @@ grid :: PathingGrid } deriving (Eq, Show) -a |> f = f a- fromMapString :: PathingMapString -> PathingMapData fromMapString (PathingMapString "" _) = error "Cannot build map from empty string" fromMapString (PathingMapString str delim) = PathingMapData start goal grid where- grid = str |> ((dropDelim delim) >>> (splitOn delim) >>> strListToGrid)+ sDelim = asString delim+ grid = str |> (asString >>> (dropDelim sDelim) >>> (splitOn sDelim) >>> strListToGrid) (start, goal) = findStartAndGoal grid dropDelim d s = if (isSuffixOf d s) then s |> (reverse >>> (drop $ length d) >>> reverse) else s @@ -51,9 +48,11 @@ findStartAndGoal :: PathingGrid -> (Coordinate, Coordinate) findStartAndGoal arr = analyzeResult $ foldr findBest (Nothing, Nothing) (assocs arr) where+ findBest (coord, Self) (_, g) = (Just coord, g) findBest (coord, Goal) (s, _) = (s, Just coord) findBest _ (s, g) = (s, g)+ analyzeResult (Nothing, _ ) = error "No start in given grid." analyzeResult (_, Nothing) = error "No goal in given grid." analyzeResult (Just start, Just goal) = (start, goal)
src/PathFindingCore/PathingMap/Terrain.hs view
@@ -1,8 +1,5 @@ module PathFindingCore.PathingMap.Terrain where -import Control.Applicative(pure)-import Control.Arrow((>>>))- data Terrain = Ant | Empty@@ -38,7 +35,7 @@ charToTerrain '*' = Self charToTerrain 'D' = Wall charToTerrain '%' = Water-charToTerrain x = error $ "Cannot convert '" ++ (show x) ++ "' to a terrain"+charToTerrain x = error $ "Cannot convert '" <> (showText x) <> "' to a terrain" terrainToChar :: Terrain -> Char terrainToChar Ant = 'a'
src/PathFindingTest/TestSet.hs view
@@ -1,6 +1,6 @@ module PathFindingTest.TestSet(PathingMapTest(..), tests) where -import PathFindingCore.PathingMap.Interpreter(PathingMapString(..))+import PathFindingCore.PathingMap.Interpreter(PathingMapString(PathingMapString)) data PathingMapTest = PathingMapTest { dist :: Maybe Double, pathingMapStr :: PathingMapString } @@ -11,7 +11,7 @@ ,testMap31, testMap32, testMap33, testMap34, testMap35, testMap36, testMap37, testMap38, testMap39 ] -pms :: String -> String -> PathingMapString+pms :: Text -> Text -> PathingMapString pms = flip PathingMapString testMap1 :: PathingMapTest
+ test/BreadcrumbTests.hs view
@@ -0,0 +1,19 @@+module BreadcrumbTests(tests) where++import Test.Tasty(testGroup, TestTree)+import Test.Tasty.HUnit((@?=), testCase)++import PathFindingCore.PathingMap.Coordinate(Breadcrumb(Crumb, Source), breadcrumbsToList, Coordinate(Coord))++tests = testGroup "Test breadcrumbs" [+ testIt "Simple source 1" (Source $ Coord 0 0) [Coord 0 0]+ , testIt "Simple source 2" (Source $ Coord 1 1) [Coord 1 1]+ , testIt "Simple source 3" (Source $ Coord 3 8) [Coord 3 8]+ , testIt "Two-item crumb" (Crumb (Coord 0 0) $ Source $ Coord 3 8) [(Coord 3 8), (Coord 0 0)]+ , testIt "Three-item crumb" (Crumb (Coord 1 7) $ Crumb (Coord 0 0) $ Source $ Coord 3 8) [(Coord 3 8), (Coord 0 0), (Coord 1 7)]+ ]++testIt :: Text -> Breadcrumb -> [Coordinate] -> TestTree+testIt desc crumbs coords = testCase (asString desc) assertion+ where+ assertion = (breadcrumbsToList crumbs) @?= coords
+ test/InstanceTests.hs view
@@ -0,0 +1,48 @@+module InstanceTests(tests) where++import Test.Tasty(testGroup, TestTree)+import Test.Tasty.HUnit((@?=), testCase)++import PathFindingCore.PathingMap(PrintablePathingGrid(PPG))+import PathFindingCore.PathingMap.Interpreter(fromMapString, grid, PathingMapString(PathingMapString))++tests = testGroup "Test instances" [+ testPPGInstance "Show PPG 1" " " expected1+ , testPPGInstance "Show PPG 2" "xG" expected2+ , testPPGInstance "Show PPG 3" "x|G" expected3+ , testPPGInstance "Show PPG 4" "x | G" expected4+ , testPPGInstance "Show PPG 5" actual5 expected5+ ]+ where+ actual5 = " D D|\+ \ x |\+ \ DDDD|\+ \D DG D|\+ \D DDDD"+ expected1 = "+-+\n\+ \| |\n\+ \+-+"+ expected2 = "+--+\n\+ \|xG|\n\+ \+--+"+ expected3 = "+-+\n\+ \|x|\n\+ \|G|\n\+ \+-+"+ expected4 = "+--+\n\+ \|x |\n\+ \| G|\n\+ \+--+"+ expected5 = "+------+\n\+ \| D D|\n\+ \| x |\n\+ \| DDDD|\n\+ \|D DG D|\n\+ \|D DDDD|\n\+ \+------+"++testPPGInstance :: Text -> Text -> Text -> TestTree+testPPGInstance desc strGrid expected = testCase (asString desc) assertion+ where+ actual = strGrid |> ((flip PathingMapString "|") >>> fromMapString >>> grid >>> PPG >>> showText)+ assertion = actual @?= expected
+ test/InterpreterTests.hs view
@@ -0,0 +1,42 @@+module InterpreterTests(tests) where++import Test.Tasty(testGroup, TestTree)+import Test.Tasty.HUnit((@?=), testCase)++import Data.Array.IArray(listArray)++import PathFindingCore.PathingMap.Coordinate(Coordinate(Coord))+import PathFindingCore.PathingMap.Interpreter(fromMapString, PathingMapData(PathingMapData), PathingMapString(PathingMapString))+import PathFindingCore.PathingMap.Terrain(Terrain(Empty, Goal, Mound, Self, Wall, Water))++tests = testGroup "Test interpreter" [+ testInterpreter "Simple grid" "*G" (0, 0) (1, 0) (1, 0) [Self, Goal]+ , testInterpreter "One-line grid 1" "* G" (0, 0) (7, 0) (7, 0) [Self, Empty, Empty, Empty, Empty, Empty, Empty, Goal]+ , testInterpreter "One-line grid 2" "G *" (7, 0) (0, 0) (7, 0) [Goal, Empty, Empty, Empty, Empty, Empty, Empty, Self]+ , testInterpreter "One-line grid 3" "G %D% *" (7, 0) (0, 0) (7, 0) [Goal, Empty, Water, Wall, Water, Empty, Empty, Self]+ , testInterpreter "Simple vertical grid" "*|G" (0, 1) (0, 0) (0, 1) [Goal, Self]+ , testInterpreter "One-line vert grid 1" "*| | | |G" (0, 4) (0, 0) (0, 4) [Goal, Empty, Empty, Empty, Self]+ , testInterpreter "One-line vert grid 2" "G| | | |*" (0, 0) (0, 4) (0, 4) [Self, Empty, Empty, Empty, Goal]+ , testInterpreter "One-line vert grid 3" "G| |%|D|*" (0, 0) (0, 4) (0, 4) [Self, Wall, Water, Empty, Goal]+ , testInterpreter "2x2 grid 1" "G | *" (1, 0) (0, 1) (1, 1) [Empty, Goal, Self, Empty]+ , testInterpreter "2x2 grid 2" "G*| " (1, 1) (0, 1) (1, 1) [Empty, Goal, Empty, Self]+ , testInterpreter "2x2 grid 3" "G*|DD" (1, 1) (0, 1) (1, 1) [Wall, Goal, Wall, Self]+ , testInterpreter "2x2 grid 4" "DD|*G" (0, 0) (1, 0) (1, 1) [Self, Wall, Goal, Wall]+ , testInterpreter "5x5 grid 1" m5x5p1 (3, 1) (1, 3) (4, 4) [Wall, Wall, Wall, Wall, Wall, Wall, Empty, Empty, Goal, Wall, Wall, Empty, Empty, Empty, Wall, Wall, Self, Empty, Empty, Wall, Wall, Wall, Wall, Wall, Wall]+ , testInterpreter "5x5 grid 2" m5x5p2 (0, 0) (2, 4) (4, 4) [Self, Wall, Water, Empty, Empty, Wall, Wall, Water, Wall, Wall, Empty, Empty, Water, Wall, Goal, Empty, Water, Water, Wall, Wall, Water, Water, Empty, Empty, Empty]+ , testInterpreter "Past troublemaker" trblmkr (4, 2) (1, 1) (4, 2) [Water, Mound, Empty, Empty, Goal, Water, Empty, Water, Empty, Empty, Empty, Empty, Empty, Water, Self]+ ]+ where+ m5x5p1 = "DDDDD|DG D|D D|D *D|DDDDD"+ m5x5p2 = " DGD | DDD |%%%% |DD %%|*D %"+ trblmkr = " % *|\+ \OG% %|\+ \% |"++testInterpreter :: Text -> Text -> (Int, Int) -> (Int, Int) -> (Int, Int) -> [Terrain] -> TestTree+testInterpreter desc strGrid (x1, y1) (x2, y2) (ux, uy) arr = testCase (asString desc) assertion+ where+ pmStr = PathingMapString strGrid "|"+ grid = listArray (Coord 0 0, Coord ux uy) arr+ pmData = PathingMapData (Coord x1 y1) (Coord x2 y2) grid+ assertion = (fromMapString pmStr) @?= pmData
+ test/PathingMapTests.hs view
@@ -0,0 +1,40 @@+module PathingMapTests(tests) where++import Test.Tasty(testGroup, TestTree)+import Test.Tasty.HUnit((@?=), testCase)++import PathFindingCore.PathingMap.Coordinate(Coordinate(Coord))+import PathFindingCore.PathingMap.Direction(Direction(East, North, South, West))+import PathFindingCore.PathingMap.Interpreter(fromMapString, grid, PathingGrid, PathingMapString(PathingMapString))+import PathFindingCore.PathingMap.Terrain(Terrain(Empty, Wall))+import PathFindingCore.PathingMap(findDirection, getTerrain, insertPath, markAsGoal, neighborsOf, step)++tests = testGroup "Test interpreter" [+ testInterpreter "getTerrain 1" (getTerrain $ Coord 9001 9001) Nothing+ , testInterpreter "getTerrain 2" (getTerrain $ Coord 1 1) $ Just Wall+ , testInterpreter "getTerrain 3" (getTerrain $ Coord 3 0) $ Just Empty+ , testInterpreter "neighborsOf 1" (neighborsOf $ Coord 9001 9001) []+ , testInterpreter "neighborsOf 2" (neighborsOf $ Coord 2 0) [Coord 2 1, Coord 3 0]+ , testInterpreter "neighborsOf 3" (neighborsOf $ Coord 3 0) [Coord 2 0]+ , testInterpreter "step" (step (Coord 2 0) (Coord 2 1)) $ gridFromString " DGD | DDD |%%%% |DD*%%|*D. %"+ , testInterpreter "markAsGoal 1" (markAsGoal $ Coord 2 0) $ gridFromString " DGD | DDD |%%%% |DD %%|*DG %"+ , testInterpreter "markAsGoal 2" (markAsGoal $ Coord 2 1) $ gridFromString " DGD | DDD |%%%% |DDG%%|*D %"+ , testInterpreter "insertPath 1" (insertPath cPath1) $ gridFromString " DGD | DDDx|%%%%x|DD %%|*D %"+ , testInterpreter "insertPath 2" (insertPath cPath2) $ gridFromString " DGD | DDD |%%%% |DDx%%|*Dxx%"+ , testInterpreter "insertPath 3" (insertPath []) $ gridFromString " DGD | DDD |%%%% |DD %%|*D %"+ , testInterpreter "findDirection 1" (\x -> findDirection (Coord 2 0) (Coord 2 1)) $ North+ , testInterpreter "findDirection 2" (\x -> findDirection (Coord 2 0) (Coord 3 0)) $ East+ , testInterpreter "findDirection 3" (\x -> findDirection (Coord 2 0) (Coord 1 0)) $ West+ ]+ where+ cPath1 = [(Coord 4 3), (Coord 4 2)]+ cPath2 = [(Coord 2 1), (Coord 2 0), (Coord 3 0)]++testInterpreter :: (Eq t, Show t) => Text -> (PathingGrid -> t) -> t -> TestTree+testInterpreter desc genActual expected = testCase (asString desc) assertion+ where+ grid = gridFromString " DGD | DDD |%%%% |DD %%|*D %"+ assertion = (genActual grid) @?= expected++gridFromString :: Text -> PathingGrid+gridFromString str = str |> ((flip PathingMapString "|") >>> fromMapString >>> grid)