packages feed

geodetic-types (empty) → 0.0.1

raw patch · 11 files changed

+1039/−0 lines, 11 filesdep +basedep +dimensionaldep +lenssetup-changed

Dependencies added: base, dimensional, lens, semigroups

Files

+ LICENCE view
@@ -0,0 +1,31 @@+Copyright (c) 2018, Commonwealth Scientific and Industrial Research Organisation+(CSIRO) ABN 41 687 119 230.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of QFPL nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.md view
@@ -0,0 +1,4 @@+0.0.1++* This change log starts.+* The initial version of geodetic-types.
+ geodetic-types.cabal view
@@ -0,0 +1,45 @@+-- documentation, see http://haskell.org/cabal/users-guide/++name:                  geodetic-types+version:               0.0.1+synopsis:              Types for geodetic operations+description:       +  <<http://i.imgur.com/uZnp9ke.png>>+  .+  Geodetic types.+license:               BSD3+license-file:          LICENCE+author:                Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>+maintainer:            Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>+copyright:             Copyright (C) 2018 Commonwealth Scientific and Industrial Research Organisation (CSIRO)+category:              Geodgraphy+build-type:            Simple+extra-source-files:    changelog.md+cabal-version:         >=1.10+homepage:              https://github.com/qfpl/geodetic-types+bug-reports:           https://github.com/qfpl/geodetic-types/issues+tested-with:           GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3++source-repository      head+  type:                git+  location:            git@github.com:qfpl/geodetic-types.git++library+  exposed-modules:       Geodetics.Types+                       , Geodetics.Types.Altitude+                       , Geodetics.Types.Ellipsoid+                       , Geodetics.Types.Helmert+                       , Geodetics.Types.Latitude+                       , Geodetics.Types.Longitude+                       , Geodetics.Types.TRF+                       +  build-depends:         base              >= 4.8     && < 4.12+                       , lens              >= 4.15    && < 4.18+                       , dimensional       >= 1       && < 1.2+                       , semigroups        >= 0.9     && < 0.19++  hs-source-dirs:      src++  default-language:    Haskell2010++  ghc-options:         -Wall
+ src/Geodetics/Types.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Geodetics.Types(+  module T+) where++import Geodetics.Types.Altitude as T+import Geodetics.Types.Ellipsoid as T+import Geodetics.Types.Helmert as T+import Geodetics.Types.Latitude as T+import Geodetics.Types.Longitude as T+import Geodetics.Types.TRF as T
+ src/Geodetics/Types/Altitude.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}++module Geodetics.Types.Altitude(+  Altitude(..)+, HasAltitude(..)+, AsAltitude(..)+, ManyAltitude(..)+, GetAltitude(..)+, SetAltitude(..)+, FoldAltitude(..)+, IsAltitude(..)+, groundPosition+) where++import Control.Category((.), id)+import Control.Lens(Lens', Prism', Traversal', Getter, Setter', Fold, Iso', Wrapped(_Wrapped'), Unwrapped, iso, prism, set)+import Data.Either(Either(Right))+import Data.Eq(Eq)+import Data.Functor(fmap)+import Data.Ord(Ord)+import Numeric.Units.Dimensional.Prelude(Length, _0)+import Prelude(Double, Show)++newtype Altitude =+  Altitude+    (Length Double)+  deriving (Eq, Ord, Show)+  +instance Wrapped Altitude where+  type Unwrapped Altitude =+    Length Double+  _Wrapped' =+    iso+      (\(Altitude x) -> x)+      Altitude++class HasAltitude a where+  altitude ::+    Lens' a Altitude+  altitudeLength ::+    Lens' a (Length Double)+  {-# INLINE altitudeLength #-}+  altitudeLength =+    altitude . altitudeLength++instance HasAltitude Altitude where+  altitude =+    id+  altitudeLength k (Altitude x) =+    fmap Altitude (k x)++class ManyAltitude a => AsAltitude a where+  _Altitude ::+    Prism' a Altitude+  _AltitudeFields ::+    Prism' a (Length Double)+  _AltitudeFields =+    _Altitude . _AltitudeFields++instance AsAltitude Altitude where+  _Altitude =+    id+  _AltitudeFields =+    prism+      Altitude+      (\(Altitude x) -> Right x)++class (FoldAltitude a, SetAltitude a) => ManyAltitude a where+  _ManyAltitude ::+    Traversal' a Altitude++instance ManyAltitude Altitude where+  _ManyAltitude =+    id++class FoldAltitude a => GetAltitude a where+  _GetAltitude ::+    Getter a Altitude+    +instance GetAltitude Altitude where+  _GetAltitude =+    id++class SetAltitude a where+  _SetAltitude ::+    Setter' a Altitude+    +instance SetAltitude Altitude where+  _SetAltitude =+    id++class FoldAltitude a where+  _FoldAltitude ::+    Fold a Altitude+    +instance FoldAltitude Altitude where+  _FoldAltitude =+    id++class (HasAltitude a, AsAltitude a) => IsAltitude a where+  _IsAltitude ::+    Iso' a Altitude+    +instance IsAltitude Altitude where+  _IsAltitude =+    id+groundPosition ::+  HasAltitude a =>+  a+  -> a+groundPosition =+  set altitude (Altitude _0)
+ src/Geodetics/Types/Ellipsoid.hs view
@@ -0,0 +1,204 @@+{-# 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)
+ src/Geodetics/Types/Helmert.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Geodetics.Types.Helmert(+  Helmert(..)+, HasHelmert(..)+, AsHelmert(..)+, ManyHelmert(..)+, GetHelmert(..)+, SetHelmert(..)+, FoldHelmert(..)+, IsHelmert(..)+, translations+, rotations+) where++import Control.Applicative((<*>))+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.Monoid(Monoid(mempty, mappend))+import Data.Semigroup(Semigroup((<>)))+import Numeric.Units.Dimensional.Prelude(Length, Dimensionless, (+), (*~), meter, _0)+import Prelude(Double, Show)++-- | The 7 parameter Helmert transformation. The monoid instance allows composition.+data Helmert =+  Helmert+    (Length Double)+    (Length Double)+    (Length Double)+    (Dimensionless Double)  -- Parts per million+    (Dimensionless Double)+    (Dimensionless Double)+    (Dimensionless Double)+  deriving (Eq, Ord, Show)++class HasHelmert a where+  helmert ::+    Lens' a Helmert+  cX ::+    Lens' a (Length Double)+  {-# INLINE cX #-}+  cY ::+    Lens' a (Length Double)+  {-# INLINE cY #-}+  cZ ::+    Lens' a (Length Double)+  {-# INLINE cZ #-}+  helmertScale ::+    Lens' a (Dimensionless Double)+  {-# INLINE helmertScale #-}+  rX ::+    Lens' a (Dimensionless Double)+  {-# INLINE rX #-}+  rY ::+    Lens' a (Dimensionless Double)+  {-# INLINE rY #-}+  rZ ::+    Lens' a (Dimensionless Double)+  {-# INLINE rZ #-}+  cX =+    helmert . cX+  cY =+     helmert . cY+  cZ =+    helmert . cZ+  helmertScale =+    helmert . helmertScale+  rX =+    helmert . rX+  rY =+    helmert . rY+  rZ =+    helmert . rZ++instance HasHelmert Helmert where+  {-# INLINE cX #-}+  {-# INLINE cY #-}+  {-# INLINE cZ #-}+  {-# INLINE helmertScale #-}+  {-# INLINE rX #-}+  {-# INLINE rY #-}+  {-# INLINE rZ #-}+  helmert =+    id+  cX k (Helmert cX' cY' cZ' helmertScale' rX' rY' rZ') =+    fmap (\x -> Helmert x cY' cZ' helmertScale' rX' rY' rZ') (k cX')+  cY k (Helmert cX' cY' cZ' helmertScale' rX' rY' rZ') =+    fmap (\x -> Helmert cX' x cZ' helmertScale' rX' rY' rZ') (k cY')+  cZ k (Helmert cX' cY' cZ' helmertScale' rX' rY' rZ') =+    fmap (\x -> Helmert cX' cY' x helmertScale' rX' rY' rZ') (k cZ')+  helmertScale k (Helmert cX' cY' cZ' helmertScale' rX' rY' rZ') =+    fmap (\x -> Helmert cX' cY' cZ' x rX' rY' rZ') (k helmertScale')+  rX k (Helmert cX' cY' cZ' helmertScale' rX' rY' rZ') =+    fmap (\x -> Helmert cX' cY' cZ' helmertScale' x rY' rZ') (k rX')+  rY k (Helmert cX' cY' cZ' helmertScale' rX' rY' rZ') =+    fmap (\x -> Helmert cX' cY' cZ' helmertScale' rX' x rZ') (k rY')+  rZ k (Helmert cX' cY' cZ' helmertScale' rX' rY' rZ') =+    fmap (\x -> Helmert cX' cY' cZ' helmertScale' rX' rY' x) (k rZ')++class ManyHelmert a => AsHelmert a where+  _Helmert ::+    Prism' a Helmert++  _HelmertFields ::+    Prism' a (Length Double, Length Double, Length Double, Dimensionless Double, Dimensionless Double, Dimensionless Double, Dimensionless Double)+  _HelmertFields =+    _Helmert . _HelmertFields++instance AsHelmert Helmert where+  _Helmert =+    id++  _HelmertFields =+    prism+      (\(cX', cY', cZ', helmertScale', rX', rY', rZ') -> Helmert cX' cY' cZ' helmertScale' rX' rY' rZ')+      (\(Helmert cX' cY' cZ' helmertScale' rX' rY' rZ') -> Right (cX', cY', cZ', helmertScale', rX', rY', rZ'))++class (FoldHelmert a, SetHelmert a) => ManyHelmert a where+  _ManyHelmert ::+    Traversal' a Helmert++instance ManyHelmert Helmert where+  _ManyHelmert =+    id++class FoldHelmert a => GetHelmert a where+  _GetHelmert ::+    Getter a Helmert+    +instance GetHelmert Helmert where+  _GetHelmert =+    id++class SetHelmert a where+  _SetHelmert ::+    Setter' a Helmert+    +instance SetHelmert Helmert where+  _SetHelmert =+    id++class FoldHelmert a where+  _FoldHelmert ::+    Fold a Helmert+    +instance FoldHelmert Helmert where+  _FoldHelmert =+    id++class (HasHelmert a, AsHelmert a) => IsHelmert a where+  _IsHelmert ::+    Iso' a Helmert+    +instance IsHelmert Helmert where+  _IsHelmert =+    id++instance Semigroup Helmert where+  h1 <> h2 =+    let p x =+          h1 ^. x + h2 ^. x+    in  Helmert+          (p cX)+          (p cY)+          (p cZ)+          (p helmertScale)+          (p rX)+          (p rY)+          (p rZ)++instance Monoid Helmert where+  mempty =+    Helmert+      (0 *~ meter)+      (0 *~ meter)+      (0 *~ meter)+      _0+      _0+      _0+      _0+  mappend =+    (<>)++translations ::+  Traversal'+    Helmert+    (Length Double)+translations k (Helmert cX' cY' cZ' helmertScale' rX' rY' rZ') =+  (\cX'' cY'' cZ'' -> Helmert cX'' cY'' cZ'' helmertScale' rX' rY' rZ') <$>+  k cX' <*>+  k cY' <*>+  k cZ'++rotations ::+  Traversal'+    Helmert+    (Dimensionless Double)+rotations k (Helmert cX' cY' cZ' helmertScale' rX' rY' rZ') =+  Helmert cX' cY' cZ' helmertScale' <$>+  k rX' <*>+  k rY' <*>+  k rZ'
+ src/Geodetics/Types/Latitude.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}++module Geodetics.Types.Latitude(+  Latitude(..)+, HasLatitude(..)+, AsLatitude(..)+, ManyLatitude(..)+, GetLatitude(..)+, SetLatitude(..)+, FoldLatitude(..)+, IsLatitude(..)  +) where+  +import Control.Category((.), id)+import Control.Lens(Lens', Prism', Traversal', Getter, Setter', Fold, Iso', Wrapped(_Wrapped'), Unwrapped, iso, prism)+import Data.Either(Either(Right))+import Data.Eq(Eq)+import Data.Functor(fmap)+import Data.Ord(Ord)+import Numeric.Units.Dimensional.Prelude(Angle)+import Prelude(Double, Show)++newtype Latitude =+  Latitude+    (Angle Double)+  deriving (Eq, Ord, Show)++instance Wrapped Latitude where+  type Unwrapped Latitude =+    Angle Double+  _Wrapped' =+    iso+      (\(Latitude x) -> x)+      Latitude++class HasLatitude a where+  latitude ::+    Lens' a Latitude+  latitudeAngle ::+    Lens' a (Angle Double)+  {-# INLINE latitudeAngle #-}+  latitudeAngle =+    latitude . latitudeAngle++instance HasLatitude Latitude where+  latitude =+    id+  latitudeAngle k (Latitude x) =+    fmap Latitude (k x)++class ManyLatitude a => AsLatitude a where+  _Latitude ::+    Prism' a Latitude+  _LatitudeFields ::+    Prism' a (Angle Double)+  _LatitudeFields =+    _Latitude . _LatitudeFields++instance AsLatitude Latitude where+  _Latitude =+    id+  _LatitudeFields =+    prism+      Latitude+      (\(Latitude x) -> Right x)++class (FoldLatitude a, SetLatitude a) => ManyLatitude a where+  _ManyLatitude ::+    Traversal' a Latitude++instance ManyLatitude Latitude where+  _ManyLatitude =+    id++class FoldLatitude a => GetLatitude a where+  _GetLatitude ::+    Getter a Latitude+    +instance GetLatitude Latitude where+  _GetLatitude =+    id++class SetLatitude a where+  _SetLatitude ::+    Setter' a Latitude+    +instance SetLatitude Latitude where+  _SetLatitude =+    id++class FoldLatitude a where+  _FoldLatitude ::+    Fold a Latitude+    +instance FoldLatitude Latitude where+  _FoldLatitude =+    id++class (HasLatitude a, AsLatitude a) => IsLatitude a where+  _IsLatitude ::+    Iso' a Latitude+    +instance IsLatitude Latitude where+  _IsLatitude =+    id
+ src/Geodetics/Types/Longitude.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}++module Geodetics.Types.Longitude(+  Longitude(..)+, HasLongitude(..)+, AsLongitude(..)+, ManyLongitude(..)+, GetLongitude(..)+, SetLongitude(..)+, FoldLongitude(..)+, IsLongitude(..)+) where++import Control.Category((.), id)+import Control.Lens(Lens', Prism', Traversal', Getter, Setter', Fold, Iso', Wrapped(_Wrapped'), Unwrapped, iso, prism)+import Data.Either(Either(Right))+import Data.Eq(Eq)+import Data.Functor(fmap)+import Data.Ord(Ord)+import Numeric.Units.Dimensional.Prelude(Angle)+import Prelude(Double, Show)++newtype Longitude =+  Longitude+    (Angle Double)+  deriving (Eq, Ord, Show)+  +instance Wrapped Longitude where+  type Unwrapped Longitude =+    Angle Double+  _Wrapped' =+    iso+      (\(Longitude x) -> x)+      Longitude++class HasLongitude a where+  longitude ::+    Lens' a Longitude+  longitudeAngle ::+    Lens' a (Angle Double)+  {-# INLINE longitudeAngle #-}+  longitudeAngle =+    longitude . longitudeAngle++instance HasLongitude Longitude where+  longitude =+    id+  longitudeAngle k (Longitude x) =+    fmap Longitude (k x)++class ManyLongitude a => AsLongitude a where+  _Longitude ::+    Prism' a Longitude+  _LongitudeFields ::+    Prism' a (Angle Double)+  _LongitudeFields =+    _Longitude . _LongitudeFields++instance AsLongitude Longitude where+  _Longitude =+    id+  _LongitudeFields =+    prism+      Longitude+      (\(Longitude x) -> Right x)++class (FoldLongitude a, SetLongitude a) => ManyLongitude a where+  _ManyLongitude ::+    Traversal' a Longitude++instance ManyLongitude Longitude where+  _ManyLongitude =+    id++class FoldLongitude a => GetLongitude a where+  _GetLongitude ::+    Getter a Longitude+    +instance GetLongitude Longitude where+  _GetLongitude =+    id++class SetLongitude a where+  _SetLongitude ::+    Setter' a Longitude+    +instance SetLongitude Longitude where+  _SetLongitude =+    id++class FoldLongitude a where+  _FoldLongitude ::+    Fold a Longitude+    +instance FoldLongitude Longitude where+  _FoldLongitude =+    id++class (HasLongitude a, AsLongitude a) => IsLongitude a where+  _IsLongitude ::+    Iso' a Longitude+    +instance IsLongitude Longitude where+  _IsLongitude =+    id
+ src/Geodetics/Types/TRF.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Geodetics.Types.TRF(+  TRF(..)+, HasTRF(..)+, AsTRF(..)+, ManyTRF(..)+, GetTRF(..)+, SetTRF(..)+, FoldTRF(..)+, IsTRF(..)+, _WGS84+, _OSGB36+, _Clarke1866+, _Bessel1841+) 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.Monoid(mempty)+import Data.Ord(Ord)+import Data.Functor(fmap)+import Data.Tuple(uncurry)+import Geodetics.Types.Ellipsoid(Ellipsoid(Ellipsoid), HasEllipsoid(ellipsoid), GetEllipsoid(_GetEllipsoid), ManyEllipsoid(_ManyEllipsoid), FoldEllipsoid(_FoldEllipsoid), SetEllipsoid(_SetEllipsoid))+import Geodetics.Types.Helmert(Helmert(Helmert), HasHelmert(helmert), GetHelmert(_GetHelmert), ManyHelmert(_ManyHelmert), FoldHelmert(_FoldHelmert), SetHelmert(_SetHelmert))+import Numeric.Units.Dimensional.Prelude((*~), meter, one, arcsecond)+import Prelude(Show)++data TRF =+  TRF+    Ellipsoid+    Helmert+  deriving (Eq, Ord, Show)++instance HasEllipsoid TRF where+  ellipsoid k (TRF e h) =+    fmap (\e' -> TRF e' h) (k e)++instance GetEllipsoid TRF where+  _GetEllipsoid =+    ellipsoid++instance ManyEllipsoid TRF where+  _ManyEllipsoid =+    ellipsoid++instance FoldEllipsoid TRF where+  _FoldEllipsoid =+    ellipsoid++instance SetEllipsoid TRF where+  _SetEllipsoid =+    ellipsoid++instance HasHelmert TRF where+  helmert k (TRF e h) =+    fmap (\h' -> TRF e h') (k h)++instance GetHelmert TRF where+  _GetHelmert =+    helmert++instance ManyHelmert TRF where+  _ManyHelmert =+    helmert++instance FoldHelmert TRF where+  _FoldHelmert =+    helmert++instance SetHelmert TRF where+  _SetHelmert =+    helmert++class (GetTRF a, ManyTRF a, HasEllipsoid a) => HasTRF a where+  trf ::+    Lens' a TRF+    +instance HasTRF TRF where+  trf =+    id++class ManyTRF a => AsTRF a where+  _TRF ::+    Prism' a TRF+  _TRFFields ::+    Prism' a (Ellipsoid, Helmert)+  _TRFFields =+    _TRF . _TRFFields++instance AsTRF TRF where+  _TRF =+    id+  _TRFFields =+    prism+      (uncurry TRF)+      (\(TRF e h) -> Right (e, h))++class (FoldTRF a, SetTRF a) => ManyTRF a where+  _ManyTRF ::+    Traversal' a TRF++instance ManyTRF TRF where+  _ManyTRF =+    id++class FoldTRF a => GetTRF a where+  _GetTRF ::+    Getter a TRF+    +instance GetTRF TRF where+  _GetTRF =+    id++class SetTRF a where+  _SetTRF ::+    Setter' a TRF+    +instance SetTRF TRF where+  _SetTRF =+    id++class FoldTRF a where+  _FoldTRF ::+    Fold a TRF+    +instance FoldTRF TRF where+  _FoldTRF =+    id++class (HasTRF a, AsTRF a) => IsTRF a where+  _IsTRF ::+    Iso' a TRF+    +instance IsTRF TRF where+  _IsTRF =+    id++_WGS84 ::+  TRF+_WGS84 =+  TRF+    (+      Ellipsoid+        (6378137.0 *~ meter)+        (298.257223563 *~ one)+    )+    mempty++_OSGB36 ::+  TRF+_OSGB36 =+  TRF+    (+      Ellipsoid+        (6377563.396 *~ meter)+        (299.3249646 *~ one)+    )+    (+      Helmert +        (446.448 *~ meter)+        ((-125.157) *~ meter)+        (542.06 *~ meter)+        ((-20.4894) *~ one)+        (0.1502 *~ arcsecond)+        (0.247 *~ arcsecond)+        (0.8421 *~ arcsecond)+    )++_Clarke1866 ::+  TRF+_Clarke1866 =+  TRF+    (+      Ellipsoid+        (6378206.4 *~ meter)+        (294.978698214 *~ one)+    )+    (+      Helmert +        ((-8) *~ meter)+        (160 *~ meter)+        (176 *~ meter)+        (0 *~ one)+        (0 *~ arcsecond)+        (0 *~ arcsecond)+        (0 *~ arcsecond)+    )++_Bessel1841 ::+  TRF+_Bessel1841 =+  TRF+    (+      Ellipsoid+        (6377397.155 *~ meter)+        (299.1528153513233 *~ one)+    )+    (+      Helmert +        (582 *~ meter)+        (105 *~ meter)+        (414 *~ meter)+        (8.3 *~ one)+        (1.04 *~ arcsecond)+        (0.35 *~ arcsecond)+        (3.08 *~ arcsecond)+    )