diff --git a/casr-logbook.cabal b/casr-logbook.cabal --- a/casr-logbook.cabal +++ b/casr-logbook.cabal @@ -1,5 +1,5 @@ name: casr-logbook -version: 0.2.2 +version: 0.3.0 license: OtherLicense license-file: LICENSE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> @@ -32,19 +32,16 @@ Haskell2010 build-depends: - base < 5 && >= 4.8 - , casr-logbook-types >= 0.0.1 && < 0.1 - , casr-logbook-meta >= 0.0.4 && < 0.1 - , casr-logbook-html >= 0.0.2 && < 0.1 - , casr-logbook-meta-html >= 0.0.4 && < 0.1 - , casr-logbook-reports >= 0.0.2 && < 0.1 - , casr-logbook-reports-html >= 0.0.2 && < 0.1 - , casr-logbook-reports-meta >= 0.0.3 && < 0.1 - , casr-logbook-reports-meta-html >= 0.0.3 && < 0.1 + base >= 4.8 && < 5 + , containers >= 0.4 && < 0.6 , lucid >= 2.9 && < 3 - , digit < 3 && >= 0.2.8 - , time < 2 && >= 1.5 - + , digit >= 0.2.8 && < 3 + , time >= 1.5 && < 2 + , lucid >= 2.9 && < 3 + , lens >= 4.1 && < 5 + , digit >= 0.2.8 && < 3 + , time >= 1.5 && < 1.6 + , text >= 1.2 && < 1.3 ghc-options: -Wall @@ -56,7 +53,57 @@ exposed-modules: Data.Aviation.Casr.Logbook - + Data.Aviation.Casr.Logbook.Meta + Data.Aviation.Casr.Logbook.Meta.AircraftFlightExpense + Data.Aviation.Casr.Logbook.Meta.AircraftFlightMeta + Data.Aviation.Casr.Logbook.Meta.AircraftLandingExpense + Data.Aviation.Casr.Logbook.Meta.AircraftUsageExpense + Data.Aviation.Casr.Logbook.Meta.BriefingExpense + Data.Aviation.Casr.Logbook.Meta.BriefingMeta + Data.Aviation.Casr.Logbook.Meta.ExamExpense + Data.Aviation.Casr.Logbook.Meta.ExamMeta + Data.Aviation.Casr.Logbook.Meta.Image + Data.Aviation.Casr.Logbook.Meta.ImageType + Data.Aviation.Casr.Logbook.Meta.Passenger + Data.Aviation.Casr.Logbook.Meta.SimulatorFlightExpense + Data.Aviation.Casr.Logbook.Meta.SimulatorFlightMeta + Data.Aviation.Casr.Logbook.Meta.TrackLog + Data.Aviation.Casr.Logbook.Meta.TrackLogs + Data.Aviation.Casr.Logbook.Meta.TrackLogType + Data.Aviation.Casr.Logbook.Meta.Video + Data.Aviation.Casr.Logbook.Meta.VideoType + Data.Aviation.Casr.Logbook.Meta.Visualisation + Data.Aviation.Casr.Logbook.Reports + Data.Aviation.Casr.Logbook.Reports.FlightTimeReport + Data.Aviation.Casr.Logbook.Reports.SimulatorTimeReport + Data.Aviation.Casr.Logbook.Reports.TakeOffLanding90 + Data.Aviation.Casr.Logbook.Types + Data.Aviation.Casr.Logbook.Types.Rating + Data.Aviation.Casr.Logbook.Types.Aviator + Data.Aviation.Casr.Logbook.Types.Engine + Data.Aviation.Casr.Logbook.Types.Aircraft + Data.Aviation.Casr.Logbook.Types.TimeAmount + Data.Aviation.Casr.Logbook.Types.DayNight + Data.Aviation.Casr.Logbook.Types.Location + Data.Aviation.Casr.Logbook.Types.Command + Data.Aviation.Casr.Logbook.Types.Time + Data.Aviation.Casr.Logbook.Types.FlightPoint + Data.Aviation.Casr.Logbook.Types.FlightPath + Data.Aviation.Casr.Logbook.Types.AircraftFlight + Data.Aviation.Casr.Logbook.Types.SimulatorFlight + Data.Aviation.Casr.Logbook.Types.Exam + Data.Aviation.Casr.Logbook.Types.Briefing + Data.Aviation.Casr.Logbook.Types.Entry + Data.Aviation.Casr.Logbook.Types.Entries + Data.Aviation.Casr.Logbook.Types.Logbook + + Data.Aviation.Casr.Logbook.Html.Html + Data.Aviation.Casr.Logbook.Meta.Html + Data.Aviation.Casr.Logbook.Reports.Html + Data.Aviation.Casr.Logbook.Reports.Meta + Data.Aviation.Casr.Logbook.Reports.Meta.ExpenseReport + Data.Aviation.Casr.Logbook.Reports.Meta.Html + test-suite doctests type: exitcode-stdio-1.0 diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +0.3.0 + +* Move all packages into one. + 0.2.2 * Add `Lucid` module in export. diff --git a/src/Data/Aviation/Casr/Logbook/Html/Html.hs b/src/Data/Aviation/Casr/Logbook/Html/Html.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Html/Html.hs @@ -0,0 +1,691 @@ +{-# LANGUAGE OverloadedStrings #-} + +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" diff --git a/src/Data/Aviation/Casr/Logbook/Meta.hs b/src/Data/Aviation/Casr/Logbook/Meta.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta.hs @@ -0,0 +1,23 @@ +module Data.Aviation.Casr.Logbook.Meta ( + module A +) where + +import Data.Aviation.Casr.Logbook.Meta.AircraftFlightExpense as A +import Data.Aviation.Casr.Logbook.Meta.AircraftFlightMeta as A +import Data.Aviation.Casr.Logbook.Meta.AircraftLandingExpense as A +import Data.Aviation.Casr.Logbook.Meta.AircraftUsageExpense as A +import Data.Aviation.Casr.Logbook.Meta.BriefingExpense as A +import Data.Aviation.Casr.Logbook.Meta.BriefingMeta as A +import Data.Aviation.Casr.Logbook.Meta.ExamExpense as A +import Data.Aviation.Casr.Logbook.Meta.ExamMeta as A +import Data.Aviation.Casr.Logbook.Meta.Image as A +import Data.Aviation.Casr.Logbook.Meta.ImageType as A +import Data.Aviation.Casr.Logbook.Meta.Passenger as A +import Data.Aviation.Casr.Logbook.Meta.SimulatorFlightExpense as A +import Data.Aviation.Casr.Logbook.Meta.SimulatorFlightMeta as A +import Data.Aviation.Casr.Logbook.Meta.TrackLog as A +import Data.Aviation.Casr.Logbook.Meta.TrackLogs as A +import Data.Aviation.Casr.Logbook.Meta.TrackLogType as A +import Data.Aviation.Casr.Logbook.Meta.Video as A +import Data.Aviation.Casr.Logbook.Meta.VideoType as A +import Data.Aviation.Casr.Logbook.Meta.Visualisation as A diff --git a/src/Data/Aviation/Casr/Logbook/Meta/AircraftFlightExpense.hs b/src/Data/Aviation/Casr/Logbook/Meta/AircraftFlightExpense.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/AircraftFlightExpense.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.AircraftFlightExpense( + AircraftFlightExpense(ExpenseAircraftUsage, ExpenseAircraftLanding) +, AsAircraftFlightExpense(..) +) where + +import Control.Lens(makeClassyPrisms) +import Data.Aviation.Casr.Logbook.Meta.AircraftLandingExpense +import Data.Aviation.Casr.Logbook.Meta.AircraftUsageExpense +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +data AircraftFlightExpense = + ExpenseAircraftUsage AircraftUsageExpense + | ExpenseAircraftLanding AircraftLandingExpense + deriving (Eq, Ord, Show) + +makeClassyPrisms ''AircraftFlightExpense diff --git a/src/Data/Aviation/Casr/Logbook/Meta/AircraftFlightMeta.hs b/src/Data/Aviation/Casr/Logbook/Meta/AircraftFlightMeta.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/AircraftFlightMeta.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.AircraftFlightMeta( + AircraftFlightMeta(AircraftFlightMeta) +, HasAircraftFlightMeta(..) +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Meta.AircraftFlightExpense +import Data.Aviation.Casr.Logbook.Meta.Image +import Data.Aviation.Casr.Logbook.Meta.Passenger +import Data.Aviation.Casr.Logbook.Meta.TrackLog +import Data.Aviation.Casr.Logbook.Meta.Video +import Data.Aviation.Casr.Logbook.Meta.Visualisation +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +data AircraftFlightMeta = + AircraftFlightMeta { + _tracklogs :: [TrackLog] + , _visualisations :: [Visualisation] + , _images :: [Image] + , _videos :: [Video] + , _expenses :: [AircraftFlightExpense] + , _pax :: [Passenger] + } deriving (Eq, Ord, Show) + +makeClassy '' AircraftFlightMeta diff --git a/src/Data/Aviation/Casr/Logbook/Meta/AircraftLandingExpense.hs b/src/Data/Aviation/Casr/Logbook/Meta/AircraftLandingExpense.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/AircraftLandingExpense.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.AircraftLandingExpense( + AircraftLandingExpense(AircraftLandingExpense) +, HasAircraftLandingExpense(..) +) where + +import Control.Lens(makeClassy) +import Data.Eq(Eq) +import Data.Int(Int) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data AircraftLandingExpense = + AircraftLandingExpense { + _aircraftlandingexpenseamount :: Int + , _aircraftlandingexpensename :: String + } deriving (Eq, Ord, Show) + +makeClassy ''AircraftLandingExpense diff --git a/src/Data/Aviation/Casr/Logbook/Meta/AircraftUsageExpense.hs b/src/Data/Aviation/Casr/Logbook/Meta/AircraftUsageExpense.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/AircraftUsageExpense.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.AircraftUsageExpense( + AircraftUsageExpense(AircraftUsageExpense) +, HasAircraftUsageExpense(..) +, aircraftUsageCost +) where + +import Control.Lens(makeClassy, (^.)) +import Data.Aviation.Casr.Logbook.Types.AircraftFlight(HasAircraftFlight, daynight) +import Data.Aviation.Casr.Logbook.Types.TimeAmount(timeAmountBy10) +import Data.Aviation.Casr.Logbook.Types.DayNight(totalDayNight) +import Data.Eq(Eq) +import Data.Int(Int) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show, (*)) + +data AircraftUsageExpense = + AircraftUsageExpense { + _aircraftusageexpenseperhour :: Int + , _aircraftusageexpensename :: String + } deriving (Eq, Ord, Show) + +makeClassy ''AircraftUsageExpense + +aircraftUsageCost :: + HasAircraftFlight s => + s + -> AircraftUsageExpense + -> Int +aircraftUsageCost fl (AircraftUsageExpense perhour _) = + let z = totalDayNight (fl ^. daynight) + in timeAmountBy10 z * perhour diff --git a/src/Data/Aviation/Casr/Logbook/Meta/BriefingExpense.hs b/src/Data/Aviation/Casr/Logbook/Meta/BriefingExpense.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/BriefingExpense.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.BriefingExpense( + BriefingExpense(BriefingExpense) +, HasBriefingExpense(..) +, briefingCost +) where + +import Control.Lens(makeClassy, (^.)) +import Data.Aviation.Casr.Logbook.Types.Briefing(HasBriefing, briefingTimeAmount) +import Data.Aviation.Casr.Logbook.Types.TimeAmount(timeAmountBy10) +import Data.Eq(Eq) +import Data.Int(Int) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show, (*)) + +data BriefingExpense = + BriefingExpense { + _briefingexpenseperhour :: Int + , _briefingexpensename :: String + } deriving (Eq, Ord, Show) + +makeClassy ''BriefingExpense + +briefingCost :: + HasBriefing s => + s + -> BriefingExpense + -> Int +briefingCost br (BriefingExpense perhour _) = + let z = br ^. briefingTimeAmount + in timeAmountBy10 z * perhour diff --git a/src/Data/Aviation/Casr/Logbook/Meta/BriefingMeta.hs b/src/Data/Aviation/Casr/Logbook/Meta/BriefingMeta.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/BriefingMeta.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +module Data.Aviation.Casr.Logbook.Meta.BriefingMeta( + BriefingMeta(BriefingMeta) +, HasBriefingMeta(..) +) where + +import Control.Lens(makeClassy, makeWrapped) +import Data.Aviation.Casr.Logbook.Meta.BriefingExpense +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +newtype BriefingMeta = + BriefingMeta + [BriefingExpense] + deriving (Eq, Ord, Show) + +makeClassy ''BriefingMeta +makeWrapped ''BriefingMeta diff --git a/src/Data/Aviation/Casr/Logbook/Meta/ExamExpense.hs b/src/Data/Aviation/Casr/Logbook/Meta/ExamExpense.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/ExamExpense.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.ExamExpense( + ExamExpense(ExamExpense) +, HasExamExpense(..) +) where + +import Control.Lens(makeClassy) +import Data.Eq(Eq) +import Data.Int(Int) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data ExamExpense = + ExamExpense { + _examexpenseamount :: Int + , _examexpensename :: String + } deriving (Eq, Ord, Show) + +makeClassy ''ExamExpense diff --git a/src/Data/Aviation/Casr/Logbook/Meta/ExamMeta.hs b/src/Data/Aviation/Casr/Logbook/Meta/ExamMeta.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/ExamMeta.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +module Data.Aviation.Casr.Logbook.Meta.ExamMeta( + ExamMeta(ExamMeta) +, HasExamMeta(..) +) where + +import Control.Lens(makeClassy, makeWrapped) +import Data.Aviation.Casr.Logbook.Meta.ExamExpense +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +newtype ExamMeta = + ExamMeta + [ExamExpense] + deriving (Eq, Ord, Show) + +makeClassy ''ExamMeta +makeWrapped ''ExamMeta diff --git a/src/Data/Aviation/Casr/Logbook/Meta/Html.hs b/src/Data/Aviation/Casr/Logbook/Meta/Html.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/Html.hs @@ -0,0 +1,469 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Aviation.Casr.Logbook.Meta.Html( + htmlAircraftUsageExpense + , htmlAircraftLandingExpense + , htmlAircraftFlightExpense + , htmlSimulatorFlightExpense + , htmlExamExpense + , htmlBriefingExpense + , htmlVisualisation + , strImageType + , htmlImageSource + , htmlImage + , strTrackLogType + , htmlTrackLogSource + , htmlTrackLog + , strVideoType + , htmlVideoSource + , htmlVideo + , htmlTrackLogs + , htmlVisualisations + , htmlImages + , htmlVideos + , htmlAircraftFlightExpenses + , htmlAircraftFlightMeta + , htmlSimulatorFlightMeta + , htmlExamMeta + , htmlBriefingMeta + , htmlLogbookDocumentMeta + , showCentsAsDollars + , showThousandCentsAsDollars + , showHundredCentsAsDollars + , whenEmpty +) where + +import Control.Category((.), id) +import Control.Monad(when) +import Data.Aviation.Casr.Logbook.Types( + AircraftFlight + , SimulatorFlight + , Briefing + , Exam + , Logbook + ) +import Data.Aviation.Casr.Logbook.Html.Html(htmlLogbookDocument) +import Data.Aviation.Casr.Logbook.Meta( + AircraftFlightExpense(ExpenseAircraftUsage, ExpenseAircraftLanding) + , AircraftFlightMeta(AircraftFlightMeta) + , AircraftLandingExpense(AircraftLandingExpense) + , AircraftUsageExpense(AircraftUsageExpense) + , BriefingExpense(BriefingExpense) + , BriefingMeta(BriefingMeta) + , ExamExpense(ExamExpense) + , ExamMeta(ExamMeta) + , Image(Image) + , ImageType(Jpg, Png, Gif) + , Passenger(Passenger) + , SimulatorFlightExpense(SimulatorFlightExpense) + , SimulatorFlightMeta(SimulatorFlightMeta) + , TrackLog(TrackLog) + , TrackLogType(Gpx, Kml, Kmz, ImageTrackLog) + , Video(Video) + , VideoType(YouTube, Vimeo, Bambuser) + , Visualisation(Doarama) + , linkVideoType + , aircraftUsageCost + , simulatorFlightCost + , briefingCost + ) +import Data.Bool(not) +import Data.Foldable(mapM_, null) +import Data.Function(($)) +import Data.Int(Int) +import Data.List(reverse) +import Data.Maybe(Maybe, maybe, fromMaybe) +import Data.Monoid(Monoid, (<>), mempty) +import Data.Ord((<)) +import Data.String(String, fromString) +import qualified Data.Text as Text(pack) +import Lucid( + class_ + , span_ + , a_ + , div_ + , href_ + , src_ + , ul_ + , li_ + , width_ + , img_ + , alt_ + , br_ + , style_ + , Html + ) +import Prelude(show, (*), abs) + +htmlAircraftUsageExpense :: + AircraftFlight + -> AircraftUsageExpense + -> Html () +htmlAircraftUsageExpense fl e@(AircraftUsageExpense perhour name) = + span_ [class_ "aircraftusageexpense"] $ + do span_ [class_ "aircraftusageexpensecost"] . fromString . ('$':) . showThousandCentsAsDollars $ aircraftUsageCost fl e + span_ [class_ "aircraftusageexpensephrase"] " at " + span_ [class_ "aircraftusageexpenseperhour"] . fromString . ('$':) . showCentsAsDollars $ perhour + span_ [class_ "aircraftusageexpensephrase"] " per hour" + when (not . null $ name) . span_ [class_ "aircraftusageexpensename"] $ + do " (" + fromString name + ")" + +htmlAircraftLandingExpense :: + AircraftFlight + -> AircraftLandingExpense + -> Html () +htmlAircraftLandingExpense _ (AircraftLandingExpense amount name) = + span_ [class_ "aircraftlandingexpense"] $ + do span_ [class_ "aircraftlandingexpensecost"] . fromString . ('$':) . showThousandCentsAsDollars $ (amount * 10) + when (not . null $ name) . span_ [class_ "aircraftlandingexpensename"] $ + do " (" + fromString name + ")" + +htmlAircraftFlightExpense :: + AircraftFlight + -> AircraftFlightExpense + -> Html () +htmlAircraftFlightExpense fl (ExpenseAircraftUsage e) = + htmlAircraftUsageExpense fl e +htmlAircraftFlightExpense fl (ExpenseAircraftLanding e) = + htmlAircraftLandingExpense fl e + +htmlSimulatorFlightExpense :: + SimulatorFlight + -> SimulatorFlightExpense + -> Html () +htmlSimulatorFlightExpense sf e@(SimulatorFlightExpense perhour name) = + span_ [class_ "simulatorflightexpense"] $ + do span_ [class_ "simulatorflightcost"] . fromString . ('$':) . showThousandCentsAsDollars $ simulatorFlightCost sf e + span_ [class_ "simulatorflightexpensephrase"] " at " + span_ [class_ "simulatorflightexpenseperhour"] . fromString . ('$':) . showCentsAsDollars $ perhour + span_ [class_ "simulatorflightexpensephrase"] " per hour" + when (not . null $ name) . span_ [class_ "simulatorflightexpensename"] $ + do " (" + fromString name + ")" + +htmlExamExpense :: + Exam + -> ExamExpense + -> Html () +htmlExamExpense _ (ExamExpense amount name) = + span_ [class_ "examexpense"] $ + do span_ [class_ "examexpensecost"] . fromString . ('$':) . showThousandCentsAsDollars $ (amount * 10) + when (not . null $ name) . span_ [class_ "examexpensename"] $ + do " (" + fromString name + ")" + +htmlBriefingExpense :: + Briefing + -> BriefingExpense + -> Html () +htmlBriefingExpense br e@(BriefingExpense perhour name) = + span_ [class_ "briefingexpense"] $ + do span_ [class_ "briefingexpensecost"] . fromString . ('$':) . showThousandCentsAsDollars $ briefingCost br e + span_ [class_ "briefingexpensephrase"] " at " + span_ [class_ "briefingexpenseperhour"] . fromString . ('$':) . showCentsAsDollars $ perhour + span_ [class_ "briefingexpensephrase"] " per hour" + when (not . null $ name) . span_ [class_ "briefingexpensename"] $ + do " (" + fromString name + ")" + +htmlVisualisation :: + AircraftFlight + -> Visualisation + -> Html () +htmlVisualisation _ (Doarama i _ n) = + let n' = fromMaybe "doarama.com" n + in do a_ [href_ ("http://doarama.com/view/" <> Text.pack i)] $ + span_ [class_ "Visualisation_name"] (fromString n') + -- p_ (iframe_ [src_ ("http://www.doarama.com/embed?k=" <> Text.pack e), width_ "560", height_ "315", termWith -- "allowfullscreen" [] "allowfullscreen"] "") + +strImageType :: + ImageType + -> String +strImageType Jpg = + "jpg" +strImageType Png = + "png" +strImageType Gif = + "gif" + +htmlImageSource :: + AircraftFlight + -> Maybe String + -> Html () +htmlImageSource _ = + maybe mempty (\s' -> span_ [] (fromString ("Image source: " <> s'))) + +htmlImage :: + AircraftFlight + -> Image + -> Html () +htmlImage fl (Image u t s n) = + let u' = fromString u + n' = fromMaybe ("Image (" <> strImageType t <> ")") n + in do a_ [href_ u'] $ + img_ [src_ u', width_ "120", alt_ (Text.pack n')] + htmlImageSource fl s + +strTrackLogType :: + TrackLogType + -> String +strTrackLogType Gpx = + "gpx" +strTrackLogType Kml = + "kml" +strTrackLogType Kmz = + "kmz" +strTrackLogType (ImageTrackLog i) = + strImageType i + +htmlTrackLogSource :: + AircraftFlight + -> Maybe String + -> Html () +htmlTrackLogSource _ = + maybe "" (\q -> span_ [] (fromString (" from " <> q))) + +htmlTrackLog :: + AircraftFlight + -> TrackLog + -> Html () +htmlTrackLog fl (TrackLog u t s n) = + let u' = fromString u + n' = fromMaybe (strTrackLogType t) n + o = do fromString n' + htmlTrackLogSource fl s + in do a_ [href_ u'] o + case t of + ImageTrackLog _ -> + do br_ [] + a_ [href_ u'] $ + img_ [src_ u', width_ "360", alt_ (fromString n')] + _ -> + mempty + +strVideoType :: + VideoType + -> String +strVideoType YouTube = + "youtube" +strVideoType Vimeo = + "vimeo" +strVideoType Bambuser = + "bambuser" + +htmlVideoSource :: + AircraftFlight + -> Maybe String + -> Html () +htmlVideoSource _ s = + maybe mempty (\q -> span_ [] (fromString (" from " <> q))) s + +htmlVideo :: + AircraftFlight + -> Video + -> Html () +htmlVideo fl (Video u t s n) = + let n' = fromMaybe ("Video (" <> strVideoType t <> ")") n + in do a_ [href_ (fromString (linkVideoType t u))] (fromString n') + htmlVideoSource fl s + +htmlTrackLogs :: + AircraftFlight + -> [TrackLog] + -> Html () +htmlTrackLogs fl x = + whenEmpty (\q -> div_ [class_ "tracklogs"] $ + do span_ [class_ "tracklogsheader"] "Track Logs" + ul_ [] $ + mapM_ (li_ [class_ "tracklog"] . htmlTrackLog fl) q) x + +htmlVisualisations :: + AircraftFlight + -> [Visualisation] + -> Html () +htmlVisualisations fl x = + whenEmpty (\q -> div_ [class_ "visualisations"] $ + do span_ [class_ "visualisationsheader"] "Visualisations" + ul_ [] $ + mapM_ (li_ [class_ "visualisation"] . htmlVisualisation fl) q) x + +htmlImages :: + AircraftFlight + -> [Image] + -> Html () +htmlImages fl x = + whenEmpty (\q -> div_ [class_ "tracklogs"] $ + do span_ [class_ "imagesheader"] "Images" + div_ [style_ "text-align: justify"] $ + mapM_ (htmlImage fl) q) x + +htmlVideos :: + AircraftFlight + -> [Video] + -> Html () +htmlVideos fl x = + whenEmpty (\q -> div_ [class_ "videos"] $ + do span_ [class_ "videosheader"] "Videos" + ul_ [] $ + mapM_ (li_ [class_ "video"] . htmlVideo fl) q) x + +htmlAircraftFlightExpenses :: + AircraftFlight + -> [AircraftFlightExpense] + -> Html () +htmlAircraftFlightExpenses fl x = + whenEmpty (\q -> div_ [class_ "aircraftflightexpenses"] $ + do span_ [class_ "aircraftflightexpensesheader"] "Aircraft Flight Expenses" + ul_ [] $ + mapM_ (li_ [class_ "aircraftflightexpense"] . htmlAircraftFlightExpense fl) q) x + +htmlAircraftFlightPassenger :: + AircraftFlight + -> Passenger + -> Html () +htmlAircraftFlightPassenger _ (Passenger p) = + do span_ [class_ "aircraftflightpassenger"] (fromString p) + +htmlAircraftFlightPax :: + AircraftFlight + -> [Passenger] + -> Html () +htmlAircraftFlightPax fl x = + whenEmpty (\q -> div_ [class_ "aircraftflightpax"] $ + do span_ [class_ "aircraftflightpaxheader"] "PAX" + ul_ [] $ + mapM_ (li_ [class_ "aircraftflightpassenger"] . htmlAircraftFlightPassenger fl) q) x + +htmlAircraftFlightMeta :: + AircraftFlight + -> AircraftFlightMeta + -> Html () +htmlAircraftFlightMeta fl (AircraftFlightMeta tls vls ims vds exs pax) = + div_ $ + do htmlTrackLogs fl tls + htmlVisualisations fl vls + htmlImages fl ims + htmlVideos fl vds + htmlAircraftFlightExpenses fl exs + htmlAircraftFlightPax fl pax + +htmlSimulatorFlightMeta :: + SimulatorFlight + -> SimulatorFlightMeta + -> Html () +htmlSimulatorFlightMeta fl (SimulatorFlightMeta s) = + whenEmpty (\q -> div_ [class_ "simulatormeta"] $ + do span_ [class_ "simulatorheader"] "Expenses" + ul_ [] $ + mapM_ (li_ [class_ "expense"] . htmlSimulatorFlightExpense fl) q) s + +htmlExamMeta :: + Exam + -> ExamMeta + -> Html () +htmlExamMeta e (ExamMeta s) = + whenEmpty (\q -> div_ [class_ "exammeta"] $ + do span_ [class_ "exammetaheader"] "Expenses" + ul_ [] $ + mapM_ (li_ [class_ "expense"] . htmlExamExpense e) q) s + +htmlBriefingMeta :: + Briefing + -> BriefingMeta + -> Html () +htmlBriefingMeta b (BriefingMeta s) = + whenEmpty (\q -> div_ [class_ "briefingmeta"] $ + do span_ [class_ "briefingmetaheader"] "Expenses" + ul_ [] $ + mapM_ (li_ [class_ "expense"] . htmlBriefingExpense b) q) s + +htmlLogbookDocumentMeta :: + Html () + -> Logbook AircraftFlightMeta SimulatorFlightMeta ExamMeta BriefingMeta + -> Html () +htmlLogbookDocumentMeta = + htmlLogbookDocument htmlAircraftFlightMeta htmlSimulatorFlightMeta htmlExamMeta htmlBriefingMeta + +---- + +showCentsAsDollars :: + Int + -> String +showCentsAsDollars n = + let pos :: + String + -> String + pos [] = + [] + pos [x] = + "0.0" <> [x] + pos [x, y] = + "0." <> [y, x] + pos (x:y:z) = + reverse z <> "." <> [y, x] + in (if n < 0 then ('-':) else id) . pos . reverse . show . abs $ n + +showThousandCentsAsDollars :: + Int + -> String +showThousandCentsAsDollars n = + let pos :: + String + -> String + pos [] = + [] + pos [x] = + [x] <> "0.0" + pos [x, y] = + [x, y] <> ".0" + pos [x, y, z] = + [x, y, z] <> ".0" + pos (x:y:z:r) = + [x, y, z] <> "." <> r + drop0 [] = + [] + drop0 ('0':r) = + r + drop0 w = + w + in (if n < 0 then ('-':) else id) . reverse . drop0 . pos . reverse . show . abs $ n + +showHundredCentsAsDollars :: + Int + -> String +showHundredCentsAsDollars n = + let pos :: + String + -> String + pos [] = + [] + pos [x] = + [x] <> "0.0" + pos [x, y] = + [x, y] <> ".0" + pos (x:y:r) = + [x, y] <> "." <> r + drop0 [] = + [] + drop0 ('0':r) = + r + drop0 w = + w + in (if n < 0 then ('-':) else id) . reverse . drop0 . pos . reverse . show . abs $ n + +whenEmpty :: + Monoid a => + ([t] -> a) + -> [t] + -> a +whenEmpty _ [] = + mempty +whenEmpty f x = + f x diff --git a/src/Data/Aviation/Casr/Logbook/Meta/Image.hs b/src/Data/Aviation/Casr/Logbook/Meta/Image.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/Image.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.Image( + Image(Image) +, HasImage(..) +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Meta.ImageType +import Data.Eq(Eq) +import Data.Maybe(Maybe) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data Image = + Image { + _imageuri :: String + , _imagetype :: ImageType + , _imagesource :: Maybe String + , _imagename :: Maybe String + } deriving (Eq, Ord, Show) + +makeClassy ''Image diff --git a/src/Data/Aviation/Casr/Logbook/Meta/ImageType.hs b/src/Data/Aviation/Casr/Logbook/Meta/ImageType.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/ImageType.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.ImageType( + ImageType(Jpg, Png, Gif) +, AsImageType(..) +) where + +import Control.Lens(makeClassyPrisms) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +data ImageType = + Jpg + | Png + | Gif + deriving (Eq, Ord, Show) + +makeClassyPrisms ''ImageType diff --git a/src/Data/Aviation/Casr/Logbook/Meta/Passenger.hs b/src/Data/Aviation/Casr/Logbook/Meta/Passenger.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/Passenger.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} + +module Data.Aviation.Casr.Logbook.Meta.Passenger( + Passenger(Passenger) +, HasPassenger(..) +) where + +import Control.Lens(makeWrapped, makeClassy) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +newtype Passenger = + Passenger + String + deriving (Eq, Ord, Show) + +makeWrapped '' Passenger +makeClassy '' Passenger diff --git a/src/Data/Aviation/Casr/Logbook/Meta/SimulatorFlightExpense.hs b/src/Data/Aviation/Casr/Logbook/Meta/SimulatorFlightExpense.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/SimulatorFlightExpense.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.SimulatorFlightExpense( + SimulatorFlightExpense(SimulatorFlightExpense) +, HasSimulatorFlightExpense(..) +, simulatorFlightCost +) where + +import Control.Lens(makeClassy, (^.)) +import Data.Aviation.Casr.Logbook.Types.SimulatorFlight(HasSimulatorFlight, instrumentsimulatorTime) +import Data.Aviation.Casr.Logbook.Types.TimeAmount(timeAmountBy10) +import Data.Eq(Eq) +import Data.Int(Int) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show, (*)) + +data SimulatorFlightExpense = + SimulatorFlightExpense { + _simulatorflightexpenseperhour :: Int + , _simulatorflightexpensename :: String + } deriving (Eq, Ord, Show) + +makeClassy ''SimulatorFlightExpense + +simulatorFlightCost :: + HasSimulatorFlight s => + s + -> SimulatorFlightExpense + -> Int +simulatorFlightCost sf (SimulatorFlightExpense perhour _) = + let z = sf ^. instrumentsimulatorTime + in timeAmountBy10 z * perhour diff --git a/src/Data/Aviation/Casr/Logbook/Meta/SimulatorFlightMeta.hs b/src/Data/Aviation/Casr/Logbook/Meta/SimulatorFlightMeta.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/SimulatorFlightMeta.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +module Data.Aviation.Casr.Logbook.Meta.SimulatorFlightMeta( + SimulatorFlightMeta(SimulatorFlightMeta) +, HasSimulatorFlightMeta(..) +) where + +import Control.Lens(makeClassy, makeWrapped) +import Data.Aviation.Casr.Logbook.Meta.SimulatorFlightExpense +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +newtype SimulatorFlightMeta = + SimulatorFlightMeta + [SimulatorFlightExpense] + deriving (Eq, Ord, Show) + +makeClassy ''SimulatorFlightMeta +makeWrapped ''SimulatorFlightMeta diff --git a/src/Data/Aviation/Casr/Logbook/Meta/TrackLog.hs b/src/Data/Aviation/Casr/Logbook/Meta/TrackLog.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/TrackLog.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.TrackLog( + TrackLog(TrackLog) +, HasTrackLog(..) +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Meta.TrackLogType +import Data.Eq(Eq) +import Data.Maybe(Maybe) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data TrackLog = + TrackLog { + _trackloguri :: String + , _tracklogtype :: TrackLogType + , _tracklogsource :: Maybe String + , _tracklogname :: Maybe String + } deriving (Eq, Ord, Show) + +makeClassy ''TrackLog diff --git a/src/Data/Aviation/Casr/Logbook/Meta/TrackLogType.hs b/src/Data/Aviation/Casr/Logbook/Meta/TrackLogType.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/TrackLogType.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.TrackLogType( + TrackLogType(Gpx, Kml, Kmz, ImageTrackLog) +, AsTrackLogType(..) +) where + +import Control.Lens(makeClassyPrisms) +import Data.Aviation.Casr.Logbook.Meta.ImageType +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +data TrackLogType = + Gpx + | Kml + | Kmz + | ImageTrackLog ImageType + deriving (Eq, Ord, Show) + +makeClassyPrisms ''TrackLogType diff --git a/src/Data/Aviation/Casr/Logbook/Meta/TrackLogs.hs b/src/Data/Aviation/Casr/Logbook/Meta/TrackLogs.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/TrackLogs.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +module Data.Aviation.Casr.Logbook.Meta.TrackLogs( + TrackLogs(TrackLogs) +, HasTrackLogs(..) +) where + +import Control.Lens(makeClassy, makeWrapped) +import Data.Aviation.Casr.Logbook.Meta.TrackLog +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +newtype TrackLogs = + TrackLogs + [TrackLog] + deriving (Eq, Ord, Show) + +makeClassy ''TrackLogs +makeWrapped ''TrackLogs diff --git a/src/Data/Aviation/Casr/Logbook/Meta/Video.hs b/src/Data/Aviation/Casr/Logbook/Meta/Video.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/Video.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.Video( + Video(Video) +, HasVideo(..) +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Meta.VideoType +import Data.Eq(Eq) +import Data.Maybe(Maybe) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data Video = + Video { + _videouri :: String + , _videotype :: VideoType + , _videosource :: Maybe String + , _videoname :: Maybe String + } deriving (Eq, Ord, Show) + +makeClassy ''Video diff --git a/src/Data/Aviation/Casr/Logbook/Meta/VideoType.hs b/src/Data/Aviation/Casr/Logbook/Meta/VideoType.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/VideoType.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.VideoType( + VideoType(YouTube, Vimeo, Bambuser) +, AsVideoType(..) +, linkVideoType +, iframeVideoType +) where + +import Control.Lens(makeClassyPrisms) +import Data.Eq(Eq) +import Data.List((++)) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data VideoType = + YouTube + | Vimeo + | Bambuser + deriving (Eq, Ord, Show) + +makeClassyPrisms ''VideoType + +linkVideoType :: + VideoType + -> String + -> String +linkVideoType YouTube u = + "https://www.youtube.com/watch?v=" ++ u +linkVideoType Vimeo u = + "https://bambuser.com/v/" ++ u +linkVideoType Bambuser u = + "https://vimeo.com/" ++ u + +iframeVideoType :: + VideoType + -> String + -> String +iframeVideoType YouTube u = + "http://www.youtube.com/embed/" ++ u ++ "?autohide=1&cc_load_policy=1&color=white&controls=1&disablekb=0&fs=1&iv_load_policy=0&loop=0&modestbranding=1&rel=0&showinfo=0" +iframeVideoType Vimeo u = + "https://player.vimeo.com/video/" ++ u +iframeVideoType Bambuser u = + "https://embed.bambuser.com/broadcast/" ++ u ++ "?chat=1&mute=0" diff --git a/src/Data/Aviation/Casr/Logbook/Meta/Visualisation.hs b/src/Data/Aviation/Casr/Logbook/Meta/Visualisation.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Meta/Visualisation.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Meta.Visualisation( + Visualisation(Doarama) +, HasVisualisation(..) +) where + +import Control.Lens(makeClassy) +import Data.Eq(Eq) +import Data.Maybe(Maybe) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data Visualisation = + Doarama { + _doaramaid :: String + , _oembedid :: String + , _doaramaname :: Maybe String + } deriving (Eq, Ord, Show) + +makeClassy ''Visualisation diff --git a/src/Data/Aviation/Casr/Logbook/Reports.hs b/src/Data/Aviation/Casr/Logbook/Reports.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Reports.hs @@ -0,0 +1,7 @@ +module Data.Aviation.Casr.Logbook.Reports( + module R +) where + +import Data.Aviation.Casr.Logbook.Reports.FlightTimeReport as R +import Data.Aviation.Casr.Logbook.Reports.SimulatorTimeReport as R +import Data.Aviation.Casr.Logbook.Reports.TakeOffLanding90 as R diff --git a/src/Data/Aviation/Casr/Logbook/Reports/FlightTimeReport.hs b/src/Data/Aviation/Casr/Logbook/Reports/FlightTimeReport.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Reports/FlightTimeReport.hs @@ -0,0 +1,242 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Reports.FlightTimeReport( + FlightTimeReport(..) +, HasFlightTimeReport(..) +, singleFlightTimeReport +, getFlightTimeReport +) where + +import Control.Category((.)) +import Control.Lens(makeClassy, (^.)) +import Data.Aviation.Casr.Logbook.Types + ( + TimeAmount + , Aviator + , Logbook(Logbook) + , Command(ICUS, Dual, InCommand) + , Engine(Single, Multi) + , Entry(AircraftFlightEntry) + , Entries(Entries) + , aircraftEngine + , aircraftRegistration + , aircraftType + , instrumentflightTime + , getInstructingPic + , flightaircraft + , command + , daynight + , dayDayNight + , nightDayNight + , totalDayNight + ) +import Data.Eq(Eq) +import Data.Foldable(foldl') +import Data.Int(Int) +import qualified Data.Map as Map(unionWith, singleton, empty) +import Data.Map(Map) +import Data.Maybe(Maybe(Just, Nothing)) +import Data.Monoid(Monoid(mappend, mempty)) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show, (+)) + +data FlightTimeReport = + FlightTimeReport { + _flightsTotal :: + Int + , _hoursTotal :: + TimeAmount + , _hoursTotalICUS :: + TimeAmount + , _hoursTotalDual :: + TimeAmount + , _hoursTotalInCommand :: + TimeAmount + , _hoursInAircraftType :: + Map String (TimeAmount, TimeAmount, TimeAmount, TimeAmount) + , _hoursInAircraftRegistration :: + Map String (TimeAmount, TimeAmount, TimeAmount, TimeAmount) + , _hoursSingleEngine :: + TimeAmount + , _hoursSingleEngineICUS :: + TimeAmount + , _hoursSingleEngineDual :: + TimeAmount + , _hoursSingleEngineInCommand :: + TimeAmount + , _hoursMultiEngine :: + TimeAmount + , _hoursMultiEngineICUS :: + TimeAmount + , _hoursMultiEngineDual :: + TimeAmount + , _hoursMultiEngineInCommand :: + TimeAmount + , _hoursDay :: + TimeAmount + , _hoursDayICUS :: + TimeAmount + , _hoursDayDual :: + TimeAmount + , _hoursDayInCommand :: + TimeAmount + , _hoursNight :: + TimeAmount + , _hoursNightICUS :: + TimeAmount + , _hoursNightDual :: + TimeAmount + , _hoursNightInCommand :: + TimeAmount + , _hoursWithPiC :: + Map Aviator TimeAmount + , _hoursInstrument :: + TimeAmount + } deriving (Eq, Ord, Show) + +makeClassy ''FlightTimeReport + +instance Monoid FlightTimeReport where + mempty = + FlightTimeReport + 0 + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + mempty + FlightTimeReport ft1 tl1 tli1 tld1 tlc1 tp1 rg1 se1 sei1 sed1 sec1 me1 mei1 med1 mec1 dy1 dyi1 dyd1 dyc1 nt1 nti1 ntd1 ntc1 wpc1 is1 `mappend` FlightTimeReport ft2 tl2 tli2 tld2 tlc2 tp2 rg2 se2 sei2 sed2 sec2 me2 mei2 med2 mec2 dy2 dyi2 dyd2 dyc2 nt2 nti2 ntd2 ntc2 wpc2 is2 = + FlightTimeReport + (ft1 + ft2) + (tl1 `mappend` tl2) + (tli1 `mappend` tli2) + (tld1 `mappend` tld2) + (tlc1 `mappend` tlc2) + (Map.unionWith mappend tp1 tp2) + (Map.unionWith mappend rg1 rg2) + (se1 `mappend` se2) + (sei1 `mappend` sei2) + (sed1 `mappend` sed2) + (sec1 `mappend` sec2) + (me1 `mappend` me2) + (mei1 `mappend` mei2) + (med1 `mappend` med2) + (mec1 `mappend` mec2) + (dy1 `mappend` dy2) + (dyi1 `mappend` dyi2) + (dyd1 `mappend` dyd2) + (dyc1 `mappend` dyc2) + (nt1 `mappend` nt2) + (nti1 `mappend` nti2) + (ntd1 `mappend` ntd2) + (ntc1 `mappend` ntc2) + (Map.unionWith mappend wpc1 wpc2) + (is1 `mappend` is2) + +singleFlightTimeReport :: + Entry a b c d + -> FlightTimeReport +singleFlightTimeReport (AircraftFlightEntry fl _) = + let hoursdaynight = totalDayNight (fl ^. daynight) + icus x = + case fl ^. command of + ICUS _ -> + x + Dual _ -> + mempty + InCommand -> + mempty + dual x = + case fl ^. command of + ICUS _ -> + mempty + Dual _ -> + x + InCommand -> + mempty + comd x = + case fl ^. command of + ICUS _ -> + mempty + Dual _ -> + mempty + InCommand -> + x + hoursmap k = + Map.singleton k (hoursdaynight, (icus hoursdaynight), (dual hoursdaynight), (comd hoursdaynight)) + singleengine x = + case fl ^. flightaircraft . aircraftEngine of + Single -> + x + Multi -> + mempty + multiengine x = + case fl ^. flightaircraft . aircraftEngine of + Single -> + mempty + Multi -> + x + totalhoursday = + fl ^. daynight . dayDayNight + totalhoursnight = + fl ^. daynight . nightDayNight + pic x = + case getInstructingPic (fl ^. command) of + Just a -> + Map.singleton a x + Nothing -> + Map.empty + in FlightTimeReport + 1 + hoursdaynight + (icus hoursdaynight) + (dual hoursdaynight) + (comd hoursdaynight) + (hoursmap (fl ^. flightaircraft . aircraftType)) + (hoursmap (fl ^. flightaircraft . aircraftRegistration)) + (singleengine hoursdaynight) + (singleengine (icus hoursdaynight)) + (singleengine (dual hoursdaynight)) + (singleengine (comd hoursdaynight)) + (multiengine hoursdaynight) + (multiengine (icus hoursdaynight)) + (multiengine (dual hoursdaynight)) + (multiengine (comd hoursdaynight)) + totalhoursday + (icus totalhoursday) + (dual totalhoursday) + (comd totalhoursday) + totalhoursnight + (icus totalhoursnight) + (dual totalhoursnight) + (comd totalhoursnight) + (pic hoursdaynight) + (fl ^. instrumentflightTime) +singleFlightTimeReport _ = + mempty + +getFlightTimeReport :: + Logbook a b c d + -> FlightTimeReport +getFlightTimeReport (Logbook _ (Entries es)) = + foldl' (\a -> mappend a . singleFlightTimeReport) mempty es diff --git a/src/Data/Aviation/Casr/Logbook/Reports/Html.hs b/src/Data/Aviation/Casr/Logbook/Reports/Html.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Reports/Html.hs @@ -0,0 +1,342 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Aviation.Casr.Logbook.Reports.Html( + htmlFlightPointDay + , htmlTakeOffLanding90 + , takeofflanding + , takeoffslandings90 + , htmlSimulatorTimeReport + , htmlFlightTimeReport +) where + +import Control.Category((.)) +import Control.Lens((^.), _Wrapped) +import Data.Aviation.Casr.Logbook.Types( + landingTime + , daytime + , point + , logbookentries + , flightStart + , flightIntermediate + , flightEnd + , flightpath + , FlightPoint + , Logbook + , Entry(AircraftFlightEntry) + ) +import Data.Aviation.Casr.Logbook.Html.Html( + htmlTimeAmount + , htmlAviatorShort + ) +import Data.Aviation.Casr.Logbook.Reports( + hoursMultiEngineDual + , hoursMultiEngineInCommand + , hoursDay + , hoursDayICUS + , hoursDayDual + , hoursDayInCommand + , hoursNight + , hoursNightICUS + , hoursNightDual + , hoursNightInCommand + , hoursWithPiC + , hoursInstrument + , hoursTotalDual + , hoursTotalInCommand + , hoursInAircraftType + , hoursInAircraftRegistration + , hoursSingleEngine + , hoursSingleEngineICUS + , hoursSingleEngineDual + , hoursMultiEngineInCommand + , hoursMultiEngineDual + , hoursTotalICUS + , hoursSingleEngineInCommand + , hoursMultiEngine + , hoursMultiEngineICUS + , hoursTotal + , flightsTotal + , hoursTotalSimulator + , hoursInstrumentSimulator + , currency90 + , landing1 + , landing2 + , landing3 + , takeoff1 + , takeoff2 + , takeoff3 + , TakeOffLanding90(TakeOffLanding90) + , SimulatorTimeReport + , FlightTimeReport + ) +import Data.Foldable(foldr) +import Data.Function(flip, ($)) +import qualified Data.Map as Map(foldrWithKey) +import Data.List(sortBy, (++)) +import Data.Maybe(Maybe(Nothing, Just)) +import Data.Monoid(mempty) +import Data.Ord(comparing, min) +import Data.String(fromString) +import qualified Data.Text as Text(pack) +import Data.Time(addDays) +import Lucid( + class_ + , span_ + , ul_ + , li_ + , div_ + , h3_ + , href_ + , id_ + , a_ + , ol_ + , Html + ) +import Prelude(show) + +htmlFlightPointDay :: + FlightPoint + -> Html () +htmlFlightPointDay p = + let j = p ^. landingTime . daytime + in do span_ [class_ "currencyflightpointday"] . fromString . show $ j + " " + span_ [class_ "currencyflightpointpoint"] . fromString $ p ^. point + +htmlTakeOffLanding90 :: + Logbook a b c d + -> Maybe TakeOffLanding90 + -> Html () +htmlTakeOffLanding90 _ r = + div_ [class_ "flighttimecurrencyreport"] $ + do a_ [id_ "RPT_FlightTimeCurrency"] "" + a_ [href_ (Text.pack ("#RPT_FlightTimeCurrency"))] . span_ [class_ "entrytag"] $ "RPT" + h3_ [class_ "flighttimecurrencyreportname"] "Flight Time Currency Report" + case r of + Nothing -> + span_ [class_ "flighttimenocurrency"] "NIL three take-offs and landings" + Just x -> + do ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "Three most recent take-offs" + ol_ [] $ + do li_ [] $ + span_ [class_ "value"] (htmlFlightPointDay (x ^. takeoff1)) + li_ [] $ + span_ [class_ "value"] (htmlFlightPointDay (x ^. takeoff2)) + li_ [] $ + span_ [class_ "value"] (htmlFlightPointDay (x ^. takeoff3)) + li_ [] $ + do span_ [class_ "key"] "Three most recent landings" + ol_ [] $ + do li_ [] $ + span_ [class_ "value"] (htmlFlightPointDay (x ^. landing1)) + li_ [] $ + span_ [class_ "value"] (htmlFlightPointDay (x ^. landing2)) + li_ [] $ + span_ [class_ "value"] (htmlFlightPointDay (x ^. landing3)) + li_ [] $ + do span_ [class_ "key"] "90-day currency: " + span_ [class_ "value"] . fromString . show $ x ^. currency90 + +takeofflanding :: + Entry a b c d + -> ([FlightPoint], [FlightPoint]) +takeofflanding (AircraftFlightEntry fl _) = + let p = fl ^. flightpath + i = p ^. flightIntermediate + in (p ^. flightStart : i, i ++ [p ^. flightEnd]) +takeofflanding _ = + ([], []) + +takeoffslandings90 :: + Logbook a b c d + -> Maybe TakeOffLanding90 +takeoffslandings90 b = + let (t, l) = foldr + (\a (t', l') -> let (u', m') = takeofflanding a + in (t' ++ u', m' ++ l')) + ([], []) (b ^. logbookentries . _Wrapped) + revsort = sortBy (flip (comparing (^. landingTime))) + (u, m) = (revsort t, revsort l) + in case u of + t1:t2:t3:_ -> + case m of + l1:l2:l3:_ -> + let tt = t3 ^. landingTime . daytime + lt = l3 ^. landingTime . daytime + in Just (TakeOffLanding90 t1 t2 t3 l1 l2 l3 (addDays 90 (tt `min` lt))) + _ -> + Nothing + _ -> + Nothing + +htmlSimulatorTimeReport :: + Logbook a b c d + -> SimulatorTimeReport + -> Html () +htmlSimulatorTimeReport _ r = + div_ [class_ "simulatortimereport"] $ + do a_ [id_ "RPT_SimulatorTimeSummary"] "" + a_ [href_ (Text.pack ("#RPT_SimulatorTimeSummary"))] . span_ [class_ "entrytag"] $ "RPT" + h3_ [class_ "simulatortimereportname"] "Simulator Time Summary Report" + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "Total Simulator Hours: " + span_ [class_ "value"] . htmlTimeAmount $ r ^. hoursInstrumentSimulator + li_ [] $ + do span_ [class_ "key"] "Instrument Simulator Hours: " + span_ [class_ "value"] . htmlTimeAmount $ r ^. hoursTotalSimulator + +htmlFlightTimeReport :: + Logbook a b c d + -> FlightTimeReport + -> Html () +htmlFlightTimeReport _ r = + div_ [class_ "flighttimereport"] $ + do a_ [id_ "RPT_FlightTimeSummary"] "" + a_ [href_ (Text.pack "#RPT_FlightTimeSummary")] . span_ [class_ "entrytag"] $ "RPT" + h3_ [class_ "flighttimereportname"] "Flight Time Summary Report" + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "Total Flights: " + span_ [class_ "value"] . fromString . show $ (r ^. flightsTotal) + li_ [] $ + do span_ [class_ "key"] "Total Flight Hours: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursTotal + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "in-command under-instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursTotalICUS + li_ [] $ + do span_ [class_ "key"] "dual under-instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursTotalDual + li_ [] $ + do span_ [class_ "key"] "in-command: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursTotalInCommand + li_ [] $ + do span_ [class_ "key"] "Hours in type: " + div_ [class_ "value"] . + ul_ [] . Map.foldrWithKey (\y (tl, iu, dl, ic) x -> + do li_ [] $ + do span_ [class_ "aircrafttype"] $ fromString y + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "total: " + span_ [class_ "value"] . htmlTimeAmount $ tl + li_ [] $ + do span_ [class_ "key"] "in-command under-instruction: " + span_ [class_ "value"] . htmlTimeAmount $ iu + li_ [] $ + do span_ [class_ "key"] "dual under-instruction: " + span_ [class_ "value"] . htmlTimeAmount $ dl + li_ [] $ + do span_ [class_ "key"] "in-command: " + span_ [class_ "value"] . htmlTimeAmount $ ic + x) mempty $ r ^. hoursInAircraftType + li_ [] $ + do span_ [class_ "key"] "Hours in registration: " + div_ [class_ "value"] . + ul_ [] . Map.foldrWithKey (\y (tl, iu, dl, ic) x -> + do li_ [] $ + do span_ [class_ "aircraftregistration"] $ fromString y + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "total: " + span_ [class_ "value"] . htmlTimeAmount $ tl + li_ [] $ + do span_ [class_ "key"] "in-command under-instruction: " + span_ [class_ "value"] . htmlTimeAmount $ iu + li_ [] $ + do span_ [class_ "key"] "dual under-instruction: " + span_ [class_ "value"] . htmlTimeAmount $ dl + li_ [] $ + do span_ [class_ "key"] "in-command: " + span_ [class_ "value"] . htmlTimeAmount $ ic + x) mempty $ r ^. hoursInAircraftRegistration + li_ [] $ + do span_ [class_ "key"] "Hours in Single-Engine: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursSingleEngine + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "in-command under-instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursSingleEngineICUS + li_ [] $ + do span_ [class_ "key"] "dual under-instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursSingleEngineDual + li_ [] $ + do span_ [class_ "key"] "in-command: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursSingleEngineInCommand + li_ [] $ + do span_ [class_ "key"] "Hours in Multi-Engine: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursMultiEngine + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "in-command under-instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursMultiEngineICUS + li_ [] $ + do span_ [class_ "key"] "dual under-instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursMultiEngineDual + li_ [] $ + do span_ [class_ "key"] "in-command: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursMultiEngineInCommand + li_ [] $ + do span_ [class_ "key"] "Hours in Day: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursDay + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "in-command under-instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursDayICUS + li_ [] $ + do span_ [class_ "key"] "dual under-instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursDayDual + li_ [] $ + do span_ [class_ "key"] "in-command: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursDayInCommand + li_ [] $ + do span_ [class_ "key"] "Hours in Night: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursNight + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "in-command under-instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursNightICUS + li_ [] $ + do span_ [class_ "key"] "dual under-instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursNightDual + li_ [] $ + do span_ [class_ "key"] "in-command: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursNightInCommand + li_ [] $ + do span_ [class_ "key"] "Hours with PiC: " + div_ [class_ "value"] . + ul_ [] . Map.foldrWithKey (\a t x -> + do li_ [] $ + do span_ [class_ "key"] $ + do htmlAviatorShort a + ": " + span_ [class_ "value"] . htmlTimeAmount $ t + x) mempty $ r ^. hoursWithPiC + li_ [] $ + do span_ [class_ "key"] "Hours instrument in-flight: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursInstrument diff --git a/src/Data/Aviation/Casr/Logbook/Reports/Meta.hs b/src/Data/Aviation/Casr/Logbook/Reports/Meta.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Reports/Meta.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Reports.Meta( + module M +) where + +import Data.Aviation.Casr.Logbook.Reports.Meta.ExpenseReport as M diff --git a/src/Data/Aviation/Casr/Logbook/Reports/Meta/ExpenseReport.hs b/src/Data/Aviation/Casr/Logbook/Reports/Meta/ExpenseReport.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Reports/Meta/ExpenseReport.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Reports.Meta.ExpenseReport( + ExpenseReport(ExpenseReport) +, HasExpenseReport(..) +, entryExpenseReport +, logbookExpenseReport +) where + +import Control.Category((.)) +import Control.Lens(makeClassy, (^.), _Wrapped) +import Control.Monad((>>=), return) +import Data.Aviation.Casr.Logbook.Types(Entry(AircraftFlightEntry, SimulatorFlightEntry, ExamEntry, BriefingEntry), Logbook, logbookentries) +import Data.Aviation.Casr.Logbook.Meta( + AircraftFlightMeta + , SimulatorFlightMeta + , BriefingMeta + , ExamMeta + , AircraftFlightExpense(ExpenseAircraftUsage, ExpenseAircraftLanding) + , briefingCost + , examexpenseamount + , simulatorFlightCost + , aircraftlandingexpenseamount + , expenses + , aircraftUsageCost + ) +import Data.Eq(Eq) +import Data.Foldable(sum, foldMap) +import Data.Function(($)) +import Data.Int(Int) +import Data.Monoid(Monoid(mempty, mappend)) +import Data.Ord(Ord) +import Prelude(Show) +import Prelude((+)) + +data ExpenseReport = + ExpenseReport { + _aircraftUsageExpenseTotal :: Int + , _aircraftLandingExpenseTotal :: Int + , _briefingExpenseTotal :: Int + , _examExpenseTotal :: Int + , _simulatorFlightTotal :: Int + } deriving (Eq, Ord, Show) + +makeClassy ''ExpenseReport + +instance Monoid ExpenseReport where + mempty = + ExpenseReport 0 0 0 0 0 + ExpenseReport ag1 al1 b1 e1 s1 `mappend` ExpenseReport ag2 al2 b2 e2 s2 = + ExpenseReport (ag1 + ag2) (al1 + al2) (b1 + b2) (e1 + e2) (s1 + s2) + +entryExpenseReport :: + Entry AircraftFlightMeta SimulatorFlightMeta ExamMeta BriefingMeta + -> ExpenseReport +entryExpenseReport (AircraftFlightEntry fl e) = + let usage = + sum $ e ^. expenses >>= \p -> + case p of + ExpenseAircraftUsage e' -> [aircraftUsageCost fl e'] + ExpenseAircraftLanding _ -> [] + landing = + sum $ e ^. expenses >>= \p -> + case p of + ExpenseAircraftUsage _ -> [] + ExpenseAircraftLanding l -> [l ^. aircraftlandingexpenseamount] + in ExpenseReport + usage + landing + 0 + 0 + 0 +entryExpenseReport (SimulatorFlightEntry fl e) = + ExpenseReport + 0 + 0 + 0 + 0 + (sum $ e ^. _Wrapped >>= return . simulatorFlightCost fl) +entryExpenseReport (ExamEntry _ e) = + ExpenseReport + 0 + 0 + 0 + (sum $ e ^. _Wrapped >>= return . (^. examexpenseamount)) + 0 +entryExpenseReport (BriefingEntry br e) = + ExpenseReport + 0 + 0 + (sum $ e ^. _Wrapped >>= return . briefingCost br) + 0 + 0 + +logbookExpenseReport :: + Logbook AircraftFlightMeta SimulatorFlightMeta ExamMeta BriefingMeta + -> ExpenseReport +logbookExpenseReport b = + foldMap entryExpenseReport (b ^. logbookentries . _Wrapped) + diff --git a/src/Data/Aviation/Casr/Logbook/Reports/Meta/Html.hs b/src/Data/Aviation/Casr/Logbook/Reports/Meta/Html.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Reports/Meta/Html.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Aviation.Casr.Logbook.Reports.Meta.Html( + htmlExpenseReport +, htmlReports +) where + +import Control.Category((.)) +import Data.Aviation.Casr.Logbook.Reports(getFlightTimeReport, getSimulatorTimeReport) +import Data.Aviation.Casr.Logbook.Reports.Html(htmlFlightTimeReport, htmlSimulatorTimeReport, htmlTakeOffLanding90, takeoffslandings90) +import Data.Aviation.Casr.Logbook.Reports.Meta(ExpenseReport(ExpenseReport), logbookExpenseReport) +import Data.Aviation.Casr.Logbook.Meta(AircraftFlightMeta, SimulatorFlightMeta, ExamMeta, BriefingMeta) +import Data.Aviation.Casr.Logbook.Meta.Html(showThousandCentsAsDollars, showHundredCentsAsDollars) +import Data.Aviation.Casr.Logbook.Types(Logbook) +import Data.Function(($)) +import Data.String(fromString) +import qualified Data.Text as Text(pack) +import Lucid( + hr_ + , class_ + , ul_ + , li_ + , span_ + , h3_ + , div_ + , a_ + , id_ + , href_ + , Html + ) +import Prelude((+)) + +htmlExpenseReport :: + Logbook AircraftFlightMeta SimulatorFlightMeta ExamMeta BriefingMeta + -> ExpenseReport + -> Html () +htmlExpenseReport _ (ExpenseReport ag al b e s) = + div_ [class_ "expensereport"] $ + do a_ [id_ "RPT_Expense"] "" + a_ [href_ (Text.pack ("#RPT_Expense"))] . span_ [class_ "entrytag"] $ "RPT" + h3_ [class_ "expensereportname"] "Expense Report" + do ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "Aircraft: " + span_ [class_ "value"] . fromString . ('$':) . showThousandCentsAsDollars $ ag + al + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] "Usage: " + span_ [class_ "value"] . fromString . ('$':) . showThousandCentsAsDollars $ ag + li_ [] $ + do span_ [class_ "key"] "Landing: " + span_ [class_ "value"] . fromString . ('$':) . showHundredCentsAsDollars $ al + li_ [] $ + do span_ [class_ "key"] "Briefing: " + span_ [class_ "value"] . fromString . ('$':) . showThousandCentsAsDollars $ b + li_ [] $ + do span_ [class_ "key"] "Exam: " + span_ [class_ "value"] . fromString . ('$':) . showHundredCentsAsDollars $ e + li_ [] $ + do span_ [class_ "key"] "Simulator: " + span_ [class_ "value"] . fromString . ('$':) . showThousandCentsAsDollars $ s + li_ [] $ + do span_ [class_ "key"] "TOTAL: " + span_ [class_ "value"] . fromString . ('$':) . showThousandCentsAsDollars $ (ag + al + b + e + s) + +htmlReports :: + Logbook AircraftFlightMeta SimulatorFlightMeta ExamMeta BriefingMeta + -> Html () +htmlReports b = + do htmlFlightTimeReport b (getFlightTimeReport b) + hr_ [] + htmlSimulatorTimeReport b (getSimulatorTimeReport b) + hr_ [] + htmlTakeOffLanding90 b (takeoffslandings90 b) + hr_ [] + htmlExpenseReport b (logbookExpenseReport b) diff --git a/src/Data/Aviation/Casr/Logbook/Reports/SimulatorTimeReport.hs b/src/Data/Aviation/Casr/Logbook/Reports/SimulatorTimeReport.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Reports/SimulatorTimeReport.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Reports.SimulatorTimeReport( + SimulatorTimeReport(..) +, HasSimulatorTimeReport(..) +, singleSimulatorTimeReport +, getSimulatorTimeReport +) where + +import Control.Category((.)) +import Control.Lens(makeClassy, (^.)) +import Data.Aviation.Casr.Logbook.Types + ( + TimeAmount + , Logbook(Logbook) + , Entry(SimulatorFlightEntry) + , Entries(Entries) + , simulatorTime + , instrumentsimulatorTime + ) +import Data.Eq(Eq) +import Data.Foldable(foldl') +import Data.Monoid(Monoid(mappend, mempty)) +import Data.Ord(Ord) +import Prelude(Show) + +data SimulatorTimeReport = + SimulatorTimeReport { + _hoursTotalSimulator :: + TimeAmount + , _hoursInstrumentSimulator :: + TimeAmount + } + deriving (Eq, Ord, Show) + +makeClassy ''SimulatorTimeReport + +instance Monoid SimulatorTimeReport where + mempty = + SimulatorTimeReport + mempty + mempty + SimulatorTimeReport t1 i1 `mappend` SimulatorTimeReport t2 i2 = + SimulatorTimeReport (t1 `mappend` t2) (i1 `mappend` i2) + +singleSimulatorTimeReport :: + Entry a b c d + -> SimulatorTimeReport +singleSimulatorTimeReport (SimulatorFlightEntry fl _) = + SimulatorTimeReport + (fl ^. simulatorTime) + (fl ^. instrumentsimulatorTime) +singleSimulatorTimeReport _ = + mempty + +getSimulatorTimeReport :: + Logbook a b c d + -> SimulatorTimeReport +getSimulatorTimeReport (Logbook _ (Entries es)) = + foldl' (\a -> mappend a . singleSimulatorTimeReport) mempty es diff --git a/src/Data/Aviation/Casr/Logbook/Reports/TakeOffLanding90.hs b/src/Data/Aviation/Casr/Logbook/Reports/TakeOffLanding90.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Reports/TakeOffLanding90.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Reports.TakeOffLanding90( + TakeOffLanding90(..) +, HasTakeOffLanding90(..) +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types(FlightPoint) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Data.Time(Day) +import Prelude(Show) + +data TakeOffLanding90 = + TakeOffLanding90 { + _takeoff1 :: + FlightPoint + , _takeoff2 :: + FlightPoint + , _takeoff3 :: + FlightPoint + , _landing1 :: + FlightPoint + , _landing2 :: + FlightPoint + , _landing3 :: + FlightPoint + , _currency90 :: + Day + } + deriving (Eq, Ord, Show) + +makeClassy ''TakeOffLanding90 diff --git a/src/Data/Aviation/Casr/Logbook/Types.hs b/src/Data/Aviation/Casr/Logbook/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types.hs @@ -0,0 +1,22 @@ +module Data.Aviation.Casr.Logbook.Types ( + module L +) where + +import Data.Aviation.Casr.Logbook.Types.Logbook as L +import Data.Aviation.Casr.Logbook.Types.Rating as L +import Data.Aviation.Casr.Logbook.Types.Aviator as L +import Data.Aviation.Casr.Logbook.Types.Engine as L +import Data.Aviation.Casr.Logbook.Types.Aircraft as L +import Data.Aviation.Casr.Logbook.Types.TimeAmount as L +import Data.Aviation.Casr.Logbook.Types.DayNight as L +import Data.Aviation.Casr.Logbook.Types.Location as L +import Data.Aviation.Casr.Logbook.Types.Command as L +import Data.Aviation.Casr.Logbook.Types.Time as L +import Data.Aviation.Casr.Logbook.Types.FlightPoint as L +import Data.Aviation.Casr.Logbook.Types.FlightPath as L +import Data.Aviation.Casr.Logbook.Types.AircraftFlight as L +import Data.Aviation.Casr.Logbook.Types.SimulatorFlight as L +import Data.Aviation.Casr.Logbook.Types.Exam as L +import Data.Aviation.Casr.Logbook.Types.Briefing as L +import Data.Aviation.Casr.Logbook.Types.Entry as L +import Data.Aviation.Casr.Logbook.Types.Entries as L diff --git a/src/Data/Aviation/Casr/Logbook/Types/Aircraft.hs b/src/Data/Aviation/Casr/Logbook/Types/Aircraft.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Aircraft.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.Aircraft( + Aircraft(..) +, HasAircraft(..) +, singleaircraft +, multiaircraft +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types.Engine(Engine(Single, Multi)) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data Aircraft = + Aircraft { + _aircraftType :: String + , _aircraftRegistration :: String + , _aircraftEngine :: Engine + } deriving (Eq, Ord, Show) + +makeClassy ''Aircraft + +singleaircraft :: + String + -> String + -> Aircraft +singleaircraft t r = + Aircraft + t + r + Single + +multiaircraft :: + String + -> String + -> Aircraft +multiaircraft t r = + Aircraft + t + r + Multi diff --git a/src/Data/Aviation/Casr/Logbook/Types/AircraftFlight.hs b/src/Data/Aviation/Casr/Logbook/Types/AircraftFlight.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/AircraftFlight.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.AircraftFlight( + AircraftFlight(..) +, HasAircraftFlight(..) +, icusonlyflight +, noif_icusonlyflight +, dualonlyflight +, noif_dualonlyflight +, commandonlyflight +, noif_commandonlyflight +) where + +import Control.Category((.)) +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types.Aircraft(Aircraft, HasAircraft(aircraft)) +import Data.Aviation.Casr.Logbook.Types.Command(Command(ICUS, Dual, InCommand)) +import Data.Aviation.Casr.Logbook.Types.DayNight(DayNight, HasDayNight(dayNight)) +import Data.Aviation.Casr.Logbook.Types.FlightPath(FlightPath, HasFlightPath(flightPath)) +import Data.Aviation.Casr.Logbook.Types.Aviator(Aviator) +import Data.Aviation.Casr.Logbook.Types.TimeAmount(TimeAmount, zerotimeamount) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data AircraftFlight = + AircraftFlight { + _aircraftflightname :: String + , _flightaircraft :: Aircraft + , _command :: Command + , _daynight :: DayNight + , _flightpath :: FlightPath + , _flightothercrew :: [Aviator] + , _instrumentflightTime :: TimeAmount + } deriving (Eq, Ord, Show) + +makeClassy ''AircraftFlight + +instance HasAircraft AircraftFlight where + aircraft = + flightaircraft . aircraft + +instance HasDayNight AircraftFlight where + dayNight = + daynight . dayNight + +instance HasFlightPath AircraftFlight where + flightPath = + flightpath . flightPath + +icusonlyflight :: + String + -> Aircraft + -> Aviator + -> DayNight + -> FlightPath + -> TimeAmount + -> AircraftFlight +icusonlyflight n a v t p i = + AircraftFlight + n + a + (ICUS v) + t + p + [] + i + +noif_icusonlyflight :: + String + -> Aircraft + -> Aviator + -> DayNight + -> FlightPath + -> AircraftFlight +noif_icusonlyflight n a v t p = + icusonlyflight + n + a + v + t + p + zerotimeamount + +dualonlyflight :: + String + -> Aircraft + -> Aviator + -> DayNight + -> FlightPath + -> TimeAmount + -> AircraftFlight +dualonlyflight n a v t p i = + AircraftFlight + n + a + (Dual v) + t + p + [] + i + +noif_dualonlyflight :: + String + -> Aircraft + -> Aviator + -> DayNight + -> FlightPath + -> AircraftFlight +noif_dualonlyflight n a v t p = + dualonlyflight + n + a + v + t + p + zerotimeamount + +commandonlyflight :: + String + -> Aircraft + -> DayNight + -> FlightPath + -> TimeAmount + -> AircraftFlight +commandonlyflight n a t p i = + AircraftFlight + n + a + InCommand + t + p + [] + i + +noif_commandonlyflight :: + String + -> Aircraft + -> DayNight + -> FlightPath + -> AircraftFlight +noif_commandonlyflight n a t p = + commandonlyflight + n + a + t + p + zerotimeamount diff --git a/src/Data/Aviation/Casr/Logbook/Types/Aviator.hs b/src/Data/Aviation/Casr/Logbook/Types/Aviator.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Aviator.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.Aviator( + Aviator(..) +, HasAviator(..) +, aviatorwithname +, nodobaviator +, dobaviator +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types.Rating(Rating) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Data.Digit(Digit) +import Data.Maybe(Maybe(Nothing, Just)) +import Data.String(String) +import Data.Time(Day) +import Prelude(Show) + +data Aviator = + Aviator { + _surname :: String + , _firstname :: String + , _arn :: [Digit] + , _dob :: Maybe Day + , _ratings :: [Rating] + } deriving (Eq, Ord, Show) + +makeClassy ''Aviator + +aviatorwithname :: + String + -> String + -> Aviator +aviatorwithname s f = + Aviator + s + f + [] + Nothing + [] + +nodobaviator :: + String + -> String + -> [Digit] + -> [Rating] + -> Aviator +nodobaviator s f r = + Aviator + s + f + r + Nothing + +dobaviator :: + String + -> String + -> [Digit] + -> Day + -> [Rating] + -> Aviator +dobaviator s f r b = + Aviator + s + f + r + (Just b) diff --git a/src/Data/Aviation/Casr/Logbook/Types/Briefing.hs b/src/Data/Aviation/Casr/Logbook/Types/Briefing.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Briefing.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.Briefing( + Briefing(..) +, HasBriefing(..) +) where + +import Control.Category((.)) +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types.Aviator(Aviator, HasAviator(aviator)) +import Data.Aviation.Casr.Logbook.Types.Location(Location, HasLocation(location)) +import Data.Aviation.Casr.Logbook.Types.Time(Time, HasTime(time)) +import Data.Aviation.Casr.Logbook.Types.TimeAmount(TimeAmount, HasTimeAmount(timeAmount)) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data Briefing = + Briefing { + _briefingName :: String + , _briefingLocation :: Location + , _briefingTime :: Time + , _briefer :: Aviator + , _briefingTimeAmount :: TimeAmount + } deriving (Eq, Ord, Show) + +makeClassy ''Briefing + +instance HasLocation Briefing where + location = + briefingLocation . location + +instance HasTime Briefing where + time = + briefingTime . time + +instance HasAviator Briefing where + aviator = + briefer . aviator + +instance HasTimeAmount Briefing where + timeAmount = + briefingTimeAmount . timeAmount + diff --git a/src/Data/Aviation/Casr/Logbook/Types/Command.hs b/src/Data/Aviation/Casr/Logbook/Types/Command.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Command.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.Command( + Command(..) +, AsCommand(..) +, getInstructingPic +) where + +import Control.Lens(makeClassyPrisms) +import Data.Aviation.Casr.Logbook.Types.Aviator(Aviator) +import Data.Eq(Eq) +import Data.Maybe(Maybe(Just, Nothing)) +import Data.Ord(Ord) +import Prelude(Show) + +data Command = + ICUS Aviator + | Dual Aviator + | InCommand + deriving (Eq, Ord, Show) + +makeClassyPrisms ''Command + +getInstructingPic :: + Command + -> Maybe Aviator +getInstructingPic (ICUS a) = + Just a +getInstructingPic (Dual a) = + Just a +getInstructingPic InCommand = + Nothing diff --git a/src/Data/Aviation/Casr/Logbook/Types/DayNight.hs b/src/Data/Aviation/Casr/Logbook/Types/DayNight.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/DayNight.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.DayNight( + DayNight(..) +, HasDayNight(..) +, day +, night +, totalDayNight +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types.TimeAmount(TimeAmount(TimeAmount), zerotimeamount) +import Data.Digit(Digit) +import Data.Eq(Eq) +import Data.Int(Int) +import Data.Monoid(mappend) +import Data.Ord(Ord) +import Prelude(Show) + +data DayNight = + DayNight { + _dayDayNight :: TimeAmount + , _nightDayNight :: TimeAmount + } deriving (Eq, Ord, Show) + +makeClassy ''DayNight + +day :: + Int + -> Digit + -> DayNight +day h p = + DayNight (TimeAmount h p) zerotimeamount + +night :: + Int + -> Digit + -> DayNight +night h p = + DayNight zerotimeamount (TimeAmount h p) + +totalDayNight :: + DayNight + -> TimeAmount +totalDayNight (DayNight d n) = + d `mappend` n diff --git a/src/Data/Aviation/Casr/Logbook/Types/Engine.hs b/src/Data/Aviation/Casr/Logbook/Types/Engine.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Engine.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.Engine( + Engine(..) +, AsEngine(..) +) where + +import Control.Lens(makeClassyPrisms) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +data Engine = + Single + | Multi + deriving (Eq, Ord, Show) + +makeClassyPrisms ''Engine diff --git a/src/Data/Aviation/Casr/Logbook/Types/Entries.hs b/src/Data/Aviation/Casr/Logbook/Types/Entries.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Entries.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} + +module Data.Aviation.Casr.Logbook.Types.Entries( + Entries(..) +, emptyentries +, singleentry +) where + +import Control.Lens(makeWrapped) +import Data.Aviation.Casr.Logbook.Types.Entry(Entry) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +newtype Entries ae se ee be = + Entries + [Entry ae se ee be] + deriving (Eq, Ord, Show) + +makeWrapped ''Entries + +emptyentries :: + Entries ae se ee be +emptyentries = + Entries [] + +singleentry :: + Entry ae se ee be + -> Entries ae se ee be +singleentry e = + Entries [e] diff --git a/src/Data/Aviation/Casr/Logbook/Types/Entry.hs b/src/Data/Aviation/Casr/Logbook/Types/Entry.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Entry.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} + +module Data.Aviation.Casr.Logbook.Types.Entry( + Entry(..) +, AsEntry(..) +) where + +import Control.Lens(makeClassyPrisms) +import Data.Aviation.Casr.Logbook.Types.AircraftFlight(AircraftFlight) +import Data.Aviation.Casr.Logbook.Types.SimulatorFlight(SimulatorFlight) +import Data.Aviation.Casr.Logbook.Types.Exam(Exam) +import Data.Aviation.Casr.Logbook.Types.Briefing(Briefing) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +data Entry ae se ee be = + AircraftFlightEntry AircraftFlight ae + | SimulatorFlightEntry SimulatorFlight se + | ExamEntry Exam ee + | BriefingEntry Briefing be + deriving (Eq, Ord, Show) + +makeClassyPrisms ''Entry diff --git a/src/Data/Aviation/Casr/Logbook/Types/Exam.hs b/src/Data/Aviation/Casr/Logbook/Types/Exam.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Exam.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.Exam( + Exam(..) +, HasExam(..) +, dayonlyexam +) where + +import Control.Category((.)) +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types.Aviator(Aviator, HasAviator(aviator)) +import Data.Aviation.Casr.Logbook.Types.Time(Time, HasTime(time), dayonly) +import Data.Aviation.Casr.Logbook.Types.Location(Location, HasLocation(location)) +import Data.Eq(Eq) +import Data.Int(Int) +import Data.Ord(Ord) +import Data.String(String) +import Data.Time(Day) +import Prelude(Show) + +data Exam = + Exam { + _examName :: String + , _examLocation :: Location + , _examTime :: Time + , _examDelegate :: Aviator + , _examResult :: Int + , _examResultMaximum :: Int + } deriving (Eq, Ord, Show) + +makeClassy ''Exam + +instance HasLocation Exam where + location = + examLocation . location + +instance HasTime Exam where + time = + examTime . time + +instance HasAviator Exam where + aviator = + examDelegate . aviator + +dayonlyexam :: + String + -> Location + -> Day + -> Aviator + -> Int + -> Int + -> Exam +dayonlyexam n l d = + Exam + n + l + (dayonly d) diff --git a/src/Data/Aviation/Casr/Logbook/Types/FlightPath.hs b/src/Data/Aviation/Casr/Logbook/Types/FlightPath.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/FlightPath.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.FlightPath( + FlightPath(..) +, HasFlightPath(..) +, directflightpath +, directcircuit +, pointsatdate +, flightPathList +, circuitsatdate +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types.FlightPoint(FlightPoint, pointatdate) +import Data.Eq(Eq) +import Data.Functor((<$>)) +import Data.Int(Int) +import Data.List((++), replicate) +import Data.Ord(Ord) +import Data.String(String) +import Data.Time(Day) +import Prelude(Show) + +data FlightPath = + FlightPath { + _flightStart :: FlightPoint + , _flightIntermediate :: [FlightPoint] + , _flightEnd :: FlightPoint + } deriving (Eq, Ord, Show) + +makeClassy ''FlightPath + +directflightpath :: + FlightPoint + -> FlightPoint + -> FlightPath +directflightpath x y = + FlightPath x [] y + +directcircuit :: + FlightPoint + -> FlightPath +directcircuit x = + directflightpath x x + +pointsatdate :: + String + -> [String] + -> String + -> Day + -> FlightPath +pointsatdate x i y d = + FlightPath + (pointatdate x d) + ((\s -> pointatdate s d) <$> i) + (pointatdate y d) + +flightPathList :: + FlightPath + -> [FlightPoint] +flightPathList (FlightPath s x e) = + s : x ++ [e] + +circuitsatdate :: + String + -> Int + -> Day + -> FlightPath +circuitsatdate x n d = + FlightPath + (pointatdate x d) + (replicate n (pointatdate x d)) + (pointatdate x d) diff --git a/src/Data/Aviation/Casr/Logbook/Types/FlightPoint.hs b/src/Data/Aviation/Casr/Logbook/Types/FlightPoint.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/FlightPoint.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.FlightPoint( + FlightPoint(..) +, HasFlightPoint(..) +, pointatdate +, runwayatdate +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types.Time(Time, dayonly) +import Data.Eq(Eq) +import Data.Maybe(Maybe(Nothing, Just)) +import Data.Ord(Ord) +import Data.String(String) +import Data.Time(Day) +import Prelude(Show) + +data FlightPoint = + FlightPoint { + _point :: String + , _runway :: Maybe String + , _landingTime :: Time + } deriving (Eq, Ord, Show) + +makeClassy ''FlightPoint + +pointatdate :: + String + -> Day + -> FlightPoint +pointatdate a d = + FlightPoint + a + Nothing + (dayonly d) + +runwayatdate :: + String + -> String + -> Day + -> FlightPoint +runwayatdate a r d = + FlightPoint + a + (Just r) + (dayonly d) diff --git a/src/Data/Aviation/Casr/Logbook/Types/Location.hs b/src/Data/Aviation/Casr/Logbook/Types/Location.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Location.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.Location( + Location(..) +, HasLocation(..) +) where + +import Control.Lens(makeClassy) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show, Double) + +data Location = + Location { + _locationname :: String + , _locationlatitude :: Double + , _locationlongitude :: Double + } deriving (Eq, Ord, Show) + +makeClassy ''Location diff --git a/src/Data/Aviation/Casr/Logbook/Types/Logbook.hs b/src/Data/Aviation/Casr/Logbook/Types/Logbook.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Logbook.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} + +module Data.Aviation.Casr.Logbook.Types.Logbook( + Logbook(..) +, HasLogbook(..) +, aviatorlogbook +, emptylogbook +, singleentrylogbook +) where + +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types.Aviator(Aviator) +import Data.Aviation.Casr.Logbook.Types.Entries(Entries(Entries), emptyentries, singleentry) +import Data.Aviation.Casr.Logbook.Types.Entry(Entry) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Prelude(Show) + +data Logbook ae se ee be = + Logbook { + _logbookaviator :: Aviator + , _logbookentries :: (Entries ae se ee be) + } deriving (Eq, Ord, Show) + +makeClassy ''Logbook + +aviatorlogbook :: + Aviator + -> [Entry ae se ee be] + -> Logbook ae se ee be +aviatorlogbook a e = + Logbook + a + (Entries e) + +emptylogbook :: + Aviator + -> Logbook ae se ee be +emptylogbook a = + Logbook + a + emptyentries + +singleentrylogbook :: + Aviator + -> Entry ae se ee be + -> Logbook ae se ee be +singleentrylogbook a e = + Logbook + a + (singleentry e) diff --git a/src/Data/Aviation/Casr/Logbook/Types/Rating.hs b/src/Data/Aviation/Casr/Logbook/Types/Rating.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Rating.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.Rating( + Rating(..) +, HasRating(..) +, nodayrating +, dayrating +) where + +import Control.Lens(makeClassy) +import Data.Eq(Eq) +import Data.Maybe(Maybe(Nothing, Just)) +import Data.Ord(Ord) +import Data.String(String) +import Data.Time(Day) +import Prelude(Show) + +data Rating = + Rating { + _ratingName :: String + , _ratingAchieved :: Maybe Day + } deriving (Eq, Ord, Show) + +makeClassy ''Rating + +nodayrating :: + String + -> Rating +nodayrating r = + Rating + r + Nothing + +dayrating :: + String + -> Day + -> Rating +dayrating r d = + Rating + r + (Just d) diff --git a/src/Data/Aviation/Casr/Logbook/Types/SimulatorFlight.hs b/src/Data/Aviation/Casr/Logbook/Types/SimulatorFlight.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/SimulatorFlight.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.SimulatorFlight( + SimulatorFlight(..) +, HasSimulatorFlight(..) +, dayonlysimulator +) where + +import Control.Category((.)) +import Control.Lens(makeClassy) +import Data.Aviation.Casr.Logbook.Types.Time(Time, HasTime(time), dayonly) +import Data.Aviation.Casr.Logbook.Types.Aviator(Aviator) +import Data.Aviation.Casr.Logbook.Types.TimeAmount(TimeAmount) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Data.String(String) +import Data.Time(Day) +import Prelude(Show) + +data SimulatorFlight = + SimulatorFlight { + _simulatorflightname :: String + , _simulatorflighttime :: Time + , _simulatortype :: String + , _simulatorothercrew :: [Aviator] + , _simulatorTime :: TimeAmount + , _instrumentsimulatorTime :: TimeAmount + } deriving (Eq, Ord, Show) + +makeClassy ''SimulatorFlight + +instance HasTime SimulatorFlight where + time = + simulatorflighttime . time + +dayonlysimulator :: + String + -> Day + -> String + -> [Aviator] + -> TimeAmount + -> TimeAmount + -> SimulatorFlight +dayonlysimulator n d = + SimulatorFlight + n + (dayonly d) + diff --git a/src/Data/Aviation/Casr/Logbook/Types/Time.hs b/src/Data/Aviation/Casr/Logbook/Types/Time.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Time.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.Time( + Time(..) +, HasTime(..) +, dayonly +, dayandtime +) where + +import Control.Lens(makeClassy) +import Data.Eq(Eq) +import Data.Ord(Ord) +import Data.Maybe(Maybe(Nothing, Just)) +import Data.Time(Day, TimeOfDay) +import Prelude(Show) + +data Time = + Time { + _daytime :: Day + , _timeofday :: Maybe TimeOfDay + } deriving (Eq, Ord, Show) + +makeClassy ''Time + +dayonly :: + Day + -> Time +dayonly d = + Time d Nothing + +dayandtime :: + Day + -> TimeOfDay + -> Time +dayandtime d t = + Time d (Just t) diff --git a/src/Data/Aviation/Casr/Logbook/Types/TimeAmount.hs b/src/Data/Aviation/Casr/Logbook/Types/TimeAmount.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/TimeAmount.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.TimeAmount( + TimeAmount(..) +, HasTimeAmount(..) +, parttimeamount +, zerotimeamount +, addtimeamount +, timeAmountBy10 +) where + +import Control.Lens(makeClassy, ( # )) +import Data.Eq(Eq) +import Data.Digit(Digit, x0, digit, (/+/)) +import Data.Int(Int) +import Data.Monoid(Monoid(mempty, mappend)) +import Data.Ord(Ord) +import Prelude(Show, Num((+), (*))) + +data TimeAmount = + TimeAmount { + _hours :: Int + , _tenthofhour :: Digit + } deriving (Eq, Ord, Show) + +makeClassy ''TimeAmount + +parttimeamount :: + Digit + -> TimeAmount +parttimeamount = + TimeAmount 0 + +zerotimeamount :: + TimeAmount +zerotimeamount = + TimeAmount 0 x0 + +addtimeamount :: + TimeAmount + -> TimeAmount + -> TimeAmount +TimeAmount f1 p1 `addtimeamount` TimeAmount f2 p2 = + let (h, q) = p1 /+/ p2 + in TimeAmount (f1 + f2 + digit # h) q + +timeAmountBy10 :: + TimeAmount + -> Int +timeAmountBy10 (TimeAmount a b) = + a * 10 + digit # b + +instance Monoid TimeAmount where + mempty = + zerotimeamount + mappend = + addtimeamount