diff --git a/docs/manual.tex b/docs/manual.tex --- a/docs/manual.tex +++ b/docs/manual.tex @@ -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} diff --git a/hgis.cabal b/hgis.cabal --- a/hgis.cabal +++ b/hgis.cabal @@ -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 diff --git a/src/GIS/Exe/Opt.hs b/src/GIS/Exe/Opt.hs --- a/src/GIS/Exe/Opt.hs +++ b/src/GIS/Exe/Opt.hs @@ -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 diff --git a/src/GIS/Exe/OptCairo.hs b/src/GIS/Exe/OptCairo.hs --- a/src/GIS/Exe/OptCairo.hs +++ b/src/GIS/Exe/OptCairo.hs @@ -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 () diff --git a/src/GIS/Exe/Parser.hs b/src/GIS/Exe/Parser.hs --- a/src/GIS/Exe/Parser.hs +++ b/src/GIS/Exe/Parser.hs @@ -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` diff --git a/src/GIS/Graphics/Plot.hs b/src/GIS/Graphics/Plot.hs --- a/src/GIS/Graphics/Plot.hs +++ b/src/GIS/Graphics/Plot.hs @@ -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 diff --git a/src/GIS/Graphics/PlotPNG.hs b/src/GIS/Graphics/PlotPNG.hs --- a/src/GIS/Graphics/PlotPNG.hs +++ b/src/GIS/Graphics/PlotPNG.hs @@ -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 --} diff --git a/src/GIS/Graphics/PlotSVG.hs b/src/GIS/Graphics/PlotSVG.hs --- a/src/GIS/Graphics/PlotSVG.hs +++ b/src/GIS/Graphics/PlotSVG.hs @@ -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 ---} diff --git a/src/GIS/Graphics/Types.hs b/src/GIS/Graphics/Types.hs --- a/src/GIS/Graphics/Types.hs +++ b/src/GIS/Graphics/Types.hs @@ -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 diff --git a/src/GIS/Hylo.hs b/src/GIS/Hylo.hs --- a/src/GIS/Hylo.hs +++ b/src/GIS/Hylo.hs @@ -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] diff --git a/src/GIS/Math/Projections.hs b/src/GIS/Math/Projections.hs --- a/src/GIS/Math/Projections.hs +++ b/src/GIS/Math/Projections.hs @@ -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)))) diff --git a/src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs b/src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs --- a/src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs +++ b/src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs @@ -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