hgis 0.1.3.3 → 0.1.3.4
raw patch · 12 files changed
+179/−124 lines, 12 filesdep ~Chartdep ~Chart-cairodep ~Chart-diagrams
Dependency ranges changed: Chart, Chart-cairo, Chart-diagrams, ansi-wl-pprint, base, binary, bytestring, colour, composition, data-binary-ieee754, data-default, directory, filepath, hgis, hspec, lens, monad-loops, optparse-applicative, transformers
Files
- docs/manual.tex +3/−2
- hgis.cabal +93/−81
- src/GIS/Exe/Opt.hs +3/−1
- src/GIS/Exe/OptCairo.hs +3/−1
- src/GIS/Exe/Parser.hs +29/−9
- src/GIS/Graphics/Plot.hs +13/−4
- src/GIS/Graphics/PlotPNG.hs +13/−4
- src/GIS/Graphics/PlotSVG.hs +5/−8
- src/GIS/Graphics/Types.hs +1/−3
- src/GIS/Hylo.hs +14/−9
- src/GIS/Math/Projections.hs +1/−1
- src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs +1/−1
docs/manual.tex view
@@ -32,8 +32,9 @@ \begin{appendices} \section{Installation}- HGIS is supported and tested with stack, available from- \url{https://haskellstack.org}. + HGIS is supported and tested with nix and stack, available from+ \url{http://nixos.org/nix/} and \url{https://haskellstack.org}, respectively.+ % opinionated: nix is best when you just want the binaries! \section{Using the libaries} \end{appendices}
hgis.cabal view
@@ -1,88 +1,100 @@-name: hgis-version: 0.1.3.3-synopsis: Package and command-line for GIS with Haskell-description: Package containting functions to make graphs, read - shapefiles, and compute areas/perimeters of- geographic features. -homepage: https://github.com/vmchale/hgis#readme-license: BSD3-license-file: LICENSE-author: Vanessa McHale-maintainer: tmchale@wisc.edu-copyright: Copyright: (c) 2016 Vanessa McHale-category: Web-build-type: Simple-extra-source-files: README.md, stack.yaml, docs/manual.tex, docs/manual.pdf, src/depends/readshp/LICENSE, LICENSE-readshp-cabal-version: >=1.10+name: hgis+version: 0.1.3.4+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: Copyright: (c) 2016 Vanessa McHale+maintainer: tmchale@wisc.edu+homepage: https://github.com/vmchale/hgis#readme+synopsis: Package and command-line for GIS with Haskell+description:+ Package containting functions to make graphs, read+ shapefiles, and compute areas/perimeters of+ geographic features.+category: Web+author: Vanessa McHale+extra-source-files:+ README.md+ stack.yaml+ docs/manual.tex+ docs/manual.pdf+ src/depends/readshp/LICENSE+ LICENSE-readshp -Flag llvm-fast {- Description: Enable build with llvm backend- Default: False-}+source-repository head+ type: git+ location: https://github.com/vmchale/hgis +flag llvm-fast+ description:+ Enable build with llvm backend+ default: False+ library- hs-source-dirs: src, src/depends/readshp- exposed-modules: GIS.Exe.Opt- , GIS.Exe.OptCairo- , GIS.Math.Spherical- , GIS.Graphics.PlotPNG- , GIS.Graphics.PlotSVG- , GIS.Hylo- , GIS.Math.Projections- other-modules: GIS.Math.Utils- , GIS.Utils- , GIS.Graphics.Plot- , GIS.Graphics.Types- , GIS.Types- , GIS.Exe.Parser- , Geometry.Shapefile- , Geometry.Shapefile.MergeShpDbf- , Geometry.Shapefile.ReadDbf- , Geometry.Shapefile.ReadShp- , Geometry.Shapefile.Types- , Geometry.Shapefile.Internal- build-depends: base >= 4.7 && < 5- , optparse-applicative- , Chart- , Chart-cairo- , Chart-diagrams- , lens- , composition- , ansi-wl-pprint- , transformers- , directory- , colour- , data-default- , binary- , bytestring- , data-binary-ieee754- , filepath- , monad-loops- default-language: Haskell2010- default-extensions: DeriveGeneric- , OverloadedStrings+ exposed-modules:+ GIS.Exe.Opt+ GIS.Exe.OptCairo+ GIS.Math.Spherical+ GIS.Graphics.PlotPNG+ GIS.Graphics.PlotSVG+ GIS.Hylo+ GIS.Math.Projections+ build-depends:+ base >=4.7 && <5,+ optparse-applicative >=0.13.2.0 && <0.14,+ Chart >=1.8.2 && <1.9,+ Chart-cairo >=1.8.2 && <1.9,+ Chart-diagrams >=1.8.2 && <1.9,+ lens >=4.15.1 && <4.16,+ composition >=1.0.2.1 && <1.1,+ ansi-wl-pprint >=0.6.7.3 && <0.7,+ transformers >=0.5.2.0 && <0.6,+ directory >=1.3.0.0 && <1.4,+ colour >=2.3.3 && <2.4,+ data-default >=0.7.1.1 && <0.8,+ binary >=0.8.3.0 && <0.9,+ bytestring >=0.10.8.1 && <0.11,+ data-binary-ieee754 >=0.4.4 && <0.5,+ filepath >=1.4.1.1 && <1.5,+ monad-loops >=0.4.3 && <0.5+ default-language: Haskell2010+ default-extensions: DeriveGeneric OverloadedStrings+ hs-source-dirs: src src/depends/readshp+ other-modules:+ GIS.Math.Utils+ GIS.Utils+ GIS.Graphics.Plot+ GIS.Graphics.Types+ GIS.Types+ GIS.Exe.Parser+ Geometry.Shapefile+ Geometry.Shapefile.MergeShpDbf+ Geometry.Shapefile.ReadDbf+ Geometry.Shapefile.ReadShp+ Geometry.Shapefile.Types+ Geometry.Shapefile.Internal executable hgis- hs-source-dirs: app- main-is: MainPng.hs- if flag(llvm-fast)- ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3- else- ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-depends: base- , hgis- default-language: Haskell2010+ + if flag(llvm-fast)+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3+ else+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ main-is: MainPng.hs+ build-depends:+ base >=4.9.1.0 && <4.10,+ hgis >=0.1.3.4 && <0.2+ default-language: Haskell2010+ hs-source-dirs: app test-suite hgis-test- type: exitcode-stdio-1.0- hs-source-dirs: test- main-is: Spec.hs- build-depends: base- , hgis- , hspec- ghc-options: -threaded -rtsopts -with-rtsopts=-N- default-language: Haskell2010--source-repository head- type: git- location: https://github.com/vmchale/hgis+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ build-depends:+ base >=4.9.1.0 && <4.10,+ hgis >=0.1.3.4 && <0.2,+ hspec >=2.4.2 && <2.5+ default-language: Haskell2010+ hs-source-dirs: test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
src/GIS/Exe/Opt.hs view
@@ -18,9 +18,11 @@ pick :: Program -> IO () pick (Program (MapMaker outfile False projection) infile) = let p = pickProjection projection in- mkMapSVG outfile =<< districtToMapP p <$> getDistricts infile -- svg now idk?+ mkMapSVG outfile =<< districtToMapP p <$> getDistricts infile pick (Program (MapMaker outfile True projection) infile) = let p = pickProjection projection in makeFoldersSVG =<< districtToMapFilesP p <$> getDistricts infile+pick (Program (MapLabel outfile False projection lensName) infile) = let p = pickProjection projection in+ mkMapSVG outfile =<< districtToMapLensP p (pickLens lensName) <$> getDistricts infile -- FIXME make it work with -a (generate-all) exec :: IO () exec = pick =<< execParser helpDisplay
src/GIS/Exe/OptCairo.hs view
@@ -34,13 +34,15 @@ pick (Program (MapMaker outfile False projection) infile) = let p = pickProjection projection in mkMap outfile =<< districtToMapP p <$> getDistricts infile -- svg now idk? pick (Program (MapMaker outfile True projection) infile) = let p = pickProjection projection in- makeFoldersPng =<< districtToMapFilesP p <$> getDistricts infile+ makeFoldersPng =<< districtToMapFilesP p <$> getDistricts infile -- TODO fix this pick (Program (Computation comp Nothing) infile) = --slightly wrong but eh. case comp of "perimeter" -> putStrLn =<< districtPerimeter <$> getDistricts infile "area" -> putStrLn =<< districtArea <$> getDistricts infile "compactness" -> putStrLn =<< districtCompactness <$> getDistricts infile _ -> putStrLn "computation not recognized"+pick (Program (MapLabel outfile False projection lensName) infile) = let p = pickProjection projection in+ mkLensMap "" outfile (pickLens lensName) =<< getDistricts infile -- FIXME make it work with -a (generate-all) and make it not bind things together?? -- | Make maps as png files. makeFoldersPng :: [Map] -> IO ()
src/GIS/Exe/Parser.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE RankNTypes #-} -- | This module contains the parser for the command-line options module GIS.Exe.Parser where @@ -14,15 +15,16 @@ -- | Data type for the appropriate subcommand data Command = Computation { computation :: String , outputM :: Maybe FilePath } - | MapMaker { output :: FilePath , generateAll :: Bool, projection :: Maybe String }- -- also a "map and label command?"+ | MapMaker { output :: FilePath , generateAll :: Bool , projection :: Maybe String }+ | MapLabel { output :: FilePath , generateAll :: Bool , projection :: Maybe String , computatation :: String } -- | Parses the `Program` data type program :: Parser Program program = Program <$> hsubparser ( command "compute" (info computationP ( progDesc "Compute perimeter, area, etc. of map" ))- <> command "map" (info mapMaker ( progDesc "Make a map from a shapefile database." )))+ <> command "map" (info mapMaker ( progDesc "Make a map from a shapefile database." ))+ <> command "labelmap" (info mapLabelMaker ( progDesc "Make a map from a shapefile database, and label areas with relevant info" ))) <*> ( argument str ( metavar "SHAPEFILE" <> help "Path to .shp file" ) ) -- | Parses the `Command` datatype into a Computation@@ -38,6 +40,27 @@ <> help "Where to write output" ) ) -- | Parses the `Command` datatype into a map+mapLabelMaker :: Parser Command+mapLabelMaker = MapLabel+ <$> strOption+ (long "output"+ <> short 'o'+ <> metavar "OUTPUT"+ <> help "Where to write the image/map" )+ <*> switch+ (long "generate-all"+ <> short 'a'+ <> help "Whether to generate a separate file for each object in the shapefile" )+ <*> ( optional $ strOption+ (long "projection"+ <> short 'p'+ <> help "Which projection to use, e.g. mercator etc.") )+ <*> ( strOption+ (long "label"+ <> short 'p'+ <> help "What aspect to label (area, perimeter, compactness)") )++-- | Parses the `Command` datatype into a map mapMaker :: Parser Command mapMaker = MapMaker <$> strOption@@ -62,12 +85,9 @@ <> progDesc "GIS for Haskell. Can make maps, compute areas/perimeters for shapefiles." <> header "hgis - GIS in Haskell" ) -{---pickComputation :: String -> District -> [Double]-pickComputation str dist = case str of- "perimeter" -> pure $ view perimeter dist- "area" -> view area dist---}+pickLens :: String -> Lens' District Double+pickLens "compactness" = compactness+pickLens "perimeter" = perimeter -- | Parse a `Maybe String` into the appropriate `Projection`, doing nothing for -- a `Nothing`
src/GIS/Graphics/Plot.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE RankNTypes #-}+ -- | Module containing renderable objects and plots for our maps module GIS.Graphics.Plot where @@ -21,20 +23,27 @@ mkRenderablePlots title plots = toRenderable $ layout_title .~ title $ layout_plots .~ plots $ def -mkRenderableLabelled :: String -> [(Polygon, String)] -> Renderable ()-mkRenderableLabelled title points = mkRenderablePlots title [ plotDataPoints (map fst points), plotLabels points ]+mkRenderableLens :: (Show a) => Lens' District a -> [District] -> String -> Renderable ()+mkRenderableLens lens districts title = mkRenderableLabelled title (labelByLens lens districts) +mkRenderableLabelled :: String -> [([Polygon], String)] -> Renderable ()+mkRenderableLabelled title points = mkRenderablePlots title [ plotDataPoints (concat . (fmap fst) $ points), plotLabels points ]+ -- | Helper function to plot data points as appropriate for a map, i.e. using -- contiguous lines. plotDataPoints :: [Polygon] -> Plot Double Double plotDataPoints points = toPlot $ plot_lines_values .~ points $ plot_lines_style . line_color .~ opaque blue $ plot_lines_title .~ "Border" $ def +-- | Set labels via a lens field.+labelByLens :: (Show a) => Lens' District a -> [District] -> [([Polygon], String)]+labelByLens lens districts = zip (fmap (view shape) districts) (fmap (show . (view lens)) districts)+ -- | Helper function to plot labels on a map. The ordinate will be plotted at -- the centroid of the abscissa, which may be outside the polygon if it is -- concave. -plotLabels :: [(Polygon, String)] -> Plot Double Double+plotLabels :: [([Polygon], String)] -> Plot Double Double plotLabels points = toPlot texts- where pairs = fmap (flatten . (over _1 shittyCentroid)) points+ where pairs = fmap (flatten . (over _1 (shittyCentroid . concat))) points fontStyle = font_size .~ 15 $ font_weight .~ FontWeightBold $ def texts = plot_annotation_values .~ pairs $ plot_annotation_style .~ fontStyle $ def
src/GIS/Graphics/PlotPNG.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE RankNTypes #-}+ -- | Module to generate PNGs from shapefiles module GIS.Graphics.PlotPNG where @@ -30,18 +32,25 @@ "png" -> mkMapPng filepath map "svg" -> mkMapSVG filepath map +-- | Given a `Map` write it to file, where the format is determined by the+-- extension.+mkLensMap :: (Show a) => String -> FilePath -> Lens' District a -> [District] -> IO ()+mkLensMap title filepath lens districts = case getExt filepath of+ "png" -> makeLensMapPng title filepath lens districts+ "svg" -> makeLensMapSVG title filepath lens districts+ -- | Given a `Map`, write it to file. mkMapPng :: FilePath -> Map -> IO () mkMapPng path map = do renderableToFile fileOptions path $ mkMapR map putStrLn ("...output written to " <> path) -{---makeLabelledMapPng :: String -> FilePath -> [(Polygon, String)] -> IO ()-makeLabelledMapPng title filepath points = do- renderableToFile fileOptions filepath $ mkRenderableLabelled title points+makeLensMapPng :: (Show a) => String -> FilePath -> Lens' District a -> [District] -> IO ()+makeLensMapPng title filepath lens districts = do+ renderableToFile fileOptions filepath $ mkRenderableLens lens districts title putStrLn ("...output written to " <> filepath) +{-- makeMapPng' :: String -> FilePath -> [Polygon] -> IO () makeMapPng' = (flip zip (forever $ "")) -.** makeLabelledMapPng --}
src/GIS/Graphics/PlotSVG.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE RankNTypes #-}+ -- | Module to generate SVGs from shapefiles. module GIS.Graphics.PlotSVG where @@ -22,12 +24,7 @@ renderableToFile fileOptions path $ mkMapR map putStrLn ("...output written to " <> path) -{---makeLabelledMapSVG :: String -> FilePath -> [(Polygon, String)] -> IO ()-makeLabelledMapSVG title filepath points = do- renderableToFile fileOptions filepath $ mkRenderableLabelled title points+makeLensMapSVG :: (Show a) => String -> FilePath -> Lens' District a -> [District] -> IO ()+makeLensMapSVG title filepath lens districts = do+ renderableToFile fileOptions filepath $ mkRenderableLens lens districts title putStrLn ("...output written to " <> filepath)--makeMapSVG :: String -> FilePath -> [Polygon] -> IO ()-makeMapSVG = (flip zip (forever "")) -.** makeLabelledMapSVG---}
src/GIS/Graphics/Types.hs view
@@ -11,9 +11,7 @@ data Map = Map { _projection :: Projection , _title :: String , _labelEntities :: Bool -- whether to label districts- , _labelledDistricts :: [(Polygon, String)] -- the data we actually want to map- --technically just needs to be a - --though for that matter then projection should also have a typeclass!+ , _labelledDistricts :: [([Polygon], String)] -- the data we actually want to map } makeLenses ''Map
src/GIS/Hylo.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE RankNTypes #-} -- | Module to transform shapefiles. module GIS.Hylo where @@ -18,13 +19,13 @@ import GIS.Graphics.Types import Data.Default import System.Directory+import Data.Composition -- | Get the areas of various objects and return a string suitable for printing districtArea :: [District] -> String districtArea districts = concat . intercalate (pure "\n") $ map (pure . show . distA) districts where distA (District _ label _ area _) = (label, sum area) -- TODO figure out which one is the correct one --- should mention it's km -- | Get the perimeters of various objects and return a string suitable for printing districtPerimeter :: [District] -> String districtPerimeter districts = concat . intercalate (pure "\n") $ map (pure . show . distP) districts@@ -39,11 +40,18 @@ districtToMapP :: Projection -> [District] -> Map districtToMapP p = projectMap p . districtToMap +-- | Given a projection and lists of districts, draw a map, with labels determined by a lens+districtToMapLensP :: (Show a) => Projection -> Lens' District a -> [District] -> Map+districtToMapLensP p lens districts = projectMap p (districtToMapLens lens districts)++-- | Given a list of districts, draw a map, with labels determined by a lens.+districtToMapLens :: (Show a) => Lens' District a -> [District] -> Map+districtToMapLens lens districts = labelledDistricts .~ dist $ def+ where dist = zip (fmap (_shape) districts) (map (show . view lens) districts)+ -- | Given a list of districts, draw a map. districtToMap :: [District] -> Map-districtToMap districts = labelledDistricts .~ dist $ def- where dist = gc $ zip (fmap _shape districts) (fmap _districtLabel districts)- gc = concatMap (\(a,b) -> zip a (replicate (length a) b))+districtToMap = districtToMapLens districtLabel -- | Given a projection and list of districts, return a list of maps. districtToMapFilesP :: Projection -> [District] -> [Map]@@ -51,22 +59,19 @@ -- | Given a list of districts, return a list of maps. districtToMapFiles :: [District] -> [Map]-districtToMapFiles = map (\(District polygons label _ area _) -> title .~ label ++ "-" ++ (show . sum $ area) $ labelledDistricts .~ (zip polygons (nullLabel polygons)) $ def)- where nullLabel polys = map (const "") [1..(length polys)]+districtToMapFiles = map (\(District polygons label _ area _) -> title .~ label ++ "-" ++ (show . sum $ area) $ labelledDistricts .~ (pure (polygons,"")) $ def) -- | Given the path to a shapefile, return a list of districts getDistricts :: FilePath -> IO [District] getDistricts filepath = do dbfExists <- doesFileExist (stripExt filepath <> ".dbf") file <- if dbfExists then readShpWithDbf filepath else readShpFile filepath- let districtLabels = fromJust $ (fmap labels) $ mapM (shpRecLabel) . shpRecs $ file -- <$> for print? + let districtLabels = fromJust $ (fmap labels) $ mapM (shpRecLabel) . shpRecs $ file -- labels + field descriptions? let shapes = (map (getPolygon . fromJust . shpRecContents)) . shpRecs $ file let perimeters = map (totalPerimeter . getPolygon . fromJust . shpRecContents) . shpRecs $ file let areas = map (fmap areaPolygon . getPolygon . fromJust . shpRecContents) . shpRecs $ file let compacticity = map (relativeCompactness . concat . getPolygon . fromJust . shpRecContents) . shpRecs $ file pure $ zipWith5 (\a b c d e -> District a b c d e) shapes districtLabels perimeters areas compacticity- --let tuple = zip5 shapes districtLabels perimeters areas compactness- --pure $ fmap (\(a,b,c,d,e) -> District a b c d e) tuple -- | Helper function for extracting from shapefiles. getPolygon :: RecContents -> [Polygon]
src/GIS/Math/Projections.hs view
@@ -71,4 +71,4 @@ -- | Helper to apply a projection given a `Map`. projectMap :: Projection -> Map -> Map-projectMap p = over (labelledDistricts) (fmap (over _1 (project p)))+projectMap p = over (labelledDistricts) (fmap (over _1 (fmap (project p))))
src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs view
@@ -27,4 +27,4 @@ } addRecLabel :: ShpRec -> [DbfRecord] -> ShpRec-addRecLabel sr labels = sr { shpRecLabel = Just labels }+addRecLabel sr labels = sr { shpRecLabel = Just (labels) } -- FIXME add field name as string