module Data.Geography.GeoJSON (
FeatureCollection(..)
, Feature(..)
, Geometry(..)
, PointGeometry(..)
, MultiPointGeometry(..)
, LineStringGeometry(..)
, MultiLineStringGeometry(..)
, PolygonGeometry(..)
, MultiPolygonGeometry(..)
, readGeoJSON
) where
import Control.Applicative ((<$>), (<*>))
import Control.Monad (guard, liftM2, mzero)
import Data.Aeson (FromJSON(..), Value(..), (.:), (.:?), decode)
import Data.Aeson.Types (Parser)
import Data.Scientific (Scientific)
import qualified Data.ByteString.Lazy.Char8 as BS (readFile)
readGeoJSON
:: FilePath
-> IO (Maybe FeatureCollection)
readGeoJSON file = decode <$> BS.readFile file
data FeatureCollection =
FeatureCollection
{
collectionBoundingBox :: Maybe Value
, features :: [Feature]
}
deriving (Eq, Show)
instance FromJSON FeatureCollection where
parseJSON (Object o) =
do
oType <- o .: "type"
guard $ oType == ("FeatureCollection" :: String)
FeatureCollection
<$> o .:? "bbox"
<*> o .: "features"
parseJSON _ = mzero
data Feature =
Feature
{
boundingBox :: Maybe Value
, geometry :: Geometry
, properties :: Value
, identifier :: Maybe Value
}
deriving (Eq, Show)
instance FromJSON Feature where
parseJSON (Object o) =
do
oType <- o .: "type"
guard $ oType == ("Feature" :: String)
Feature
<$> o .:? "bbox"
<*> o .: "geometry"
<*> o .: "properties"
<*> o .:? "id"
parseJSON _ = mzero
data Geometry =
Point PointGeometry
| MultiPoint MultiPointGeometry
| LineString LineStringGeometry
| MultiLineString MultiLineStringGeometry
| Polygon PolygonGeometry
| MultiPolygon MultiPolygonGeometry
| GeometryCollection [Geometry]
deriving (Eq, Read, Show)
instance FromJSON Geometry where
parseJSON v@(Object o) =
do
gType <- o .: "type"
parseJSON'' gType v
parseJSON _ = mzero
parseJSON'' :: String -> Value -> Parser Geometry
parseJSON'' "Point" = (Point <$>) . parseJSON
parseJSON'' "MultiPoint" = (MultiPoint <$>) . parseJSON
parseJSON'' "LineString" = (LineString <$>) . parseJSON
parseJSON'' "MultiLineString" = (MultiLineString <$>) . parseJSON
parseJSON'' "Polygon" = (Polygon <$>) . parseJSON
parseJSON'' "MultiPolygon" = (MultiPolygon <$>) . parseJSON
parseJSON'' "GeometryCollection" = parseCollection
where
parseCollection (Object o) = GeometryCollection <$> o .: "geometries"
parseCollection _ = mzero
parseJSON'' _ = const mzero
parseJSON' :: (FromJSON a, FromJSON b) => String -> (a -> b) -> Value -> Parser b
parseJSON' gName gConstructor (Object o) =
do
gType <- o .: "type"
guard $ gType == gName
gConstructor <$> o .: "coordinates"
parseJSON' _ _ _ = mzero
data PointGeometry =
PointGeometry
{
coordinates :: [Scientific]
}
deriving (Eq, Read, Show)
instance FromJSON PointGeometry where
parseJSON = parseJSON' "Point" PointGeometry
data MultiPointGeometry =
MultiPointGeometry
{
points :: [PointGeometry]
}
deriving (Eq, Read, Show)
instance FromJSON MultiPointGeometry where
parseJSON =
parseJSON' "MultiPoint" $
MultiPointGeometry <$>
map PointGeometry
data LineStringGeometry =
LineStringGeometry
{
lineString :: [PointGeometry]
}
deriving (Eq, Read, Show)
instance FromJSON LineStringGeometry where
parseJSON =
parseJSON' "LineString" $
LineStringGeometry <$>
map PointGeometry
data MultiLineStringGeometry =
MultiLineStringGeometry
{
lineStrings :: [LineStringGeometry]
}
deriving (Eq, Read, Show)
instance FromJSON MultiLineStringGeometry where
parseJSON =
parseJSON' "MultiLineString" $
MultiLineStringGeometry <$>
map (LineStringGeometry . map PointGeometry)
data PolygonGeometry =
PolygonGeometry
{
exterior :: [PointGeometry]
, holes :: [[PointGeometry]]
}
deriving (Eq, Read, Show)
instance FromJSON PolygonGeometry where
parseJSON =
parseJSON' "Polygon" $
liftM2 PolygonGeometry head tail <$>
map (map PointGeometry)
data MultiPolygonGeometry =
MultiPolygonGeometry
{
polygons :: [PolygonGeometry]
}
deriving (Eq, Read, Show)
instance FromJSON MultiPolygonGeometry where
parseJSON =
parseJSON' "MultiPolygon" $
MultiPolygonGeometry <$>
map (liftM2 PolygonGeometry head tail <$>
map (map PointGeometry))