Altitude.hs

{-# 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)