{-# LANGUAGE FlexibleInstances #-}

-- | Module containing types for various geometrical objects. Lenses included.
module GIS.Types ( -- * Types
                   Point
                 , Polygon
                 , Projection
                 , District (..)
                 , DbfReadError (..)
                 -- * Lenses
                 , districtLabel
                 , area
                 ) where

import           Control.Lens
import           GHC.Generics
import           Text.PrettyPrint.ANSI.Leijen

type Point = (Double, Double)
type Polygon = [Point]
type Projection = Point -> Point

-- | Data type for one record in a shape file, also capable of storing basic
-- information about the district.
data District = District { _shape         :: [Polygon]
                         , _districtLabel :: String
                         , _perimeter     :: Double
                         , _area          :: [Double]
                         , _compactness   :: Double
                         } deriving (Generic, Show)

districtLabel :: Lens' District String
districtLabel f s = fmap (\x -> s { _districtLabel = x }) (f (_districtLabel s))

area :: Lens' District [Double]
area f s = fmap (\x -> s { _area = x }) (f (_area s))

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 ""