hgis 0.1.3.7 → 0.1.3.8
raw patch · 22 files changed
+405/−415 lines, 22 filesdep +composition-preludedep −compositiondep −transformersPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: composition-prelude
Dependencies removed: composition, transformers
API changes (from Hackage documentation)
- GIS.Math.Spherical: perimeterPolygon :: [(Double, Double)] -> Double
+ GIS.Math.Spherical: perimeterPolygon :: Polygon -> Double
Files
- Justfile +0/−8
- LICENSE-readshp +0/−20
- cabal.project.local +4/−4
- hgis.cabal +116/−81
- src/GIS/Exe/Opt.hs +12/−18
- src/GIS/Exe/OptCairo.hs +13/−21
- src/GIS/Exe/Parser.hs +30/−27
- src/GIS/Graphics/Plot.hs +14/−17
- src/GIS/Graphics/PlotPNG.hs +20/−29
- src/GIS/Graphics/PlotSVG.hs +11/−13
- src/GIS/Hylo.hs +12/−14
- src/GIS/Math/Projections.hs +23/−24
- src/GIS/Math/Spherical.hs +27/−27
- src/GIS/Math/Utils.hs +5/−4
- src/GIS/Types.hs +7/−8
- src/GIS/Utils.hs +4/−3
- src/depends/readshp/Geometry/Shapefile/Internal.hs +5/−7
- src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs +9/−10
- src/depends/readshp/Geometry/Shapefile/ReadDbf.hs +8/−8
- src/depends/readshp/Geometry/Shapefile/ReadShp.hs +62/−63
- stack.yaml +14/−0
- test/Spec.hs +9/−9
− Justfile
@@ -1,8 +0,0 @@-clean:- rm test/testmap.*- sn c .--upload:- rm -rf dist/- cabal sdist- cabal upload --publish $(fd '\.tar\.gz$')
− LICENSE-readshp
@@ -1,20 +0,0 @@-Copyright (c) 2015 Sam van Herwaarden--Permission is hereby granted, free of charge, to any person obtaining-a copy of this software and associated documentation files (the-"Software"), to deal in the Software without restriction, including-without limitation the rights to use, copy, modify, merge, publish,-distribute, sublicense, and/or sell copies of the Software, and to-permit persons to whom the Software is furnished to do so, subject to-the following conditions:--The above copyright notice and this permission notice shall be included-in all copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.-IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY-CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,-TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE-SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
cabal.project.local view
@@ -1,5 +1,5 @@-with-compiler: ghc-8.2.1+constraints: hgis +development+with-compiler: ghc-8.2.2 optimization: 2-documentation: True-haddock-hoogle: True-haddock-internal: True+documentation: true+tests: true
hgis.cabal view
@@ -1,88 +1,123 @@-name: hgis-version: 0.1.3.7-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, cabal.project.local, docs/manual.tex, src/depends/readshp/LICENSE, LICENSE-readshp, Justfile-cabal-version: >=1.10+cabal-version: 1.18+name: hgis+version: 0.1.3.8+license: BSD3+license-file: LICENSE+copyright: Copyright: (c) 2016-2018 Vanessa McHale+maintainer: vamchale@gmail.com+author: Vanessa McHale+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+build-type: Simple+extra-source-files:+ cabal.project.local+ stack.yaml+extra-doc-files: README.md+ docs/manual.tex+ src/depends/readshp/LICENSE -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++flag development+ description:+ Turn on '-Werror'+ default: False+ manual: True+ 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+ 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+ default-language: Haskell2010+ default-extensions: DeriveGeneric OverloadedStrings+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5,+ optparse-applicative -any,+ Chart -any,+ Chart-cairo -any,+ Chart-diagrams -any,+ lens -any,+ composition-prelude >=1.1.0.1,+ ansi-wl-pprint -any,+ directory -any,+ colour -any,+ data-default -any,+ binary -any,+ bytestring -any,+ data-binary-ieee754 -any,+ filepath -any,+ monad-loops -any+ + if flag(development)+ ghc-options: -Werror+ + if impl(ghc >=8.0)+ ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates 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 > 4.9 && < 5- , hgis- default-language: Haskell2010+ main-is: MainPng.hs+ hs-source-dirs: app+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >4.9 && <5,+ hgis -any+ + if flag(llvm-fast)+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3+ else+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ + if flag(development)+ ghc-options: -Werror+ + if impl(ghc >=8.0)+ ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates 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+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:+ base -any,+ hgis -any,+ hspec -any+ + if flag(development)+ ghc-options: -Werror+ + if impl(ghc >=8.0)+ ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates
src/GIS/Exe/Opt.hs view
@@ -1,28 +1,22 @@ module GIS.Exe.Opt where -import GIS.Hylo-import Control.Monad-import Control.Lens hiding (argument)-import Options.Applicative-import Control.Monad.IO.Class-import Data.Monoid hiding (getAll)-import System.Directory----import GIS.Utils-import GIS.Math.Projections-import GIS.Math.Spherical-import GIS.Graphics.PlotSVG-import GIS.Types-import GIS.Exe.Parser-import GIS.Graphics.Types+import Control.Lens+import Data.Semigroup+import GIS.Exe.Parser hiding (projection)+import GIS.Graphics.PlotSVG+import GIS.Graphics.Types hiding (projection)+import GIS.Hylo+import Options.Applicative+import System.Directory pick :: Program -> IO () pick (Program (MapMaker outfile False projection) infile) = let p = pickProjection projection in- mkMapSVG outfile =<< districtToMapP p <$> getDistricts infile -pick (Program (MapMaker outfile True projection) infile) = let p = pickProjection projection in+ mkMapSVG outfile =<< districtToMapP p <$> getDistricts infile+pick (Program (MapMaker _ 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)+pick _ = error "not yet implemented." exec :: IO () exec = pick =<< execParser helpDisplay@@ -30,4 +24,4 @@ makeFoldersSVG :: [Map] -> IO () makeFoldersSVG maps = do createDirectoryIfMissing False "maps"- mapM_ (\m -> mkMapSVG ("maps/" <> (view title m) <> ".svg") m) maps+ mapM_ (\m -> mkMapSVG ("maps/" <> view title m <> ".svg") m) maps
src/GIS/Exe/OptCairo.hs view
@@ -7,23 +7,14 @@ , exec ) where -import GIS.Hylo-import Control.Lens-import Control.Monad-import Options.Applicative-import Control.Monad.IO.Class-import Data.Monoid hiding (getAll)-import System.Directory----import GIS.Utils-import GIS.Math.Projections-import GIS.Math.Spherical-import GIS.Graphics.PlotSVG-import GIS.Graphics.PlotPNG-import GIS.Types-import GIS.Exe.Opt hiding (exec, pick)-import GIS.Exe.Parser-import GIS.Graphics.Types+import Control.Lens+import Data.Semigroup+import GIS.Exe.Parser hiding (projection)+import GIS.Graphics.PlotPNG+import GIS.Graphics.Types hiding (projection)+import GIS.Hylo+import Options.Applicative+import System.Directory -- | Main executable; parses command line options and runs program exec :: IO ()@@ -33,19 +24,20 @@ pick :: Program -> IO () 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+pick (Program (MapMaker _ True projection) infile) = let p = pickProjection projection in makeFoldersPng =<< districtToMapFilesP p <$> getDistricts infile -- TODO fix this-pick (Program (Computation comp Nothing) infile) = --slightly wrong but eh. +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+pick (Program (MapLabel outfile False _ lensName) infile) = mkLensMap "" outfile (pickLens lensName) =<< getDistricts infile -- FIXME make it work with -a (generate-all) and make it not bind things together??+pick _ = error "not yet supported." -- | Make maps as png files. makeFoldersPng :: [Map] -> IO () makeFoldersPng maps = do createDirectoryIfMissing False "maps"- mapM_ (\m -> mkMapPng ("maps/" <> (view title m) <> ".png") m) maps+ mapM_ (\m -> mkMapPng ("maps/" <> view title m <> ".png") m) maps
src/GIS/Exe/Parser.hs view
@@ -2,33 +2,33 @@ -- | This module contains the parser for the command-line options module GIS.Exe.Parser where -import Options.Applicative-import GIS.Types-import GIS.Math.Projections-import Control.Lens hiding (argument)-import Data.Monoid+import Control.Lens hiding (argument)+import Data.Monoid+import GIS.Math.Projections+import GIS.Types+import Options.Applicative -- | Data type for one run of the program-data Program = Program { com :: Command +data Program = Program { com :: Command , file :: FilePath -- "Path to dbf file"- } + } -- | Data type for the appropriate subcommand-data Command = Computation { computation :: String , outputM :: Maybe FilePath } +data Command = Computation { computation :: String , outputM :: Maybe FilePath } | 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 +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 "labelmap" (info mapLabelMaker ( progDesc "Make a map from a shapefile database, and label areas with relevant info" )))- <*> ( argument str - (metavar "SHAPEFILE" + <*> argument str+ (metavar "SHAPEFILE" <> help "Path to .shp file"- <> completer (bashCompleter "file -X '!*.shp' -o plusdirs")))+ <> completer (bashCompleter "file -X '!*.shp' -o plusdirs")) -- | Parses the `Command` datatype into a Computation computationP :: Parser Command@@ -36,11 +36,11 @@ <$> argument str ( metavar "COMPUTATION" <> help "which computation to perform, e.g. area, perimeter, etc." )- <*> ( optional $ strOption -- because it's a maybe filepath+ <*> optional (strOption -- because it's a maybe filepath ( long "output" <> short 'o' <> metavar "OUTPUT"- <> help "Where to write output" ) )+ <> help "Where to write output" )) -- | Parses the `Command` datatype into a map mapLabelMaker :: Parser Command@@ -54,14 +54,14 @@ (long "generate-all" <> short 'a' <> help "Whether to generate a separate file for each object in the shapefile" )- <*> ( optional $ strOption+ <*> optional (strOption (long "projection" <> short 'p'- <> help "Which projection to use, e.g. mercator etc.") )- <*> ( strOption+ <> help "Which projection to use, e.g. mercator etc."))+ <*> strOption (long "label" <> short 'p'- <> help "What aspect to label (area, perimeter, compactness)") )+ <> help "What aspect to label (area, perimeter, compactness)") -- | Parses the `Command` datatype into a map mapMaker :: Parser Command@@ -75,14 +75,15 @@ (long "generate-all" <> short 'a' <> help "Whether to generate a separate file for each object in the shapefile" )- <*> ( optional $ strOption+ <*> optional (strOption (long "projection" <> short 'p'- <> help "Which projection to use, e.g. mercator etc.") )+ <> help "Which projection to use, e.g. mercator etc.")) -- | display help if user enters e.g. -- -- > hgis --help wrongcommand+helpDisplay :: ParserInfo Program helpDisplay = info ( program <**> helper) ( fullDesc <> progDesc "GIS for Haskell. Can make maps, compute areas/perimeters for shapefiles."@@ -90,15 +91,17 @@ pickLens :: String -> Lens' District Double pickLens "compactness" = compactness-pickLens "perimeter" = perimeter+pickLens "perimeter" = perimeter+pickLens _ = error "must be one of 'compactness', 'perimeter'" -- | Parse a `Maybe String` into the appropriate `Projection`, doing nothing for -- a `Nothing` pickProjection :: Maybe String -> Projection-pickProjection str = case str of+pickProjection s = case s of Just "mercator" -> mercator- Just "bonne" -> bonne- Just "albers" -> albers washingtonDC- Just "winkel3" -> winkel3- Just "littow" -> littow- Nothing -> id+ Just "bonne" -> bonne+ Just "albers" -> albers washingtonDC+ Just "winkel3" -> winkel3+ Just "littow" -> littow+ Just _ -> error "unknown projection. try one of 'mercator', 'bonne', 'albers', 'winkel3', or 'littow'"+ Nothing -> id
src/GIS/Graphics/Plot.hs view
@@ -3,21 +3,18 @@ -- | Module containing renderable objects and plots for our maps module GIS.Graphics.Plot where -import GIS.Types-import Graphics.Rendering.Chart-import Graphics.Rendering.Chart.Easy-import GIS.Math.Spherical-import GIS.Utils-import Data.Colour.Names-import GIS.Graphics.Types-import GIS.Math.Projections+import Data.Colour.Names+import GIS.Graphics.Types hiding (title)+import GIS.Math.Spherical+import GIS.Types+import GIS.Utils+import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Easy hiding (lens, points) -- | Given a map, return a `Renderable ()` for use with the--- """Graphics.Rendering.Char""" module. +-- """Graphics.Rendering.Char""" module. mkMapR :: Map -> Renderable ()-mkMapR (Map { _projection = p , _title = tit , _labelEntities = le , _labelledDistricts = points }) = case le of- True -> mkRenderableLabelled tit points- False -> mkRenderableLabelled tit $ fmap (over _2 (const "")) points+mkMapR Map { _title = tit , _labelEntities = le , _labelledDistricts = points } = if le then mkRenderableLabelled tit points else mkRenderableLabelled tit $ fmap (over _2 (pure "")) points mkRenderablePlots :: String -> [Plot Double Double] -> Renderable () mkRenderablePlots title plots = toRenderable $@@ -27,23 +24,23 @@ 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 ]+mkRenderableLabelled title points = mkRenderablePlots title [ plotDataPoints (fst =<< points), plotLabels points ] -- | Helper function to plot data points as appropriate for a map, i.e. using--- contiguous lines. +-- 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)+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. +-- concave. plotLabels :: [([Polygon], String)] -> Plot Double Double plotLabels points = toPlot texts- where pairs = fmap (flatten . (over _1 (shittyCentroid . concat))) 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
@@ -3,34 +3,29 @@ -- | Module to generate PNGs from shapefiles module GIS.Graphics.PlotPNG where -import Graphics.Rendering.Chart-import Graphics.Rendering.Chart.Easy-import Graphics.Rendering.Chart.Backend.Cairo-import GIS.Types-import Data.Monoid-import Control.Monad-import GIS.Hylo-import GIS.Math.Projections-import Control.Lens-import Control.Lens.Tuple----import GIS.Math.Spherical-import GIS.Utils-import GIS.Graphics.Plot-import GIS.Graphics.Types-import GIS.Graphics.PlotSVG hiding (fileOptions)+import Control.Lens hiding (lens)+import Data.Semigroup+import GIS.Graphics.Plot+import GIS.Graphics.PlotSVG hiding (fileOptions)+import GIS.Graphics.Types hiding (title)+import GIS.Types+import GIS.Utils+import Graphics.Rendering.Chart.Backend.Cairo+import Graphics.Rendering.Chart.Easy hiding (lens) -- | Default file options: PNG output and 1920x1080. To change the file size, -- you can do e.g. -- > fo_size .~ (640,480) $ fileOptions+fileOptions :: FileOptions fileOptions = def { _fo_size = (1920, 1080) , _fo_format = PNG } -- | Given a `Map` write it to file, where the format is determined by the -- extension. mkMap :: FilePath -> Map -> IO ()-mkMap filepath map = case getExt filepath of- "png" -> mkMapPng filepath map- "svg" -> mkMapSVG filepath map+mkMap filepath map' = case getExt filepath of+ "png" -> mkMapPng filepath map'+ "svg" -> mkMapSVG filepath map'+ _ -> error "file extension must be one of: .svg, .png" -- | Given a `Map` write it to file, where the format is determined by the -- extension.@@ -38,19 +33,15 @@ mkLensMap title filepath lens districts = case getExt filepath of "png" -> makeLensMapPng title filepath lens districts "svg" -> makeLensMapSVG title filepath lens districts+ _ -> error "file extension must be one of: .svg, .png" --- | Given a `Map`, write it to file. +-- | Given a `Map`, write it to file. mkMapPng :: FilePath -> Map -> IO ()-mkMapPng path map = do- renderableToFile fileOptions path $ mkMapR map+mkMapPng path map' =+ renderableToFile fileOptions path (mkMapR map') >> putStrLn ("...output written to " <> path) makeLensMapPng :: (Show a) => String -> FilePath -> Lens' District a -> [District] -> IO ()-makeLensMapPng title filepath lens districts = do- renderableToFile fileOptions filepath $ mkRenderableLens lens districts title+makeLensMapPng title filepath lens districts =+ 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
@@ -3,28 +3,26 @@ -- | Module to generate SVGs from shapefiles. module GIS.Graphics.PlotSVG where -import Graphics.Rendering.Chart.Easy-import Graphics.Rendering.Chart.Backend.Diagrams -import Control.Monad-import GIS.Hylo-import GIS.Types-import Data.Monoid-import GIS.Math.Projections-import GIS.Graphics.Plot-import GIS.Graphics.Types+import Data.Semigroup+import GIS.Graphics.Plot+import GIS.Graphics.Types hiding (title)+import GIS.Types+import Graphics.Rendering.Chart.Backend.Diagrams+import Graphics.Rendering.Chart.Easy hiding (lens) -- | Default file options: PNG output and 1920x1080. To change the file size, -- you can do e.g. -- > fo_size .~ (640,480) $ fileOptions+fileOptions :: FileOptions fileOptions = def { _fo_size = (1920, 1080) , _fo_format = SVG } -- | Given a `Map`, write it to file as an SVG. mkMapSVG :: FilePath -> Map -> IO ()-mkMapSVG path map = do- renderableToFile fileOptions path $ mkMapR map+mkMapSVG path map' =+ renderableToFile fileOptions path (mkMapR map') >> putStrLn ("...output written to " <> path) makeLensMapSVG :: (Show a) => String -> FilePath -> Lens' District a -> [District] -> IO ()-makeLensMapSVG title filepath lens districts = do- renderableToFile fileOptions filepath $ mkRenderableLens lens districts title+makeLensMapSVG title filepath lens districts =+ renderableToFile fileOptions filepath (mkRenderableLens lens districts title) >> putStrLn ("...output written to " <> filepath)
src/GIS/Hylo.hs view
@@ -2,38 +2,34 @@ -- | Module to transform shapefiles. module GIS.Hylo where -import Control.Lens-import Control.Lens.Tuple-import Control.Monad-import Data.Char-import Data.Composition+import Control.Lens hiding (lens) import Data.Default import Data.List import Data.Maybe-import Data.Monoid+import Data.Semigroup import Geometry.Shapefile.MergeShpDbf import Geometry.Shapefile.ReadShp import Geometry.Shapefile.Types import GIS.Graphics.Types import GIS.Math.Projections import GIS.Math.Spherical-import GIS.Types+import GIS.Types hiding (area, perimeter) import GIS.Utils import System.Directory -- | 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+districtArea districts = concat . intercalate (pure "\n") $ fmap (pure . show . distA) districts where distA (District _ label _ area _) = (label, sum area) -- TODO figure out which one is the correct one -- | 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+districtPerimeter districts = concat . intercalate (pure "\n") $ fmap (pure . show . distP) districts where distP (District _ label perimeter _ _) = (label, perimeter) -- | Label with relative compactness districtCompactness :: [District] -> String-districtCompactness districts = concat . intercalate (pure "\n") $ map (pure . show . distC) districts+districtCompactness districts = concat . intercalate (pure "\n") $ fmap (pure . show . distC) districts where distC (District _ label _ _ compacticity) = (label, compacticity) -- | Given a projection and lists of districts, draw a map.@@ -59,7 +55,8 @@ -- | Given a list of districts, return a list of maps. districtToMapFiles :: [District] -> [Map]-districtToMapFiles = fmap (\(District polygons label _ area _) -> title .~ label ++ "-" ++ (show . sum $ area) $ labelledDistricts .~ pure (polygons,"") $ def)+districtToMapFiles = fmap g where+ g (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]@@ -75,6 +72,7 @@ -- | Helper function for extracting from shapefiles. getPolygon :: RecContents -> [Polygon]-getPolygon RecPolygon{ recPolPoints = pt } = pt-getPolygon RecPolygonM{ recPolMPoints = pt } = pt-getPolygon RecPolygonZ{ recPolZPoints = pt } = pt+getPolygon RecPolygon { recPolPoints = pt } = pt+getPolygon RecPolygonM { recPolMPoints = pt } = pt+getPolygon RecPolygonZ { recPolZPoints = pt } = pt+getPolygon _ = error "shapefile contents not supported. please ensure the shapefile contains a list of polygons."
src/GIS/Math/Projections.hs view
@@ -1,11 +1,10 @@ -- | Module containing several useful projections for generating maps. module GIS.Math.Projections where -import Control.Lens-import Control.Lens.Tuple-import GIS.Types-import GIS.Math.Utils-import GIS.Graphics.Types+import Control.Lens+import GIS.Graphics.Types+import GIS.Math.Utils+import GIS.Types -- | For use as a reference point in certain projections. washingtonDC :: Point@@ -17,7 +16,7 @@ -- | Littow retroazimuthal + conformal projection littow :: Projection-littow (long, lat) = ((sin(long - referenceLong)/(cos lat)), (cos (long - referenceLong) * (tan lat)))+littow (long, lat) = (sin(long - referenceLong)/cos lat, cos (long - referenceLong) * tan lat) where referenceLong = radians 0 -- | Craig retroazimuthal projection@@ -25,29 +24,29 @@ craig :: Point -> Projection craig referencePoint (long, lat) = (long - referenceLong, y) where (referenceLong, referenceLat) = referencePoint- y = if long - referenceLong == 0 then expr else (long - referenceLong)/(sin(long - referenceLong)) * expr- expr = ((sin lat) * (cos (long - referenceLong)) - (tan referenceLat) * (cos lat)) + y = if long - referenceLong == 0 then expr else (long - referenceLong)/sin(long - referenceLong) * expr+ expr = sin lat * cos (long - referenceLong) - tan referenceLat * cos lat --- | Winkel Tripel projection (standard for the National Geographic Society since +-- | Winkel Tripel projection (standard for the National Geographic Society since winkel3 :: Projection-winkel3 (long, lat) = ((lambda * (cos phi1) + (2 * cos lat * sin (lambda/2)/(sinc alpha)))/2, (lat + (sin lat)/(sinc alpha))/2)+winkel3 (long, lat) = ((lambda * cos phi1 + (2 * cos lat * sin (lambda/2)/sinc alpha))/2, (lat + sin lat/sinc alpha)/2) where lambda = long - lambda0 phi1 = acos $ 2 / pi- alpha = acos $ cos lat * (cos (lambda/2))+ alpha = acos $ cos lat * cos (lambda/2) lambda0 = radians (-77.0369) -- | Mercator projection. mercator :: Projection-mercator (long, lat) = (long - meridian, asinh(tan(lat)))+mercator (long, lat) = (long - meridian, asinh (tan lat)) where meridian = radians (-98.5795) -- | Bonne projection with standard parallel at 45 N and central meridian -- centered at Washington DC bonne :: Projection-bonne (long, lat) = (rho * (sin e), (cot phi1 - rho * (cos e)))- where rho = (cot phi1) + phi1 - lat- e = (long - meridian) * (cos lat) / rho- phi1 = radians 45 -- standard parallel @ 45 N +bonne (long, lat) = (rho * sin e, cot phi1 - rho * cos e)+ where rho = cot phi1 + phi1 - lat+ e = (long - meridian) * cos lat / rho+ phi1 = radians 45 -- standard parallel @ 45 N meridian = radians (-77.0369) -- central meridian @ dc cot = (1/) . tan @@ -55,15 +54,15 @@ -- use -- > ablers washingtonDC albers :: Point -> Projection-albers referencePoint (long, lat) = (rho * (sin theta), rho' - rho * (cos theta))+albers referencePoint (long, lat) = (rho * sin theta, rho' - rho * cos theta) where n = (sin phi1 + sin phi2)/2 theta = n * (long - referenceLong)- c = (cos phi1)^2 + 2 * n * (sin phi1)- rho = sqrt (c - 2 * n * (sin lat)) / n- rho' = sqrt (c - 2 * n * (sin referenceLat)) / n- phi1 = (radians 20) -- standard parallels @ 20, 50 degrees- phi2 = (radians 50)- (referenceLong, referenceLat) = referencePoint + c = cos phi1^(2 :: Int) + 2 * n * sin phi1+ rho = sqrt (c - 2 * n * sin lat) / n+ rho' = sqrt (c - 2 * n * sin referenceLat) / n+ phi1 = radians 20 -- standard parallels @ 20, 50 degrees+ phi2 = radians 50+ (referenceLong, referenceLat) = referencePoint -- | Helper to project given a `Polygon`. project :: Projection -> Polygon -> Polygon@@ -71,4 +70,4 @@ -- | Helper to apply a projection given a `Map`. projectMap :: Projection -> Map -> Map-projectMap p = over (labelledDistricts) (fmap (over _1 (fmap (project p))))+projectMap p = over labelledDistricts (fmap (over _1 (fmap (project p))))
src/GIS/Math/Spherical.hs view
@@ -1,18 +1,15 @@ -- | Utilities to compute area, perimeterPolygon, etc. on the surface of a sphere. module GIS.Math.Spherical where -import Control.Lens-import Control.Lens.Tuple-import Data.Function-import Data.List-import GIS.Types-import Data.Composition-import GIS.Math.Projections-import GIS.Math.Utils+import Control.Composition+import Control.Lens+import GIS.Math.Projections+import GIS.Math.Utils+import GIS.Types -- | averages the coördinates of a polygon, returning a point. shittyCentroid :: Polygon -> Point-shittyCentroid poly = (avg $ map fst poly, avg $ map snd poly)+shittyCentroid poly = (avg $ fmap fst poly, avg $ fmap snd poly) -- | Average over a foldable container avg :: (RealFrac a, Foldable t) => t a -> a@@ -20,7 +17,7 @@ -- | Compute the area of a triangle using L'Huillier's formula areaTriangle :: Point -> Point -> Point -> Double-areaTriangle x1 x2 x3 = r^2 * e+areaTriangle x1 x2 x3 = r^(2 :: Int) * e where r = 6371 e = 4 * atan(sqrt(tan(s/2) * tan((s - a)/2) * tan((s - b)/2) * tan((s - c)/2))) s = (a + b + c) / 2@@ -29,24 +26,25 @@ c = distanceRad x2 x3 distanceRad = on centralAngle toRadians --- TODO mandelbrot/fractal dimension? --- consider "area of largest circumscribable circle" as well. +-- TODO mandelbrot/fractal dimension?+-- consider "area of largest circumscribable circle" as well. -- | Relative compactness, i.e. compactness divided by the compactness of a Euclidean circle relativeCompactness :: Polygon -> Double relativeCompactness = (*scale) . compactness1- where scale = (1/4*pi)+ where scale = 1/4*pi -- | Take the area of the polygon and divide by the perimeter squared. This is a dimensionless measurement.-compactness1 :: Polygon -> Double -compactness1 p = (areaPolygon p)/(perimeterPolygon p)^2+compactness1 :: Polygon -> Double+compactness1 p = areaPolygon p/perimeterPolygon p^(2 :: Int) -- | Compute the area of a convex polygon on the surface of a sphere. areaConvex :: Polygon -> Double-areaConvex (base1:base2:pts) = (view _1) $ foldr stepArea (0,base2) pts- where stepArea point (sum, base) = (sum + (areaTriangle base1 base point), point)+areaConvex (base1:base2:pts) = view _1 $ foldr stepArea (0,base2) pts+ where stepArea point (sum', base) = (sum' + areaTriangle base1 base point, point)+areaConvex _ = error "attempted to take area of polygon with < 3 points" --- | Uses areal projection; then finds area of the polygon. +-- | Uses areal projection; then finds area of the polygon. -- Result is in km^2 areaPolygon :: Polygon -> Double areaPolygon = (*factor) . areaPolyRectangular . fmap (bonne . toRadians)@@ -54,22 +52,24 @@ -- | Given a list of polygons, return the total area. totalPerimeter :: [Polygon] -> Double-totalPerimeter lines = sum $ fmap perimeterPolygon lines+totalPerimeter ps = sum $ fmap perimeterPolygon ps +perimeterPolygon :: Polygon -> Double perimeterPolygon [x1, x2] = distance x1 x2 perimeterPolygon (x1:x2:points) = perimeterPolygon (x2:points) + distance x1 x2+perimeterPolygon _ = error "Attempted to take area of polygon with no points" --- | Find the area of a polygon with rectangular coördinates given. +-- | Find the area of a polygon with rectangular coördinates given. areaPolyRectangular :: Polygon -> Double-areaPolyRectangular (pt:pts) = abs . (*0.5) . fst $ (foldl' areaPolyCalc (0,pt) pts)- where areaPolyCalc (sum,(x1,y1)) (x2, y2) = (sum + (x1 * y2 - x2 * y1),(x2,y2))- ((x1, y1),(xn, yn)) = (pt, last pts)+areaPolyRectangular (pt:pts) = abs . (*0.5) . fst $ foldr areaPolyCalc (0,pt) pts+ where areaPolyCalc (x2, y2) (sum',(x1,y1)) = (sum' + (x1 * y2 - x2 * y1),(x2,y2))+areaPolyRectangular _ = error "Attempted to take area of polygon with no points" --- | Distance in kilometers between two points given in degrees. +-- | Distance in kilometers between two points given in degrees. distance :: (Double, Double) -> (Double, Double) -> Double-distance = (*6371) .* (on centralAngle toRadians)+distance = (*6371) .* on centralAngle toRadians -- | Compute central angle from points given in radians centralAngle :: (Double, Double) -> (Double, Double) -> Double-centralAngle (long1, lat1) (long2, lat2) = centralAngle- where centralAngle = acos $ (sin lat1) * (sin lat2) + (cos lat1) * (cos lat2) * (cos (long1 - long2))+centralAngle (long1, lat1) (long2, lat2) =+ acos $ sin lat1 * sin lat2 + cos lat1 * cos lat2 * cos (long1 - long2)
src/GIS/Math/Utils.hs view
@@ -1,15 +1,16 @@ -- | Miscellaneous utils for math module GIS.Math.Utils where -import GIS.Types-import Control.Lens-import Control.Lens.Tuple+import Control.Lens+import GIS.Types +sinc :: Floating a => a -> a sinc x = sin x / x -- | Convert a `Double` from degrees to radians.+radians :: Double -> Double radians = (*(pi/180)) -- | Convert both coördinates to radians. toRadians :: Point -> Point-toRadians = (over _1 radians) . (over _2 radians)+toRadians = over _1 radians . over _2 radians
src/GIS/Types.hs view
@@ -1,19 +1,19 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} --- | Module containing types for various geometrical objects. Lenses included. +-- | Module containing types for various geometrical objects. Lenses included. module GIS.Types where -import Text.PrettyPrint.ANSI.Leijen-import GHC.Generics-import Control.Lens+import Control.Lens+import GHC.Generics+import Text.PrettyPrint.ANSI.Leijen type Point = (Double, Double) type Polygon = [Point] type Projection = (Double, Double) -> (Double, Double) -- | Data type for one record in a shape file, also capable of storing basic--- information about the district. +-- information about the district. data District = District { _shape :: [Polygon] , _districtLabel :: String , _perimeter :: Double@@ -23,9 +23,8 @@ makeLenses ''District --- possibly get rid of this idk data DbfReadError = NotAPolygon | ShpNull instance Show DbfReadError where- show NotAPolygon = show $ red (text "Error: ") <> (text "Shape not a polygon! Are you sure you're opening a district?")- show ShpNull = show $ red (text "Error: ") <> (text "")+ show NotAPolygon = show $ red (text "Error: ") <> text "Shape not a polygon! Are you sure you're opening a district?"+ show ShpNull = show $ red (text "Error: ") <> text ""
src/GIS/Utils.hs view
@@ -1,7 +1,8 @@ -- | Miscellaneous utils and helper functions. module GIS.Utils where -import Data.Char+import Control.Composition+import Data.Char -- | Strip extension from a filepath stripExt :: String -> String@@ -9,11 +10,11 @@ -- | Get extension given a filepath getExt :: String -> String-getExt = fmap toLower . reverse . (takeWhile (/='.')) . reverse+getExt = fmap toLower . reverse . takeWhile (/='.') . reverse -- | Make sure labels on shapefile objects are suitable for human reading. labels :: (Show a) => [[a]] -> [String]-labels = map ((filter (/=' ')) . (take 35) . (drop 11) . show . (!!3))+labels = fmap (thread [filter (/=' '), take 35, drop 11] . show . (!!3)) -- | Flatten a nested tuple. flatten :: ((a,b),c) -> (a,b,c)
src/depends/readshp/Geometry/Shapefile/Internal.hs view
@@ -6,9 +6,9 @@ module Geometry.Shapefile.Internal where -import Control.Monad ( replicateM )-import Data.Binary.Get-import Data.Binary.IEEE754 ( getFloat64le )+import Control.Monad (replicateM)+import Data.Binary.Get+import Data.Binary.IEEE754 (getFloat64le) import qualified Data.ByteString.Char8 as C -- | 8-bit Int value@@ -43,14 +43,12 @@ -- | Two doubles making up a point with two coordinates getPoint :: Get Point-getPoint = do x <- getFloat64le- y <- getFloat64le- return (x, y)+getPoint = (,) <$> getFloat64le <*> getFloat64le -- | Get the increments between list values steps :: Num a => [a] -> [a] steps [] = []-steps (_:[]) = []+steps [_] = [] steps (x1:x2:xs) = x2 - x1 : steps (x2:xs) -- | List of points of length `numPoints`
src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs view
@@ -6,25 +6,24 @@ module Geometry.Shapefile.MergeShpDbf ( readShpWithDbf ) where -import System.FilePath--import qualified Data.ByteString.Lazy as BL--import Geometry.Shapefile.ReadDbf-import Geometry.Shapefile.ReadShp-import Geometry.Shapefile.Types+import qualified Data.ByteString.Lazy as BL+import Data.Semigroup+import Geometry.Shapefile.ReadDbf+import Geometry.Shapefile.ReadShp+import Geometry.Shapefile.Types+import System.FilePath -- | Read a shp-file from `fp`, and a dbf file from the same path but with -- modified extension. readShpWithDbf :: String -> IO ShpData readShpWithDbf fp = do shpData <- readShpData <$> BL.readFile fp- let dbfPath = dropExtension fp ++ ".dbf"+ let dbfPath = dropExtension fp <> ".dbf" dbfData <- readDbfData <$> BL.readFile dbfPath- return shpData {+ pure shpData { dbfFieldDescs = Just $ dbfFields dbfData, shpRecs = zipWith addRecLabel (shpRecs shpData) (dbfRecords dbfData) } addRecLabel :: ShpRec -> [DbfRecord] -> ShpRec-addRecLabel sr labels = sr { shpRecLabel = Just (labels) } -- FIXME add field name as string+addRecLabel sr labels = sr { shpRecLabel = Just labels } -- FIXME add field name as string
src/depends/readshp/Geometry/Shapefile/ReadDbf.hs view
@@ -10,14 +10,14 @@ readDbfData ) where -import Control.Monad ( replicateM )-import Control.Monad.Loops ( whileM )-import Data.Binary.Get hiding (getInt8)+import Control.Monad (replicateM)+import Control.Monad.Loops (whileM)+import Data.Binary.Get hiding (getInt8) -import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy as BL -import Geometry.Shapefile.Internal-import Geometry.Shapefile.Types+import Geometry.Shapefile.Internal+import Geometry.Shapefile.Types -- | Read dbf file at `fp` into resident data format `DbfData` readDbfFile :: String -> IO DbfData@@ -37,7 +37,7 @@ -- Records recs <- replicateM numRecs (getWord8 >> mapM getDbfRecord fields) -- Everything together- return DbfData { dbfNumRecs = numRecs,+ pure DbfData { dbfNumRecs = numRecs, dbfFields = fields, dbfRecords = recs } @@ -49,7 +49,7 @@ _ <- getIntLE -- Field displacement (?) len <- getInt8 -- Field length _ <- getByteString 15 -- Num decimal/field flags/autoincrement- return DbfFieldDesc { fieldName = name,+ pure DbfFieldDesc { fieldName = name, fieldType = fieldT, fieldLen = len }
src/depends/readshp/Geometry/Shapefile/ReadShp.hs view
@@ -9,15 +9,16 @@ readShpData, ) where -import Control.Monad ( replicateM, when )-import Control.Monad.Loops ( whileM )-import Data.Binary.Get-import Data.Binary.IEEE754 ( getFloat64le )+import Control.Monad (replicateM, replicateM_, when)+import Control.Monad.Loops (whileM)+import Data.Binary.Get+import Data.Binary.IEEE754 (getFloat64le)+import Data.Semigroup -import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy as BL -import Geometry.Shapefile.Internal-import Geometry.Shapefile.Types+import Geometry.Shapefile.Internal+import Geometry.Shapefile.Types -- | Read shapefile at `fp` to resident data structure `ShpData` readShpFile :: String -> IO ShpData@@ -28,7 +29,7 @@ readShpData = runGet $ do shpH <- getShpHeader shpRs <- whileM (not <$> isEmpty) getShpRec- return ShpData { shpHeader = shpH,+ pure ShpData { shpHeader = shpH, dbfFieldDescs = Nothing, -- fill using readDbfData shpRecs = shpRs } @@ -37,12 +38,12 @@ getShpHeader = do fc <- getIntBE -- File code when (fc /= 9994) (error "getShpHeader: Input file is not a SHP file")- _ <- replicateM 5 getWord32be -- Unused data+ _ <- replicateM_ 5 getWord32be -- Unused data shpLen <- getIntBE -- File length shpV <- getIntLE -- Version (little-endian!) shpT <- getShpType -- Shape type shpbb <- getShpBBox shpT -- Bounding box- return ShpHeader { shpFileLength = shpLen,+ pure ShpHeader { shpFileLength = shpLen, shpVersion = shpV, shpType = shpT, shpBB = shpbb }@@ -58,13 +59,13 @@ [xMin, yMin, xMax, yMax] <- replicateM 4 getFloat64le [zMin, zMax] <- let ds = replicateM 2 getFloat64le in if t `elem` zTypes- then map Just <$> ds- else ds >> return [Nothing, Nothing]+ then fmap Just <$> ds+ else ds >> pure [Nothing, Nothing] [mMin, mMax] <- let ds = replicateM 2 getFloat64le in if t `elem` mTypes- then map Just <$> ds- else ds >> return [Nothing, Nothing]- return ShpBBox { shpXMin = xMin,+ then fmap Just <$> ds+ else ds >> pure [Nothing, Nothing]+ pure ShpBBox { shpXMin = xMin, shpXMax = xMax, shpYMin = yMin, shpYMax = yMax,@@ -80,84 +81,82 @@ recLen <- getIntBE -- Record length recType <- getShpType -- Shape type recContents <- if recType == ShpNull -- Record contents- then return Nothing+ then pure Nothing else Just <$> getRecContents recType- return ShpRec { shpRecNum = recNum,- shpRecLen = recLen,- shpRecContents = recContents,- shpRecLabel = Nothing,- shpRecType = recType }+ pure ShpRec { shpRecNum = recNum,+ shpRecLen = recLen,+ shpRecContents = recContents,+ shpRecLabel = Nothing,+ shpRecType = recType } -- | Get record contents for record of given type getRecContents :: ShpType -> Get RecContents getRecContents t = case t of - ShpPoint -> do- p <- getPoint- return $ RecPoint p+ ShpPoint -> RecPoint <$> getPoint ShpPointM -> do p <- getPoint m <- getFloat64le- return $ RecPointM { pmPoint = p, pmM = m }+ pure RecPointM { pmPoint = p, pmM = m } ShpPointZ -> do p <- getPoint z <- getFloat64le m <- getFloat64le- return $ RecPointZ { pzPoint = p, pzZ = z, pzM = m }+ pure RecPointZ { pzPoint = p, pzZ = z, pzM = m } ShpMultiPoint -> do (bb, nPoints, points) <- getPointsData- return RecMultiPoint { recMPBBox = bb,- recMPNumPoints = nPoints,- recMPPoints = points }+ pure RecMultiPoint { recMPBBox = bb,+ recMPNumPoints = nPoints,+ recMPPoints = points } ShpMultiPointM -> do (bb, nPoints, points) <- getPointsData (mMin, mMax, ms) <- getMData nPoints- return RecMultiPointM { recMPMBBox = bb,- recMPMNumPoints = nPoints,- recMPMPoints = points,- recMPMMRange = (mMin, mMax),- recMPMMs = ms}+ pure RecMultiPointM { recMPMBBox = bb,+ recMPMNumPoints = nPoints,+ recMPMPoints = points,+ recMPMMRange = (mMin, mMax),+ recMPMMs = ms} ShpMultiPointZ -> do (bb, nPoints, points) <- getPointsData (zMin, zMax, zs) <- getZData nPoints (mMin, mMax, ms) <- getMData nPoints- return RecMultiPointZ { recMPZBBox = bb,- recMPZNumPoints = nPoints,- recMPZPoints = points,- recMPZZRange = (zMin, zMax),- recMPZZs = zs,- recMPZMRange = (mMin, mMax),- recMPZMs = ms }+ pure RecMultiPointZ { recMPZBBox = bb,+ recMPZNumPoints = nPoints,+ recMPZPoints = points,+ recMPZZRange = (zMin, zMax),+ recMPZZs = zs,+ recMPZMRange = (mMin, mMax),+ recMPZMs = ms } ShpPolyLine -> do (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData- return RecPolyLine { recPolLBBox = bb,- recPolLNumParts = nParts,- recPolLNumPoints = nPoints,- recPolLPartLengths = partLengths,- recPolLPoints = pntLists }+ pure RecPolyLine { recPolLBBox = bb,+ recPolLNumParts = nParts,+ recPolLNumPoints = nPoints,+ recPolLPartLengths = partLengths,+ recPolLPoints = pntLists } ShpPolyLineM -> do (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData (mMin, mMax, ms) <- getMData nPoints- return RecPolyLineM { recPolLMBBox = bb,- recPolLMNumParts = nParts,- recPolLMNumPoints = nPoints,- recPolLMPartLengths = partLengths,- recPolLMPoints = pntLists,- recPolLMMRange = (mMin, mMax),- recPolLMMs = ms }+ pure RecPolyLineM { recPolLMBBox = bb,+ recPolLMNumParts = nParts,+ recPolLMNumPoints = nPoints,+ recPolLMPartLengths = partLengths,+ recPolLMPoints = pntLists,+ recPolLMMRange = (mMin, mMax),+ recPolLMMs = ms } ShpPolyLineZ -> do (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData (zMin, zMax, zs) <- getZData nPoints (mMin, mMax, ms) <- getMData nPoints- return RecPolyLineZ { recPolLZBBox = bb,+ pure RecPolyLineZ { recPolLZBBox = bb, recPolLZNumParts = nParts, recPolLZNumPoints = nPoints, recPolLZPartLengths = partLengths,@@ -169,7 +168,7 @@ ShpPolygon -> do (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData- return RecPolygon { recPolBBox = bb,+ pure RecPolygon { recPolBBox = bb, recPolNumParts = nParts, recPolNumPoints = nPoints, recPolPartLengths = partLengths,@@ -178,7 +177,7 @@ ShpPolygonM -> do (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData (mMin, mMax, ms) <- getMData nPoints- return RecPolygonM { recPolMBBox = bb,+ pure RecPolygonM { recPolMBBox = bb, recPolMNumParts = nParts, recPolMNumPoints = nPoints, recPolMPartLengths = partLengths,@@ -190,7 +189,7 @@ (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData (zMin, zMax, zs) <- getZData nPoints (mMin, mMax, ms) <- getMData nPoints- return RecPolygonZ { recPolZBBox = bb,+ pure RecPolygonZ { recPolZBBox = bb, recPolZNumParts = nParts, recPolZNumPoints = nPoints, recPolZPartLengths = partLengths,@@ -201,7 +200,7 @@ recPolZMs = ms } ShpNull ->- return RecNull+ pure RecNull ShpMultiPatch -> error "getShpRec: MultiPatch type is not supported, sorry!"@@ -212,7 +211,7 @@ bb <- getRecBBox nPoints <- getIntLE points <- replicateM nPoints getPoint- return (bb, nPoints, points)+ pure (bb, nPoints, points) -- | Recurring pattern of a bounding box with polygon data getPolyData :: Get (RecBBox, Int, Int, [Int], [[Point]])@@ -221,16 +220,16 @@ nParts <- getIntLE nPoints <- getIntLE partIndices <- replicateM nParts getIntLE- let partLengths = steps $ partIndices ++ [nPoints]+ let partLengths = steps $ partIndices <> [nPoints] pntLists <- mapM getPointList partLengths- return (bb, nParts, nPoints, partLengths, pntLists)+ pure (bb, nParts, nPoints, partLengths, pntLists) -- | Recurring pattern of M-valued data getMData :: Int -> Get (Double, Double, [Double]) getMData nPoints = do [mMin, mMax] <- replicateM 2 getFloat64le ms <- replicateM nPoints getFloat64le- return (mMin, mMax, ms)+ pure (mMin, mMax, ms) -- | Recurring pattern of Z-valued data (same structure as M-valued data) getZData :: Int -> Get (Double, Double, [Double])@@ -240,7 +239,7 @@ getRecBBox :: Get RecBBox getRecBBox = do [xMin, yMin, xMax, yMax] <- replicateM 4 getFloat64le- return RecBBox { recXMin = xMin,+ pure RecBBox { recXMin = xMin, recXMax = xMax, recYMin = yMin, recYMax = yMax }
+ stack.yaml view
@@ -0,0 +1,14 @@+---+resolver: lts-11.3+extra-deps:+ - Chart-diagrams-1.8.3+ - composition-prelude-1.3.0.8+ - SVGFonts-1.6.0.3+ - diagrams-core-1.4.0.1+ - diagrams-lib-1.4.2+ - diagrams-postscript-1.4+ - diagrams-svg-1.4.1.1+ - diagrams-solve-0.1.1+ - dual-tree-0.2.1.1+ - lens-4.15.4+ - free-4.12.4
test/Spec.hs view
@@ -7,12 +7,12 @@ main :: IO () main = hspec $ do- describe "distance" $ do- it "computes distances along geodesics" $ do- distance ((-74.0059), 40.7128) ((-118.2347), 34.0522) `shouldBe` 3934.997673163554- describe "mercatorFullPng" $ do- it "Reads a map and writes a .png with the mercator projection" $ do- (mkMapPng "test/testmap.png" =<< districtToMapP bonne <$> getDistricts "test/data/worldmap/TM_WORLD_BORDERS-0.3.shp") >>= (`shouldBe` ())- describe "mercatorFullSVG" $ do- it "Reads a map and writes a .svg with the mercator projection" $ do- (mkMapSVG "test/testmap.svg" =<< districtToMapP bonne <$> getDistricts "test/data/worldmap/TM_WORLD_BORDERS-0.3.shp") >>= (`shouldBe` ())+ describe "distance" $+ it "computes distances along geodesics" $+ distance (-74.0059, 40.7128) (-118.2347, 34.0522) `shouldBe` 3934.997673163554+ describe "mercatorFullPng" $+ it "Reads a map and writes a .png with the mercator projection" $+ (mkMapPng "test/testmap.png" =<< districtToMapP bonne <$> getDistricts "test/data/worldmap/TM_WORLD_BORDERS-0.3.shp") >>= (`shouldBe` ())+ describe "mercatorFullSVG" $+ it "Reads a map and writes a .svg with the mercator projection" $+ (mkMapSVG "test/testmap.svg" =<< districtToMapP bonne <$> getDistricts "test/data/worldmap/TM_WORLD_BORDERS-0.3.shp") >>= (`shouldBe` ())