diff --git a/casr-logbook.cabal b/casr-logbook.cabal --- a/casr-logbook.cabal +++ b/casr-logbook.cabal @@ -1,13 +1,13 @@ name: casr-logbook -version: 0.5.4 +version: 0.6.0 license: OtherLicense license-file: LICENSE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> maintainer: Tony Morris -copyright: Copyright (C) 2016 Tony Morris +copyright: Copyright (C) 2016-2021 Tony Morris synopsis: CASR 61.345 Pilot Personal Logbook category: Aviation -description: +description: <> . CASR 61.345 Pilot Personal Logbook @@ -91,6 +91,7 @@ Data.Aviation.Casr.Logbook.Types.Entry Data.Aviation.Casr.Logbook.Types.Entries Data.Aviation.Casr.Logbook.Types.Logbook + Data.Aviation.Casr.Logbook.Types.Instruction Data.Aviation.Casr.Logbook.Html.Html Data.Aviation.Casr.Logbook.Meta.Html diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +0.6.0 + +* Add instruction to flight time report. + 0.5.4 * Update `digit` dependency. diff --git a/src/Data/Aviation/Casr/Logbook/Html/Html.hs b/src/Data/Aviation/Casr/Logbook/Html/Html.hs --- a/src/Data/Aviation/Casr/Logbook/Html/Html.hs +++ b/src/Data/Aviation/Casr/Logbook/Html/Html.hs @@ -20,7 +20,7 @@ , htmlFlightPath , htmlCommand , htmlTimeAmountZero -, htmlTimeAmountZeroWith +, htmlTimeAmountZeroWith , htmlAviators , htmlAircraftFlightName , htmlAircraftFlight @@ -37,8 +37,8 @@ , htmlBriefing , space2dot , htmlEntryTag -, htmlEntry -, htmlEntries +, htmlEntry +, htmlEntries , htmlLogbook , htmlTitleAviator , htmlLogbookDocument @@ -71,7 +71,7 @@ , landingTime , zerotimeamount , flightPathList - , Command(ICUS, Dual, InCommand) + , Command(ICUS, Dual, InCommand, InCommandInstructing) , Rating(Rating) , Aircraft(Aircraft) , Engine(Single, Multi) @@ -137,7 +137,7 @@ ) import Text.Printf(printf) -import Prelude(show, fromIntegral, (/), (*), Double) +import Prelude(show, fromIntegral, (/), (*), Double, undefined) htmlTimeAmount :: TimeAmount @@ -177,7 +177,7 @@ Maybe Day -> Html () htmlRatingDay = - maybe mempty (\q -> + maybe mempty (\q -> do " " span_ [] $ fromString (show q)) @@ -225,7 +225,7 @@ -> Html () htmlAviatorARN a = when (not . null $ a) $ - do li_ [id_ "aviatorarn"] $ + do li_ [id_ "aviatorarn"] $ do span_ [class_ "key"] "ARN: " span_ [class_ "value"] $ fromString (a >>= (\d -> [charDecimal # d])) @@ -245,7 +245,7 @@ -> Html () htmlAviatorRatings r = when (not . null $ r) $ - do li_ [id_ "aviatorratings"] $ + do li_ [id_ "aviatorratings"] $ do span_ [class_ "key"] "Ratings: " span_ [class_ "value"] . htmlRatings $ r @@ -260,10 +260,10 @@ htmlAviatorARN a htmlAviatorDob d htmlAviatorRatings r - + htmlAviatorShort :: Aviator - -> Html () + -> Html () htmlAviatorShort (Aviator s f a _ r) = do fromString f " " @@ -288,13 +288,15 @@ 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 _ (InCommandInstructing _) = + undefined htmlCommand _ (ICUS a) = do span_ [class_ "command incommandunderinstruction"] "In-Command Under-Instruction" span_ [class_ "commandphrase"] $ " by " @@ -310,7 +312,7 @@ htmlTimeAmountZero = htmlTimeAmountZeroWith id -htmlTimeAmountZeroWith :: +htmlTimeAmountZeroWith :: Monoid a => (Html () -> a) -> TimeAmount @@ -387,7 +389,7 @@ Time -> Html () htmlTime (Time t d) = - span_ [class_ "time"] $ + span_ [class_ "time"] $ do fromString (show t) htmlTimeOfDayTime d @@ -438,24 +440,24 @@ do span_ [class_ "key"] "Instrument: " span_ [class_ "value"] . htmlTimeAmount $ i - + htmlLocation :: Location -> Html () -htmlLocation (Location n t o) = - span_ [class_ "location"] $ +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')] + 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 @@ -469,7 +471,7 @@ String -> Html () htmlExamName n = - h3_ [class_ "examname"] $ + h3_ [class_ "examname"] $ fromString n htmlExam :: @@ -506,7 +508,7 @@ String -> Html () htmlBriefingName n = - h3_ [class_ "briefingname"] $ + h3_ [class_ "briefingname"] $ fromString n htmlBriefing :: @@ -537,7 +539,7 @@ String -> String space2dot = - (<$>) $ \c -> case c of + (<$>) $ \c -> case c of ' ' -> '.' _ -> c @@ -588,9 +590,9 @@ , show (e ^. briefingTime . daytime) ] in do a_ [id_ (Text.pack lk)] "" - a_ [href_ (Text.pack ('#' : lk))] . span_ [class_ "entrytag"] $ "BRF" + a_ [href_ (Text.pack ('#' : lk))] . span_ [class_ "entrytag"] $ "BRF" -htmlEntry :: +htmlEntry :: (AircraftFlight -> a -> Html x) -> (SimulatorFlight -> b -> Html x) -> (Exam -> c -> Html x) @@ -616,8 +618,8 @@ do div_ [] $ do htmlBriefing e briefingMeta' e ae - -htmlEntries :: + +htmlEntries :: (AircraftFlight -> a -> Html x) -> (SimulatorFlight -> b -> Html x) -> (Exam -> c -> Html x) @@ -666,14 +668,14 @@ htmlLogbookDocument aircraftFlightMeta' simulatorFlightMeta' examMeta' briefingMeta' reports' b = do doctype_ html_ [lang_ "en"] $ - do head_ $ + 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"] $ + 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 diff --git a/src/Data/Aviation/Casr/Logbook/Reports/FlightTimeReport.hs b/src/Data/Aviation/Casr/Logbook/Reports/FlightTimeReport.hs --- a/src/Data/Aviation/Casr/Logbook/Reports/FlightTimeReport.hs +++ b/src/Data/Aviation/Casr/Logbook/Reports/FlightTimeReport.hs @@ -8,28 +8,24 @@ ) where import Control.Category((.)) -import Control.Lens(makeClassy, (^.)) +import Control.Lens ( (^.), view, 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 - ) + ( Engine(Multi, Single), + TimeAmount, + Aviator, + HasAircraft(aircraftRegistration, aircraftType, aircraftEngine), + HasDayNight(nightDayNight, dayDayNight), + totalDayNight, + Command(InCommandInstructing, InCommand, Dual, ICUS), + HasAircraftFlight(instrumentflightTime, flightaircraft, command, + daynight), + Entry(AircraftFlightEntry), + Entries(Entries), + Logbook(Logbook), + HasInstructionRating(instructionRating), + getUnderInstructionPic, + isRAInstruction, + isGAInstruction ) import Data.Eq(Eq) import Data.Foldable(foldl') import Data.Int(Int) @@ -47,59 +43,65 @@ _flightsTotal :: Int , _hoursTotal :: - TimeAmount + TimeAmount , _hoursTotalICUS :: - TimeAmount + TimeAmount , _hoursTotalDual :: - TimeAmount + TimeAmount , _hoursTotalInCommand :: - TimeAmount + TimeAmount , _hoursInAircraftType :: Map String (TimeAmount, TimeAmount, TimeAmount, TimeAmount) , _hoursInAircraftRegistration :: Map String (TimeAmount, TimeAmount, TimeAmount, TimeAmount) , _hoursSingleEngine :: - TimeAmount + TimeAmount , _hoursSingleEngineICUS :: - TimeAmount - , _hoursSingleEngineDual :: - TimeAmount + TimeAmount + , _hoursSingleEngineDual :: + TimeAmount , _hoursSingleEngineInCommand :: - TimeAmount + TimeAmount , _hoursMultiEngine :: - TimeAmount + TimeAmount , _hoursMultiEngineICUS :: - TimeAmount + TimeAmount , _hoursMultiEngineDual :: - TimeAmount + TimeAmount , _hoursMultiEngineInCommand :: - TimeAmount + TimeAmount , _hoursDay :: - TimeAmount + TimeAmount , _hoursDayICUS :: - TimeAmount + TimeAmount , _hoursDayDual :: - TimeAmount + TimeAmount , _hoursDayInCommand :: - TimeAmount + TimeAmount + , _hoursInstructing :: + TimeAmount + , _hoursGAInstructing :: + TimeAmount + , _hoursRAInstructing :: + TimeAmount , _hoursNight :: - TimeAmount + TimeAmount , _hoursNightICUS :: - TimeAmount + TimeAmount , _hoursNightDual :: - TimeAmount + TimeAmount , _hoursNightInCommand :: - TimeAmount + TimeAmount , _hoursWithPiC :: Map Aviator TimeAmount , _hoursInstrument :: - TimeAmount + TimeAmount } deriving (Eq, Ord, Show) makeClassy ''FlightTimeReport instance Semigroup FlightTimeReport where - 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 <> 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 tl1 tli1 tld1 tlc1 tp1 rg1 se1 sei1 sed1 sec1 me1 mei1 med1 mec1 dy1 dyi1 dyd1 dyc1 ins1 insr1 insg1 nt1 nti1 ntd1 ntc1 wpc1 is1 <> FlightTimeReport ft2 tl2 tli2 tld2 tlc2 tp2 rg2 se2 sei2 sed2 sec2 me2 mei2 med2 mec2 dy2 dyi2 dyd2 dyc2 ins2 insr2 insg2 nt2 nti2 ntd2 ntc2 wpc2 is2 = FlightTimeReport (ft1 + ft2) (tl1 <> tl2) @@ -120,6 +122,9 @@ (dyi1 <> dyi2) (dyd1 <> dyd2) (dyc1 <> dyc2) + (ins1 <> ins2) + (insr1 <> insr2) + (insg1 <> insg2) (nt1 <> nt2) (nti1 <> nti2) (ntd1 <> ntd2) @@ -155,6 +160,9 @@ mempty mempty mempty + mempty + mempty + mempty mappend = (<>) @@ -171,6 +179,8 @@ mempty InCommand -> mempty + InCommandInstructing _ -> + mempty dual x = case fl ^. command of ICUS _ -> @@ -178,7 +188,9 @@ Dual _ -> x InCommand -> - mempty + mempty + InCommandInstructing _ -> + mempty comd x = case fl ^. command of ICUS _ -> @@ -187,8 +199,40 @@ mempty InCommand -> x + InCommandInstructing _ -> + mempty + instr x = + case fl ^. command of + ICUS _ -> + mempty + Dual _ -> + mempty + InCommand -> + mempty + InCommandInstructing _ -> + x + instrRA x = + case fl ^. command of + ICUS _ -> + mempty + Dual _ -> + mempty + InCommand -> + mempty + InCommandInstructing a -> + if isRAInstruction (view instructionRating a) then x else mempty + instrGA x = + case fl ^. command of + ICUS _ -> + mempty + Dual _ -> + mempty + InCommand -> + mempty + InCommandInstructing a -> + if isGAInstruction (view instructionRating a) then x else mempty hoursmap k = - Map.singleton k (hoursdaynight, (icus hoursdaynight), (dual hoursdaynight), (comd hoursdaynight)) + Map.singleton k (hoursdaynight, icus hoursdaynight, dual hoursdaynight, comd hoursdaynight) singleengine x = case fl ^. flightaircraft . aircraftEngine of Single -> @@ -206,7 +250,7 @@ totalhoursnight = fl ^. daynight . nightDayNight pic x = - case getInstructingPic (fl ^. command) of + case getUnderInstructionPic (fl ^. command) of Just a -> Map.singleton a x Nothing -> @@ -228,9 +272,12 @@ (multiengine (dual hoursdaynight)) (multiengine (comd hoursdaynight)) totalhoursday - (icus totalhoursday) - (dual totalhoursday) - (comd totalhoursday) + (icus hoursdaynight) + (dual hoursdaynight) + (comd hoursdaynight) + (instr hoursdaynight) + (instrRA hoursdaynight) + (instrGA hoursdaynight) totalhoursnight (icus totalhoursnight) (dual totalhoursnight) diff --git a/src/Data/Aviation/Casr/Logbook/Reports/Html.hs b/src/Data/Aviation/Casr/Logbook/Reports/Html.hs --- a/src/Data/Aviation/Casr/Logbook/Reports/Html.hs +++ b/src/Data/Aviation/Casr/Logbook/Reports/Html.hs @@ -28,47 +28,24 @@ 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.Aviation.Casr.Logbook.Reports + ( TakeOffLanding90(TakeOffLanding90), + SimulatorTimeReport, + FlightTimeReport, + HasSimulatorTimeReport(hoursTotalSimulator, + hoursInstrumentSimulator), + HasTakeOffLanding90(currency90, landing3, landing2, landing1, + takeoff3, takeoff2, takeoff1), + HasFlightTimeReport(hoursInstrument, hoursWithPiC, + hoursGAInstructing, hoursRAInstructing, hoursInstructing, + hoursNightInCommand, hoursNightDual, hoursNightICUS, hoursNight, + hoursDayInCommand, hoursDayDual, hoursDayICUS, hoursDay, + hoursMultiEngineInCommand, hoursMultiEngineDual, + hoursMultiEngineICUS, hoursMultiEngine, hoursSingleEngineInCommand, + hoursSingleEngineDual, hoursSingleEngineICUS, hoursSingleEngine, + hoursInAircraftRegistration, hoursInAircraftType, + hoursTotalInCommand, hoursTotalDual, hoursTotalICUS, hoursTotal, + flightsTotal) ) import Data.Foldable(foldr) import Data.Function(flip, ($)) import qualified Data.Map as Map(foldrWithKey) @@ -110,8 +87,8 @@ 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" + 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" @@ -178,8 +155,8 @@ 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" + 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: " @@ -187,7 +164,7 @@ li_ [] $ do span_ [class_ "key"] "Instrument Simulator Hours: " span_ [class_ "value"] . htmlTimeAmount $ r ^. hoursTotalSimulator - + htmlFlightTimeReport :: Logbook a b c d -> FlightTimeReport @@ -196,7 +173,7 @@ 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" + h3_ [class_ "flighttimereportname"] "Flight Time Summary Report" ul_ [] $ do li_ [] $ do span_ [class_ "key"] "Total Flights: " @@ -327,16 +304,29 @@ span_ [class_ "value"] . htmlTimeAmount $ r ^. hoursNightInCommand li_ [] $ + do span_ [class_ "key"] "Hours providing instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursInstructing + ul_ [] $ + do li_ [] $ + do span_ [class_ "key"] " RA instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursRAInstructing + li_ [] $ + do span_ [class_ "key"] "GA instruction: " + span_ [class_ "value"] . + htmlTimeAmount $ r ^. hoursGAInstructing + li_ [] $ do span_ [class_ "key"] "Hours with PiC: " div_ [class_ "value"] . ul_ [] . Map.foldrWithKey (\a t x -> do li_ [] $ - do span_ [class_ "key"] $ + do span_ [class_ "key"] $ do htmlAviatorShort a ": " - span_ [class_ "value"] . htmlTimeAmount $ t + span_ [class_ "value"] . htmlTimeAmount $ t x) mempty $ r ^. hoursWithPiC li_ [] $ do span_ [class_ "key"] "Hours instrument in-flight: " span_ [class_ "value"] . - htmlTimeAmount $ r ^. hoursInstrument + htmlTimeAmount $ r ^. hoursInstrument diff --git a/src/Data/Aviation/Casr/Logbook/Types.hs b/src/Data/Aviation/Casr/Logbook/Types.hs --- a/src/Data/Aviation/Casr/Logbook/Types.hs +++ b/src/Data/Aviation/Casr/Logbook/Types.hs @@ -20,3 +20,4 @@ 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 +import Data.Aviation.Casr.Logbook.Types.Instruction as L diff --git a/src/Data/Aviation/Casr/Logbook/Types/Command.hs b/src/Data/Aviation/Casr/Logbook/Types/Command.hs --- a/src/Data/Aviation/Casr/Logbook/Types/Command.hs +++ b/src/Data/Aviation/Casr/Logbook/Types/Command.hs @@ -4,11 +4,12 @@ module Data.Aviation.Casr.Logbook.Types.Command( Command(..) , AsCommand(..) -, getInstructingPic +, getUnderInstructionPic ) where import Control.Lens(makeClassyPrisms) import Data.Aviation.Casr.Logbook.Types.Aviator(Aviator) +import Data.Aviation.Casr.Logbook.Types.Instruction import Data.Eq(Eq) import Data.Maybe(Maybe(Just, Nothing)) import Data.Ord(Ord) @@ -18,16 +19,19 @@ ICUS Aviator | Dual Aviator | InCommand + | InCommandInstructing Instruction deriving (Eq, Ord, Show) makeClassyPrisms ''Command -getInstructingPic :: +getUnderInstructionPic :: Command -> Maybe Aviator -getInstructingPic (ICUS a) = +getUnderInstructionPic (ICUS a) = Just a -getInstructingPic (Dual a) = +getUnderInstructionPic (Dual a) = Just a -getInstructingPic InCommand = +getUnderInstructionPic InCommand = + Nothing +getUnderInstructionPic (InCommandInstructing _) = Nothing diff --git a/src/Data/Aviation/Casr/Logbook/Types/Instruction.hs b/src/Data/Aviation/Casr/Logbook/Types/Instruction.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Casr/Logbook/Types/Instruction.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Casr.Logbook.Types.Instruction where + +import Control.Lens ( makeClassyPrisms, isn't, makeClassy ) +import Data.Aviation.Casr.Logbook.Types.Aviator ( Aviator ) +import Data.Bool ( Bool, (&&) ) +import Data.Eq(Eq) +import Data.Functor ( Functor(fmap) ) +import Data.Maybe ( Maybe ) +import Data.Ord(Ord) +import Data.String(String) +import Prelude(Show) + +data InstructionLesson = + InstructionLesson { + _student :: Aviator + , _lesson :: Maybe String + } deriving (Eq, Ord, Show) + +makeClassy ''InstructionLesson + +data InstructionRating = + GA3InstructionRating + | GA2InstructionRating + | GA1InstructionRating + | RAInstructionRating + | RASIInstructionRating + deriving (Eq, Ord, Show) + +makeClassy ''InstructionRating +makeClassyPrisms ''InstructionRating + +isRAInstruction :: + AsInstructionRating a => + a + -> Bool +isRAInstruction x = + isn't _GA1InstructionRating x && + isn't _GA2InstructionRating x && + isn't _GA3InstructionRating x + +isGAInstruction :: + AsInstructionRating a => + a + -> Bool +isGAInstruction x = + isn't _RAInstructionRating x && + isn't _RASIInstructionRating x + +data Instruction = + Instruction { + __instructionLesson :: InstructionLesson + , __instructionWithRating :: InstructionRating + } deriving (Eq, Ord, Show) + +makeClassy ''Instruction + +instance HasInstructionLesson Instruction where + instructionLesson f (Instruction l r) = + fmap (`Instruction` r) (f l) + +instance HasInstructionRating Instruction where + instructionRating f (Instruction l r) = + fmap (Instruction l) (f r)