{-# LANGUAGE NoImplicitPrelude #-} module Data.Aviation.VFR_Waypoints.Render ( Colour(..) , runColour , colour , render0Results , render0ResultsOr , render0ResultsList , renderVFR_WaypointSeparator , renderVFR_WaypointHeader , renderVFR_Waypoint ) where import Control.Applicative(Applicative(pure, (<*>))) import Control.Category((.)) import Control.Lens((^.)) import Control.Monad(Monad(return, (>>=))) import Data.Aviation.VFR_Waypoints(HasVFR_Waypoint(name, state, code, lat, lon), latitudeDegrees, latitudeMinutes, latitudeMantissa, longitudeDegrees, longitudeMinutes, longitudeMantissa) import Data.Bool(Bool) import Data.Foldable(length) import Data.Function(($)) import Data.Functor(Functor(fmap)) import Data.Int(Int) import Data.List(intercalate, take, drop, (++), replicate, concat) import Data.Maybe(Maybe(Nothing, Just), fromMaybe) import Data.Ord(Ord((<))) import Data.String(String) import Data.Traversable(traverse, sequence) import Prelude(Integral, Fractional, (-), (+), (/), fromIntegral, show) import Text.Printf(printf) mkN :: Int -> String -> String mkN n x = let n' = n - length (take n x) in x ++ replicate n' ' ' data Colour a = Colour (Bool -> a) runColour :: Colour a -> Bool -> a runColour (Colour x) = x instance Functor Colour where fmap f (Colour g) = Colour (f . g) instance Applicative Colour where pure = Colour . pure Colour f <*> Colour a = Colour (f <*> a) instance Monad Colour where return = pure Colour x >>= f = Colour (\p -> runColour (f (x p)) p) colour :: String -> String -> Colour String colour s c = Colour (\p -> if p then concat [ c , s , "\ESC[m" ] else s) render0Results :: Colour String render0Results = colour "0 search results" "\ESC[97m\ESC[41m" render0ResultsOr :: Colour String -> Maybe (Colour String) -> Colour String render0ResultsOr before m = do x <- before y <- fromMaybe render0Results m pure (x ++ y) render0ResultsList :: Colour String -> [Colour String] -> Colour String render0ResultsList _ [] = render0Results render0ResultsList before q@(_:_) = do x <- before y <- fmap (>>= (++ "\n")) (sequence q) pure (x ++ y) renderVFR_WaypointSeparator :: Colour String renderVFR_WaypointSeparator = colour " " "\ESC[34m\ESC[44m" renderVFR_WaypointHeader :: Colour String renderVFR_WaypointHeader = do s <- renderVFR_WaypointSeparator y <- traverse (`colour` "\ESC[31m\ESC[47m") [ mkN 32 "WAYPOINT" , "STATE" , mkN 5 "CODE" , mkN 8 "LAT" , mkN 8 "LON" , mkN 83 "openstreetmap.org" , "SCORE" ] pure (intercalate s y) renderVFR_Waypoint :: HasVFR_Waypoint w => (w, String) -> Colour String renderVFR_Waypoint (w, sc) = let name' = w ^. name state' = w ^. state code' = w ^. code lat' = w ^. lat lon' = w ^. lon toDecimal :: (Integral a, Integral b, Ord c, Fractional c) => (a, b, c) -> c toDecimal (x, y, z) = let x' = fromIntegral x (.?.) = if x' < 0 then (-) else (+) in x' .?. (fromIntegral y/60 + z/60) in do s <- renderVFR_WaypointSeparator y <- traverse ((`colour` "\ESC[40m\ESC[37m") . concat) $ [ [ mkN 32 name' ] , [ mkN 5 $ case state' of Nothing -> "" Just st -> mkN 5 st ] , [ mkN 5 code' ] , [ printf "%03d" (lat' ^. latitudeDegrees) , " " , printf "%02d" (lat' ^. latitudeMinutes) , drop 1 . printf "%.1f" $ (lat' ^. latitudeMantissa) ] , [ show (lon' ^. longitudeDegrees) , " " , printf "%02d" (lon' ^. longitudeMinutes) , drop 1 . printf "%.1f" $ (lon' ^. longitudeMantissa) ] , let lat'' = printf "%08.4f" (toDecimal (lat' ^. latitudeDegrees, lat' ^. latitudeMinutes, lat' ^. latitudeMantissa)) lon'' = printf "%08.4f" (toDecimal (lon' ^. longitudeDegrees, lon' ^. longitudeMinutes, lon' ^. longitudeMantissa)) in [ "https://www.openstreetmap.org/?mlat=" , lat'' , "&mlon=" , lon'' , "#map=13/" , lat'' , "/" , lon'' ] , [ mkN 5 sc ] ] pure (intercalate s y)