partial integration/support for geojson (#237)

* some instances for the points * exporting functionality + cleaning up imports * some work on the examples * bunch of instances for the polygon type * some fiddling * more instances :) * uncommented the partial instance for now * qualified import * missing exe
noinia · Aug 16, 2024 · 6888879 · 6888879
1 parent bb3fe79
commit 6888879
Show file tree

Hide file tree

Showing 6 changed files with 397 additions and 4 deletions.
diff --git a/hgeometry-combinatorial/src/HGeometry/Foldable/Util.hs b/hgeometry-combinatorial/src/HGeometry/Foldable/Util.hs
@@ -61,6 +61,9 @@ instance Monoid c => HasFromFoldable (Const c) where
 instance HasFromFoldable1 NonEmpty where
   fromNonEmpty = id
 
+instance HasFromFoldable1 Seq.Seq where
+  fromNonEmpty = Seq.fromList . F.toList
+
 instance HasFromFoldable Vector.Vector  where
   fromList = Vector.fromList
 

diff --git a/hgeometry-examples/geojson/Main.hs b/hgeometry-examples/geojson/Main.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Main(main) where
+
+import           Control.Lens
+import           Data.Aeson
+import           Data.Geospatial
+import           Data.Maybe
+import           HGeometry.GeoJSON
+import           HGeometry.Point
+import           HGeometry.Polygon.Class
+import           HGeometry.Polygon.Simple
+-- import           HGeometry.Vector ()
+import           Ipe
+import           Paths_hgeometry_examples
+import qualified System.File.OsPath as File
+import           System.OsPath
+--------------------------------------------------------------------------------
+
+type R = Double
+
+parseGeoJSONFile :: OsPath -> IO (Either String (GeoFeatureCollection Value))
+parseGeoJSONFile = fmap eitherDecode . File.readFile
+
+
+-- toPolygon :: IpeOut GeoPolygon Ipe.Path R
+-- toPolygon = ipePolygon . fromMaybe (error "failed") . toPolygon'
+
+-- toPolygon' :: GeoPolygon -> Maybe (SimplePolygon (Point 2 R))
+-- toPolygon' = fromPoints . view (vertices.asPoint)
+
+
+main :: IO ()
+main = do
+  res <- parseGeoJSONFile [osp|data/ne_110m_admin_1_states_provinces_shp.geojson|]
+  case res of
+    Left err          -> print err
+    Right fCollection -> do
+      mapM_ print $ fCollection^..geofeatures.traverse.geometry._Polygon
+      -- let outFp = [osp|foo.ipe|]
+      --     out   = [ iO $ toPolygon pg
+      --             | pg <- fCollection^..geofeatures.traverse.geometry._Polygon
+      --             ]
+      -- writeIpeFile outFp . singlePageFromContent $ out
diff --git a/hgeometry-examples/hgeometry-examples.cabal b/hgeometry-examples/hgeometry-examples.cabal
@@ -19,6 +19,7 @@ extra-source-files:
 data-files:
     data/**/*.in
     data/**/*.out
+    data/**/**.geojson
 
 tested-with:
     GHC == 9.6.5
@@ -48,6 +49,7 @@ common setup
       , hgeometry:ipe
       , hgeometry:svg
       , hgeometry:miso
+      , hgeometry:geojson
       , hiraffe                   >= 0.1
       , containers                >= 0.6
       , vector                    >= 0.13
@@ -71,6 +73,9 @@ common setup
       , transformers              >= 0.6.0.0
       , infinite-list             >= 0.1.1         && < 0.2
       , text                      >= 2.0
+      , file-io
+      , filepath
+      , geojson                   >= 4.1.1
 
       -- , dependent-map             >= 0.4
       -- , dependent-sum             >= 0.7.1
@@ -188,6 +193,17 @@ executable hgeometry-polyLineDrawing
   -- other-modules:
   --      Miso.Event.Extra
 
+--------------------------------------------------------------------------------
+-- * GeoJSON example
+
+executable hgeometry-geojson
+  import:         setup, miso-setup
+  hs-source-dirs: geojson
+  main-is:        Main.hs
+  other-modules:
+          Paths_hgeometry_examples
+  --      Miso.Event.Extra
+
 --------------------------------------------------------------------------------
 -- * Polyline Drawing
 

diff --git a/hgeometry-examples/skia/Main.hs b/hgeometry-examples/skia/Main.hs
@@ -52,9 +52,10 @@ import           SkiaCanvas ( mouseCoordinates, dimensions, canvasKitRefs, surfa
                             , Canvas
                             )
 
-import           SkiaCanvas.CanvasKit.Image
+import           HGeometry.GeoJSON
 import           SkiaCanvas.CanvasKit hiding (Style(..))
 import           SkiaCanvas.CanvasKit.GeomPrims (ltrbRect)
+import           SkiaCanvas.CanvasKit.Image
 import           SkiaCanvas.CanvasKit.Paint (SkPaintRef)
 import           SkiaCanvas.CanvasKit.Picture (serialize, withPicture, drawPicture)
 import           SkiaCanvas.CanvasKit.PictureRecorder (recordAsPicture)