module Data.Aviation.Casr.Logbook.Html.Html(
htmlTimeAmount
, strTimeAmount
, strEngine
, htmlAircraft
, htmlRatingDay
, htmlRating
, htmlRatingShort
, htmlRatings
, htmlRatingsShort
, htmlAviatorName
, htmlAviatorARN
, htmlAviatorDob
, htmlAviatorRatings
, htmlAviator
, htmlAviatorShort
, htmlFlightPoint
, htmlFlightPath
, htmlCommand
, htmlTimeAmountZero
, htmlTimeAmountZeroWith
, htmlAviators
, htmlAircraftFlightName
, htmlAircraftFlight
, htmlTimeOfDayTime
, htmlTime
, htmlFlightPathTime
, htmlSimulatorFlightName
, htmlSimulatorFlight
, htmlLocation
, htmlExamResult
, htmlExamName
, htmlExam
, htmlBriefingName
, htmlBriefing
, space2dot
, htmlEntryTag
, htmlEntry
, htmlEntries
, htmlLogbook
, htmlTitleAviator
, htmlLogbookDocument
, htmlLogbookHeader
) where
import Control.Applicative((*>))
import Control.Category((.), id)
import Control.Lens((^.))
import Control.Monad(when, (=<<), (>>=))
import Data.Aviation.Casr.Logbook.Types(
arn
, firstname
, surname
, logbookaviator
, daytime
, briefingTime
, briefingName
, examName
, examTime
, simulatorflightname
, simulatortype
, point
, flightStart
, flightEnd
, flightpath
, aircraftRegistration
, aircraftflightname
, flightaircraft
, landingTime
, zerotimeamount
, flightPathList
, Command(ICUS, Dual, InCommand)
, Rating(Rating)
, Aircraft(Aircraft)
, Engine(Single, Multi)
, FlightPath
, FlightPoint(FlightPoint)
, Time(Time)
, TimeAmount(TimeAmount)
, DayNight(DayNight)
, Briefing(Briefing)
, Exam(Exam)
, Location(Location)
, Aviator(Aviator)
, Entries(Entries)
, Logbook(Logbook)
, AircraftFlight(AircraftFlight)
, SimulatorFlight(SimulatorFlight)
, Briefing
, Exam
, Entry(BriefingEntry, ExamEntry, SimulatorFlightEntry, AircraftFlightEntry)
)
import Data.Bool(not)
import Data.Char(toUpper)
import Data.Digit(Digit)
import Data.Eq((==))
import Data.Foldable(fold, sequence_, mapM_, null)
import Data.Function(($))
import Data.Functor((<$>))
import Data.Int(Int)
import Data.List(intersperse, concat)
import Data.Maybe(Maybe, maybe)
import Data.Monoid(Monoid, (<>), mempty)
import Data.String(String, fromString)
import Data.Time(Day, TimeOfDay)
import Data.Text(Text)
import qualified Data.Text as Text(pack)
import Lucid(
id_
, class_
, h1_
, h2_
, h3_
, span_
, a_
, div_
, href_
, src_
, type_
, script_
, body_
, title_
, rel_
, link_
, title_
, html_
, doctype_
, head_
, lang_
, hr_
, ul_
, li_
, Html
, toHtmlRaw
)
import Text.Printf(printf)
import Prelude(show, fromIntegral, (/), (*), Double)
htmlTimeAmount ::
TimeAmount
-> Html ()
htmlTimeAmount t =
span_ [] $
do fromString (strTimeAmount t)
"hrs"
strTimeAmount ::
TimeAmount
-> String
strTimeAmount (TimeAmount h x) =
show h <> "." <> show x
strEngine ::
Engine
-> String
strEngine Single =
"single-engine"
strEngine Multi =
"multi-engine"
htmlAircraft ::
AircraftFlight
-> Aircraft
-> Html ()
htmlAircraft _ (Aircraft t r e) =
span_ [class_ "aircraft"] $
do span_ [class_ "aircrafttype"] (fromString t)
" "
span_ [class_ "aircraftregistration"] (fromString r)
" "
span_ [class_ "aircraftengine"] (fromString (strEngine e))
htmlRatingDay ::
Maybe Day
-> Html ()
htmlRatingDay =
maybe mempty (\q ->
do " "
span_ [] $
fromString (show q))
htmlRating ::
Rating
-> Html ()
htmlRating (Rating n d) =
span_ [] $
do span_ [] (fromString n)
htmlRatingDay d
htmlRatingShort ::
Rating
-> Html ()
htmlRatingShort (Rating n _) =
span_ [] (fromString n)
htmlRatings ::
[Rating]
-> Html ()
htmlRatings =
sequence_ . intersperse ", " . (htmlRating <$>)
htmlRatingsShort ::
[Rating]
-> Html ()
htmlRatingsShort =
sequence_ . intersperse ", " . (htmlRatingShort <$>)
htmlAviatorName ::
String
-> String
-> Html ()
htmlAviatorName s f =
do li_ [id_ "aviatorname"] $
do span_ [class_ "key"] "Name: "
span_ [class_ "value"] $
do fromString (toUpper <$> s)
", "
fromString f
htmlAviatorARN ::
[Digit]
-> Html ()
htmlAviatorARN a =
when (not . null $ a) $
do li_ [id_ "aviatorarn"] $
do span_ [class_ "key"] "ARN: "
span_ [class_ "value"] $
fromString (a >>= show)
htmlAviatorDob ::
Maybe Day
-> Html ()
htmlAviatorDob =
maybe mempty (\q ->
do li_ [id_ "aviatordob"] $
do span_ [class_ "key"] "Date of Birth: "
span_ [class_ "value"] .
fromString . show $ q)
htmlAviatorRatings ::
[Rating]
-> Html ()
htmlAviatorRatings r =
when (not . null $ r) $
do li_ [id_ "aviatorratings"] $
do span_ [class_ "key"] "Ratings: "
span_ [class_ "value"] .
htmlRatings $ r
htmlAviator ::
Aviator
-> Html ()
htmlAviator (Aviator s f a d r) =
div_ [id_ "aviator", class_ "aviator"] .
ul_ [] $
do htmlAviatorName s f
htmlAviatorARN a
htmlAviatorDob d
htmlAviatorRatings r
htmlAviatorShort ::
Aviator
-> Html ()
htmlAviatorShort (Aviator s f a _ r) =
do fromString f
" "
fromString s
when (not . null $ a) $ " "
fromString (a >>= show)
when (not . null $ r) $ " "
htmlRatingsShort r
htmlFlightPoint ::
AircraftFlight
-> FlightPoint
-> Html ()
htmlFlightPoint _ (FlightPoint p _ _) =
span_ [class_ "flightpoint"] $
fromString p
htmlFlightPath ::
AircraftFlight
-> FlightPath
-> Html ()
htmlFlightPath fl p =
span_ [class_ "flightpath"] $
fold (intersperse (toHtmlRaw (" — " :: Text)) (htmlFlightPoint fl <$> flightPathList p))
htmlCommand ::
AircraftFlight
-> Command
-> Html ()
htmlCommand _ InCommand =
span_ [class_ "command incommand"] "In-Command"
htmlCommand _ (ICUS a) =
do span_ [class_ "command incommandunderinstruction"] "In-Command Under-Instruction"
span_ [class_ "commandphrase"] $ " by "
span_ [class_ "commandaviator"] $ htmlAviatorShort a
htmlCommand _ (Dual a) =
do span_ [class_ "command dualunderinstruction"] "Dual Under-Instruction"
span_ [class_ "commandphrase"] $ " by "
span_ [class_ "commandaviator"] $ htmlAviatorShort a
htmlTimeAmountZero ::
TimeAmount
-> Html ()
htmlTimeAmountZero =
htmlTimeAmountZeroWith id
htmlTimeAmountZeroWith ::
Monoid a =>
(Html () -> a)
-> TimeAmount
-> a
htmlTimeAmountZeroWith f z =
if z == zerotimeamount
then
mempty
else
f (htmlTimeAmount z)
htmlAviators ::
[Aviator]
-> Html ()
htmlAviators =
ul_ [] .
mapM_ (li_ [] . htmlAviatorShort)
htmlAircraftFlightName ::
String
-> Html ()
htmlAircraftFlightName n =
h3_ [class_ "aircraftflightname"] $
fromString n
htmlAircraftFlight ::
AircraftFlight
-> Html ()
htmlAircraftFlight fl@(AircraftFlight n a c (DayNight d m) p o i) =
div_ [class_ "aircraftflight"] $
do htmlAircraftFlightName n
ul_ [] $
do li_ [] $
do span_ [class_ "key"] "Time: "
span_ [class_ "value"] .
htmlFlightPathTime $ p
li_ [] $
do span_ [class_ "key"] "Aircraft: "
span_ [class_ "value"] .
htmlAircraft fl $ a
li_ [] $
do span_ [class_ "key"] "Command: "
span_ [class_ "value"] .
htmlCommand fl $ c
htmlTimeAmountZeroWith (\t ->
li_ [] $
do span_ [class_ "key"] "Amount (day): "
span_ [class_ "value"] t) d
htmlTimeAmountZeroWith (\t ->
li_ [] $
do span_ [class_ "key"] "Amount (night): "
span_ [class_ "value"] t) m
htmlTimeAmountZeroWith (\t ->
li_ [] $
do span_ [class_ "key"] "Amount (instrument): "
span_ [class_ "value"] t) i
li_ [] $
do span_ [class_ "key"] "Flight Path: "
span_ [class_ "value"] .
htmlFlightPath fl $ p
when (not . null $ o) . li_ [] $
do span_ [class_ "key"] "Other Crew: "
span_ [class_ "value"] .
htmlAviators $ o
htmlTimeOfDayTime ::
Maybe TimeOfDay
-> Html ()
htmlTimeOfDayTime =
maybe mempty (\e -> do " "
fromString (show e))
htmlTime ::
Time
-> Html ()
htmlTime (Time t d) =
span_ [class_ "time"] $
do fromString (show t)
htmlTimeOfDayTime d
htmlFlightPathTime ::
FlightPath
-> Html()
htmlFlightPathTime p =
let s = p ^. flightStart . landingTime
e = p ^. flightEnd . landingTime
in if s == e
then
htmlTime s
else
do htmlTime s
toHtmlRaw (" — " :: Text)
htmlTime e
htmlSimulatorFlightName ::
String
-> Html ()
htmlSimulatorFlightName n =
h3_ [class_ "simulatorflightname"] $
fromString n
htmlSimulatorFlight ::
SimulatorFlight
-> Html ()
htmlSimulatorFlight (SimulatorFlight n t y o a i) =
div_ [class_ "simulatorflight"] $
do htmlSimulatorFlightName n
ul_ [] $
do li_ [] $
do span_ [class_ "key"] "Time: "
span_ [class_ "value"] .
htmlTime $ t
li_ [] $
do span_ [class_ "key"] "Type: "
span_ [class_ "value"] (fromString y)
when (not . null $ o) . li_ [] $
do span_ [class_ "key"] "Other Crew: "
div_ [class_ "value"] .
htmlAviators $ o
li_ [] $
do span_ [class_ "key"] "Amount: "
span_ [class_ "value"] .
htmlTimeAmount $ a
li_ [] $
do span_ [class_ "key"] "Instrument: "
span_ [class_ "value"] .
htmlTimeAmount $ i
htmlLocation ::
Location
-> Html ()
htmlLocation (Location n t o) =
span_ [class_ "location"] $
do fromString n
" "
let t' = fromString (show t)
o' = fromString (show o)
span_ [class_ "locationopenstreetmap"] $
a_ [href_ ("http://www.openstreetmap.org/?mlat=" <> t' <> "&mlon=" <> o' <> "#map=16/" <> t' <> "/" <> o')]
"osm"
" "
span_ [class_ "locationgooglemaps"] $
a_ [href_ ("https://www.google.com/maps/?q=" <> t' <> "," <> o')]
"gmap"
htmlExamResult ::
Int
-> Int
-> Html ()
htmlExamResult x y =
do fromString (show x)
"/"
fromString (show y)
htmlExamName ::
String
-> Html ()
htmlExamName n =
h3_ [class_ "examname"] $
fromString n
htmlExam ::
Exam
-> Html ()
htmlExam (Exam n l t a r m) =
let r' = do span_ [class_ "examresult"] . fromString . show $ r
span_ [class_ "examresultoutof"] "/"
span_ [class_ "examresultmaximum"] . fromString . show $ m
" ("
span_ [class_ "examresultpercentage"] . fromString . printf "%.2f" $ (100 * fromIntegral r / fromIntegral m :: Double)
span_ [class_ "examresultpercentsign"] "%"
")"
in div_ [class_ "exam"] $
do htmlExamName n
ul_ [] $
do li_ [] $
do span_ [class_ "key"] "Time: "
span_ [class_ "value"] .
htmlTime $ t
li_ [] $
do span_ [class_ "key"] "Location: "
span_ [class_ "value"] .
htmlLocation $ l
li_ [] $
do span_ [class_ "key"] "Delegate: "
span_ [class_ "value"] .
htmlAviatorShort $ a
li_ [] $
do span_ [class_ "key"] "Result: "
span_ [class_ "value"] r'
htmlBriefingName ::
String
-> Html ()
htmlBriefingName n =
h3_ [class_ "briefingname"] $
fromString n
htmlBriefing ::
Briefing
-> Html ()
htmlBriefing (Briefing n l t a m) =
div_ [class_ "briefing"] $
do htmlBriefingName n
ul_ [] $
do li_ [] $
do span_ [class_ "key"] "Time: "
span_ [class_ "value"] .
htmlTime $ t
li_ [] $
do span_ [class_ "key"] "Location: "
span_ [class_ "value"] .
htmlLocation $ l
li_ [] $
do span_ [class_ "key"] "Amount: "
span_ [class_ "value"] .
htmlTimeAmountZero $ m
li_ [] $
do span_ [class_ "key"] "Briefer: "
span_ [class_ "value"] .
htmlAviatorShort $ a
space2dot ::
String
-> String
space2dot =
(<$>) $ \c -> case c of
' ' -> '.'
_ -> c
htmlEntryTag ::
Entry a b c d
-> Html ()
htmlEntryTag (AircraftFlightEntry e _) =
let lk = space2dot . concat $
[
"FLT_"
, e ^. aircraftflightname
, "_"
, e ^. flightaircraft . aircraftRegistration
, "_"
, e ^. flightpath . flightStart . point
, "-"
, e ^. flightpath . flightEnd . point
]
in do a_ [id_ (Text.pack lk)] ""
a_ [href_ (Text.pack ('#' : lk))] . span_ [class_ "entrytag"] $ "FLT"
htmlEntryTag (SimulatorFlightEntry e _) =
let lk = space2dot . concat $
[
"SIM_"
, e ^. simulatorflightname
, "_"
, e ^. simulatortype
]
in do a_ [id_ (Text.pack lk)] ""
a_ [href_ (Text.pack ('#' : lk))] . span_ [class_ "entrytag"] $ "SIM"
htmlEntryTag (ExamEntry e _) =
let lk = space2dot . concat $
[
"EXM_"
, e ^. examName
, "_"
, show (e ^. examTime . daytime)
]
in do a_ [id_ (Text.pack lk)] ""
a_ [href_ (Text.pack ('#' : lk))] . span_ [class_ "entrytag"] $ "EXM"
htmlEntryTag (BriefingEntry e _) =
let lk = space2dot . concat $
[
"BRF_"
, e ^. briefingName
, "_"
, show (e ^. briefingTime . daytime)
]
in do a_ [id_ (Text.pack lk)] ""
a_ [href_ (Text.pack ('#' : lk))] . span_ [class_ "entrytag"] $ "BRF"
htmlEntry ::
(AircraftFlight -> a -> Html x)
-> (SimulatorFlight -> b -> Html x)
-> (Exam -> c -> Html x)
-> (Briefing -> d -> Html x)
-> Entry a b c d
-> Html x
htmlEntry aircraftFlightMeta' simulatorFlightMeta' examMeta' briefingMeta' x =
do htmlEntryTag x
case x of
AircraftFlightEntry e ae ->
do div_ [] $
do htmlAircraftFlight e
aircraftFlightMeta' e ae
SimulatorFlightEntry e ae ->
do div_ [] $
do htmlSimulatorFlight e
simulatorFlightMeta' e ae
ExamEntry e ae ->
do div_ [] $
do htmlExam e
examMeta' e ae
BriefingEntry e ae ->
do div_ [] $
do htmlBriefing e
briefingMeta' e ae
htmlEntries ::
(AircraftFlight -> a -> Html x)
-> (SimulatorFlight -> b -> Html x)
-> (Exam -> c -> Html x)
-> (Briefing -> d -> Html x)
-> Entries a b c d
-> Html ()
htmlEntries aircraftFlightMeta' simulatorFlightMeta' examMeta' briefingMeta' (Entries es) =
mapM_ (\e -> hr_ [] *> htmlEntry aircraftFlightMeta' simulatorFlightMeta' examMeta' briefingMeta' e) es
htmlLogbook ::
(AircraftFlight -> a -> Html x)
-> (SimulatorFlight -> b -> Html x)
-> (Exam -> c -> Html x)
-> (Briefing -> d -> Html x)
-> Html ()
-> Logbook a b c d
-> Html ()
htmlLogbook aircraftFlightMeta' simulatorFlightMeta' examMeta' briefingMeta' reports' (Logbook a es) =
do htmlAviator a
hr_ []
reports'
htmlEntries aircraftFlightMeta' simulatorFlightMeta' examMeta' briefingMeta' es
htmlTitleAviator ::
Aviator
-> Html ()
htmlTitleAviator a =
fromString (concat
[
a ^. firstname
, " "
, a ^. surname
, " ("
, show =<< (a ^. arn)
, ")"
])
htmlLogbookDocument ::
(AircraftFlight -> a -> Html x)
-> (SimulatorFlight -> b -> Html x)
-> (Exam -> c -> Html x)
-> (Briefing -> d -> Html x)
-> Html ()
-> Logbook a b c d
-> Html ()
htmlLogbookDocument aircraftFlightMeta' simulatorFlightMeta' examMeta' briefingMeta' reports' b =
do doctype_
html_ [lang_ "en"] $
do head_ $
do title_ ("Pilot Personal Logbook " <> toHtmlRaw (" — " :: Text) <> htmlTitleAviator (b ^. logbookaviator))
link_ [href_ "https://fonts.googleapis.com/css?family=Inconsolata:400,700", rel_ "stylesheet", type_ "text/css"]
link_ [href_ "casr-logbook.css", rel_ "stylesheet", type_ "text/css"]
link_ [href_ "/atom.xml", rel_ "alternate", type_ "application/atom+xml", title_ "Atom feed"]
script_ [type_ "text/javascript", src_ "http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML"] ("" :: Text)
script_ [type_ "text/javascript", src_ "https://raw.github.com/Mathapedia/LaTeX2HTML5/master/latex2html5.min.js"] ("" :: Text)
body_ [class_ "casr-logbook"] $
do htmlLogbookHeader b
htmlLogbook aircraftFlightMeta' simulatorFlightMeta' examMeta' briefingMeta' reports' b
htmlLogbookHeader ::
Logbook a b c d
-> Html ()
htmlLogbookHeader _ =
do div_ [id_ "header", class_ "header"] $
h1_ "Pilot Personal Log Book"
div_ [id_ "subheader", class_ "subheader"] $
h2_ $
do "Civil Aviation Safety Regulation 1998 (61.345)"
" "
span_ [class_ "austlii"] $
a_ [href_ "http://www.austlii.edu.au/au/legis/cth/consol_reg/casr1998333/s61.345.html"] "austlii.edu.au"