casr-logbook-meta-html (empty) → 0.0.1
raw patch · 6 files changed
+660/−0 lines, 6 filesdep +QuickCheckdep +basedep +casr-logbookbuild-type:Customsetup-changed
Dependencies added: QuickCheck, base, casr-logbook, casr-logbook-meta, directory, doctest, filepath, lens, lucid, template-haskell, text
Files
- LICENSE +27/−0
- Setup.lhs +44/−0
- casr-logbook-meta-html.cabal +77/−0
- changelog +4/−0
- src/Data/Aviation/Casr/Logbook/Meta/Html.hs +476/−0
- test/doctests.hs +32/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2016 Tony Morris+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions, the following disclaimer and the following SHA-512 checksum.++2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions, the following disclaimer and the following SHA-512+checksum in the documentation and/or other materials provided with the+distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++THIS SOFTWARE IS PROVIDED WITH A SHA-512 CHECKSUM.+ecdfdf543fd166b13b76b11e0b010e00d693028771880ffd8f9252ae0b8ac42bddf8eb7a23c21c86a3b50039d642ad9eeb7e8a0e82f6a345f60feb4a54808362
+ Setup.lhs view
@@ -0,0 +1,44 @@+#!/usr/bin/env runhaskell+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Verbosity ( Verbosity )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+ { buildHook = \pkg lbi hooks flags -> do+ generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+ buildHook simpleUserHooks pkg lbi hooks flags+ }++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+ let dir = autogenModulesDir lbi+ createDirectoryIfMissingVerbose verbosity True dir+ withLibLBI pkg lbi $ \_ libcfg -> do+ withTestLBI pkg lbi $ \suite suitecfg -> do+ rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+ [ "module Build_" ++ testName suite ++ " where"+ , "deps :: [String]"+ , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+ ]+ where+ formatdeps = map (formatone . snd)+ formatone p = case packageName p of+ PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}
+ casr-logbook-meta-html.cabal view
@@ -0,0 +1,77 @@+name: casr-logbook-meta-html+version: 0.0.1+license: OtherLicense+license-file: LICENSE+author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+maintainer: Tony Morris+copyright: Copyright (C) 2016 Tony Morris+synopsis: Meta-information about entries in a CASR 61.345 logbook (casr-logbook) HTML output+category: Aviation+description: + <<https://i.imgur.com/p6LT40r.png>>+ .+ CASR 61.345 Pilot Personal Logbook Meta-information about entries HTML output+ .+ <<https://i.imgur.com/Lfhcmtg.png>>++homepage: https://github.com/tonymorris/casr-logbook-meta-html+bug-reports: https://github.com/tonymorris/casr-logbook-meta-html/issues+cabal-version: >= 1.10+build-type: Custom+extra-source-files: changelog++source-repository head+ type: git+ location: git@github.com:tonymorris/casr-logbook-meta-html.git++flag small_base+ description: Choose the new, split-up base package.++library+ default-language:+ Haskell2010++ build-depends:+ base < 5 && >= 4.8+ , casr-logbook >= 0.1.3 && < 0.2+ , casr-logbook-meta >= 0.0.2 && < 0.2+ , lucid >= 2.9 && < 3+ , lens >= 4.1 && < 5+ , text >= 1.2 && < 1.3++ ghc-options:+ -Wall++ default-extensions:+ NoImplicitPrelude++ hs-source-dirs:+ src++ exposed-modules:+ Data.Aviation.Casr.Logbook.Meta.Html++test-suite doctests+ type:+ exitcode-stdio-1.0++ main-is:+ doctests.hs++ default-language:+ Haskell2010++ build-depends:+ base < 5 && >= 3+ , doctest >= 0.9.7+ , filepath >= 1.3+ , directory >= 1.1+ , QuickCheck >= 2.0+ , template-haskell >= 2.8++ ghc-options:+ -Wall+ -threaded++ hs-source-dirs:+ test
+ changelog view
@@ -0,0 +1,4 @@+0.0.1++* Initial release+
+ src/Data/Aviation/Casr/Logbook/Meta/Html.hs view
@@ -0,0 +1,476 @@+{-# 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+ , aircraftUsageCost+ , briefingCost+ , simulatorFlightCost+ , showCentsAsDollars+ , showThousandCentsAsDollars+ , showHundredCentsAsDollars+ , whenEmpty +) where++import Control.Category((.), id)+import Control.Lens((^.))+import Control.Monad(when)+import Data.Aviation.Casr.Logbook (+ instrumentsimulatorTime+ , timeAmountBy10+ , briefingTimeAmount+ , daynight+ , totalDayNight+ , AircraftFlight+ , SimulatorFlight+ , Briefing+ , Exam+ , HasSimulatorFlight+ , HasAircraftFlight+ , HasBriefing+ )+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)+ , SimulatorFlightExpense(SimulatorFlightExpense)+ , SimulatorFlightMeta(SimulatorFlightMeta)+ , TrackLog(TrackLog)+ , TrackLogType(Gpx, Kml, Kmz, ImageTrackLog)+ , Video(Video)+ , VideoType(YouTube, Vimeo, Bambuser)+ , Visualisation(Doarama)+ , linkVideoType+ ) +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++htmlAircraftFlightMeta ::+ AircraftFlight+ -> AircraftFlightMeta+ -> Html ()+htmlAircraftFlightMeta fl (AircraftFlightMeta tls vls ims vds exs) =+ div_ $ + do htmlTrackLogs fl tls+ htmlVisualisations fl vls+ htmlImages fl ims+ htmlVideos fl vds+ htmlAircraftFlightExpenses fl exs++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++----++aircraftUsageCost ::+ HasAircraftFlight s =>+ s+ -> AircraftUsageExpense+ -> Int+aircraftUsageCost fl (AircraftUsageExpense perhour _) =+ let z = totalDayNight (fl ^. daynight)+ in timeAmountBy10 z * perhour++briefingCost ::+ HasBriefing s =>+ s+ -> BriefingExpense+ -> Int+briefingCost br (BriefingExpense perhour _) =+ let z = br ^. briefingTimeAmount+ in timeAmountBy10 z * perhour++simulatorFlightCost ::+ HasSimulatorFlight s =>+ s+ -> SimulatorFlightExpense+ -> Int+simulatorFlightCost sf (SimulatorFlightExpense perhour _) =+ let z = sf ^. instrumentsimulatorTime+ in timeAmountBy10 z * perhour++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
+ test/doctests.hs view
@@ -0,0 +1,32 @@+module Main where++import Build_doctests (deps)+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest++main ::+ IO ()+main =+ getSources >>= \sources -> doctest $+ "-isrc"+ : "-idist/build/autogen"+ : "-optP-include"+ : "-optPdist/build/autogen/cabal_macros.h"+ : "-hide-all-packages"+ : map ("-package="++) deps ++ sources++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "src"+ where+ go dir = do+ (dirs, files) <- getFilesAndDirectories dir+ (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+ c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+ (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c