{-# LANGUAGE NoImplicitPrelude #-} module Geodetics.Types.Ellipsoid( Ellipsoid(..) , HasEllipsoid(..) , AsEllipsoid(..) , ManyEllipsoid(..) , GetEllipsoid(..) , SetEllipsoid(..) , FoldEllipsoid(..) , IsEllipsoid(..) , _GRS80 , _GRS67 , _Ans , _WGS72 , _AU1965 , _Krasovsky1940 , _International1924 , _Hayford1909 , _Airy1830 , _Everest1830 , _Clarke1858 , _Clarke1880 ) where import Control.Category((.), id) import Control.Lens(Lens', Prism', Traversal', Getter, Setter', Fold, Iso', prism) import Data.Either(Either(Right)) import Data.Eq(Eq) import Data.Ord(Ord) import Data.Functor(fmap) import Data.Tuple(uncurry) import Numeric.Units.Dimensional.Prelude(Length, Dimensionless, (*~), meter, one) import Prelude(Double, Show) data Ellipsoid = Ellipsoid (Length Double) -- majorRadius (Dimensionless Double) -- flatR deriving (Eq, Ord, Show) class (GetEllipsoid a, ManyEllipsoid a) => HasEllipsoid a where ellipsoid :: Lens' a Ellipsoid majorRadius :: Lens' a (Length Double) {-# INLINE majorRadius #-} flatR :: Lens' a (Dimensionless Double) {-# INLINE flatR #-} majorRadius = ellipsoid . majorRadius flatR = ellipsoid . flatR instance HasEllipsoid Ellipsoid where ellipsoid = id majorRadius k (Ellipsoid r f) = fmap (\r' -> Ellipsoid r' f) (k r) {-# INLINE majorRadius #-} flatR k (Ellipsoid r f) = fmap (\f' -> Ellipsoid r f') (k f) {-# INLINE flatR #-} class ManyEllipsoid a => AsEllipsoid a where _Ellipsoid :: Prism' a Ellipsoid _EllipsoidFields :: Prism' a (Length Double, Dimensionless Double) _EllipsoidFields = _Ellipsoid . _EllipsoidFields instance AsEllipsoid Ellipsoid where _Ellipsoid = id _EllipsoidFields = prism (uncurry Ellipsoid) (\(Ellipsoid r f) -> Right (r, f)) class (FoldEllipsoid a, SetEllipsoid a) => ManyEllipsoid a where _ManyEllipsoid :: Traversal' a Ellipsoid instance ManyEllipsoid Ellipsoid where _ManyEllipsoid = id class FoldEllipsoid a => GetEllipsoid a where _GetEllipsoid :: Getter a Ellipsoid instance GetEllipsoid Ellipsoid where _GetEllipsoid = id class SetEllipsoid a where _SetEllipsoid :: Setter' a Ellipsoid instance SetEllipsoid Ellipsoid where _SetEllipsoid = id class FoldEllipsoid a where _FoldEllipsoid :: Fold a Ellipsoid instance FoldEllipsoid Ellipsoid where _FoldEllipsoid = id class (HasEllipsoid a, AsEllipsoid a) => IsEllipsoid a where _IsEllipsoid :: Iso' a Ellipsoid instance IsEllipsoid Ellipsoid where _IsEllipsoid = id _GRS80 :: Ellipsoid _GRS80 = Ellipsoid (6378137.0 *~ meter) (294.25722100882711 *~ one) _GRS67 :: Ellipsoid _GRS67 = Ellipsoid (6378160 *~ meter) (298.25 *~ one) _Ans :: Ellipsoid _Ans = Ellipsoid (6378160 *~ meter) (298.25 *~ one) _WGS72 :: Ellipsoid _WGS72 = Ellipsoid (6378135 *~ meter) (298.26 *~ one) _AU1965 :: Ellipsoid _AU1965 = Ellipsoid (6378160 *~ meter) (298.25 *~ one) _Krasovsky1940 :: Ellipsoid _Krasovsky1940 = Ellipsoid (6378245 *~ meter) (298.3 *~ one) _International1924 :: Ellipsoid _International1924 = Ellipsoid (6378388 *~ meter) (297 *~ one) _Hayford1909 :: Ellipsoid _Hayford1909 = Ellipsoid (6378388 *~ meter) (297 *~ one) _Airy1830 :: Ellipsoid _Airy1830 = Ellipsoid (6377563.4 *~ meter) (299.32 *~ one) _Everest1830 :: Ellipsoid _Everest1830 = Ellipsoid (6377276.3 *~ meter) (300.8 *~ one) _Clarke1858 :: Ellipsoid _Clarke1858 = Ellipsoid (6378293.645 *~ meter) (294.26 *~ one) _Clarke1880 :: Ellipsoid _Clarke1880 = Ellipsoid (6378249.145 *~ meter) (293.465 *~ one)