diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,4 +0,0 @@ -import Distribution.Simple - -main :: IO () -main = defaultMainWithHooks simpleUserHooks diff --git a/pathfindingcore.cabal b/pathfindingcore.cabal --- a/pathfindingcore.cabal +++ b/pathfindingcore.cabal @@ -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 diff --git a/src/PathFindingCore/PathingMap.hs b/src/PathFindingCore/PathingMap.hs --- a/src/PathFindingCore/PathingMap.hs +++ b/src/PathFindingCore/PathingMap.hs @@ -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, _) = diff --git a/src/PathFindingCore/PathingMap/Coordinate.hs b/src/PathFindingCore/PathingMap/Coordinate.hs --- a/src/PathFindingCore/PathingMap/Coordinate.hs +++ b/src/PathFindingCore/PathingMap/Coordinate.hs @@ -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) diff --git a/src/PathFindingCore/PathingMap/Interpreter.hs b/src/PathFindingCore/PathingMap/Interpreter.hs --- a/src/PathFindingCore/PathingMap/Interpreter.hs +++ b/src/PathFindingCore/PathingMap/Interpreter.hs @@ -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) diff --git a/src/PathFindingCore/PathingMap/Terrain.hs b/src/PathFindingCore/PathingMap/Terrain.hs --- a/src/PathFindingCore/PathingMap/Terrain.hs +++ b/src/PathFindingCore/PathingMap/Terrain.hs @@ -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' diff --git a/src/PathFindingTest/TestSet.hs b/src/PathFindingTest/TestSet.hs --- a/src/PathFindingTest/TestSet.hs +++ b/src/PathFindingTest/TestSet.hs @@ -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 diff --git a/test/BreadcrumbTests.hs b/test/BreadcrumbTests.hs new file mode 100644 --- /dev/null +++ b/test/BreadcrumbTests.hs @@ -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 diff --git a/test/InstanceTests.hs b/test/InstanceTests.hs new file mode 100644 --- /dev/null +++ b/test/InstanceTests.hs @@ -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 diff --git a/test/InterpreterTests.hs b/test/InterpreterTests.hs new file mode 100644 --- /dev/null +++ b/test/InterpreterTests.hs @@ -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 diff --git a/test/PathingMapTests.hs b/test/PathingMapTests.hs new file mode 100644 --- /dev/null +++ b/test/PathingMapTests.hs @@ -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)