yx (empty) → 0.0.1.0

raw patch · 6 files changed

+184/−0 lines, 6 filesdep +arraydep +basedep +bytestringsetup-changed

Dependencies added: array, base, bytestring, hspec, yx

Files

LICENSE +30/−0
README.md +1/−0
Setup.hs +2/−0
src/Data/Geometry/YX.hs +84/−0
test/Spec.hs +27/−0
yx.cabal +40/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Matthieu Monsch (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Matthieu Monsch nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,1 @@+# yx

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ src/Data/Geometry/YX.hs view

@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}++-- | A bitmap-friendly XY coordinate.+--+-- YX rather than XY since layout is row major (first row sorts before the+-- second, etc.).+module Data.Geometry.YX ( YX(..)+                        , rows+                        , up, left, right, down+                        , steps4, steps8+                        , byteStringToArray, arrayToByteString ) where++import Data.Array.IArray (IArray)+import qualified Data.Array.IArray as Array+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import Data.Ix (Ix)+import qualified Data.Ix as Ix+import Data.List (groupBy)++-- | A 2D coordinate.+--+-- YX implements 'Num'. Integers are converted to their diagonal equivalent+-- (for example @2@ becomes @YX 2 2@).+data YX = YX { x :: !Int, y :: !Int } deriving (Eq, Ord, Show)++lift1 :: (Int -> Int) -> YX -> YX+lift1 f (YX y1 x1) = YX (f y1) (f x1)++lift2 :: (Int -> Int -> Int) -> YX -> YX -> YX+lift2 f (YX y1 x1) (YX y2 x2) = YX (f y1 y2) (f x1 x2)++instance Num YX where+  (+) = lift2 (+)+  (*) = lift2 (*)+  abs = lift1 abs+  signum = lift1 signum+  fromInteger i = let i' = fromInteger i in YX i' i'+  negate = lift1 negate++instance Ix YX where+  range (YX yl xl, YX yu xu) =+    [ YX y x | y <- Ix.range (yl, yu), x <- Ix.range (xl, xu) ]+  index (YX yl xl, YX yu xu) (YX y x) =+    Ix.index (yl, yu) y * Ix.rangeSize (xl, xu) + Ix.index (xl, xu) x+  inRange (YX yl xl, YX yu xu) (YX y x) =+    Ix.inRange (yl, yu) y && Ix.inRange (xl, xu) x++-- | All coordinates, grouped by row.+rows :: (YX, YX) -> [[YX]]+rows = groupBy (\(YX y1 _) (YX y2 _) -> y1 == y2) . Ix.range++-- | Basic steps.+up, left, right, down :: YX+up = YX (-1) 0+left = YX 0 (-1)+right = YX 0 1+down = YX 1 0++-- | Ordered steps arrays.+steps4, steps8 :: [YX]+steps4 = [up, left, right, down]+steps8 = [up + left, up, up + right, left, right, down + left, down, down + right]++-- Parse newline delimited bytestring into an array.+byteStringToArray :: (IArray a e) => (Char -> Maybe e) -> ByteString -> Either String (a YX e)+byteStringToArray f bs = shape (BS.split '\n' bs) (-1) >>= materialize bs where+  shape [] (YX y x) = Right (YX y (max x 0))+  shape (row : rows) yx@(YX y x0)+    | null rows && BS.null row = shape [] yx -- Empty last row.+    | otherwise = let x = BS.length row - 1+                  in if x /= x0 && x0 >= 0+                    then Left $ "bad row lengths: " ++ show x ++ ", " ++ show x0+                    else shape rows (YX (y + 1) x)+  materialize bs yx = Array.listArray (0, yx) <$> elems bs+  elems = sequenceA . fmap parse . filter (/= '\n') . BS.unpack+  parse c = case f c of+    Just e -> Right e+    Nothing -> Left $ "unknown char: " ++ show c++-- | Reverse of `byteStringToArray`+arrayToByteString :: (IArray a e) => (e -> Char) -> a YX e -> ByteString+arrayToByteString f arr = BS.intercalate "\n" lines where+  lines = fmap (BS.pack . fmap (f . (arr Array.!))) . rows . Array.bounds $ arr

+ test/Spec.hs view

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.Array.IArray as Array+import Data.Char (digitToInt)+import Data.Either (isLeft)+import Data.Geometry.YX (YX)+import qualified Data.Geometry.YX as YX+import Test.Hspec+import Test.Hspec.QuickCheck++main :: IO ()+main = hspec $ do+  describe "bytestring conversions" $ do+    it "should parse a simple square case" $ do+      let+        got = YX.byteStringToArray (Just . digitToInt) "12\n34\n"+        want = Array.listArray (0, 1) [1..4] :: Array.Array YX Int+      got `shouldBe` Right want+    it "fails on uneven row" $ do+      let got = YX.byteStringToArray Just "12\n3\n" :: Either String (Array.Array YX Char)+      isLeft got `shouldBe` True+    it "round trips" $ do+      let+        bs = "12\n34\n56"+        Right arr = YX.byteStringToArray Just bs :: Either String (Array.Array YX Char)+        bs' = YX.arrayToByteString id arr+      bs' `shouldBe` bs

+ yx.cabal view

@@ -0,0 +1,40 @@+name:                yx+version:             0.0.1.0+synopsis:            Row-major coordinates+description:         https://github.com/mtth/yx+homepage:            https://github.com/mtth/yx+license:             BSD3+license-file:        LICENSE+author:              Matthieu Monsch+maintainer:          matthieu.monsch@gmail.com+copyright:           2018 Matthieu Monsch+category:            Web+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.Geometry.YX+  build-depends:       base >= 4.7 && < 5+                     , array >= 0.5+                     , bytestring >= 0.10+  default-language:    Haskell2010++test-suite yx-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , array >= 0.5+    , bytestring >= 0.10+    , hspec >=2.5 && <2.6+    , yx+  default-language: Haskell2010++source-repository head+  type:     git+  location: https://github.com/mtth/yx