~jack/misc

093e7c102ccb3b5fd6ff3123c180a860153736da — Jack Kelly 4 months ago 60d61d1
Nixify cabinsheets
A cabinsheets/CHANGELOG.md => cabinsheets/CHANGELOG.md +5 -0
@@ 0,0 1,5 @@
# Revision history for cabinsheets

## 0.1.0.0 -- YYYY-mm-dd

* First version. Released on an unsuspecting world.

M cabinsheets/Cabinsheets.hs => cabinsheets/Cabinsheets.hs +42 -46
@@ 2,27 2,26 @@
-- Copyright (C) 2012  Jack Kelly
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <https://www.gnu.org/licenses/>.

import Control.Monad
import Data.Char
import qualified Data.Map as Map
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import Text.CSV
import Text.Html
import Text.CSV hiding (csv)
import Text.Html (Html, (!), (<<), (+++))
import qualified Text.Html as Html
import Text.ParserCombinators.Parsec.Error
import Text.Printf



@@ 30,9 29,9 @@ import Text.Printf
-- records of the form (Cabin, Bunk, Watch, Name). Watch names get
-- colorized, and the string "HOT BUNK" is rendered in purple.
data CabinEntry = CabinEntry {
      bunk :: String,
      watch :: String,
      name :: String
      _bunk :: String,
      _watch :: String,
      _name :: String
}

type CabinPlan = Map.Map String [CabinEntry]


@@ 42,26 41,25 @@ type CabinPlan = Map.Map String [CabinEntry]
trimCSV :: CSV -> CSV
trimCSV = noEmpty . trimRight . trimLeft where
    noEmpty = filter (/= [])
    trimRight = map $ reverse . (dropWhile (== "")) . reverse
    trimLeft csv = let margin = minimum
                                $ map length
                                $ map (takeWhile (== "")) csv in
                   map (drop margin) csv
    trimRight = map $ reverse . dropWhile (== "") . reverse
    trimLeft csv =
      let margin = minimum $ map (length . takeWhile (== "")) csv
      in map (drop margin) csv

-- Non-structural fixups on the CSV.
tidy :: CSV -> CSV
tidy = upper . trimCells where
    upper = map $ map $ map toUpper
    trimCells = map $ map $ (reverse . (dropWhile isSpace) . reverse)
    upper = map . map $ map toUpper
    trimCells = map . map $ reverse . dropWhile isSpace . reverse

-- Read the cabin plan into something useful.
parseCabinPlan :: CSV -> CabinPlan
parseCabinPlan = foldr addEntry Map.empty where
    addEntry [cabin, bunk, watch, name] =
        Map.insertWith (++) cabin [CabinEntry {
                                     bunk = bunk,
                                     watch = watch,
                                     Main.name = name
                                     _bunk = bunk,
                                     _watch = watch,
                                     _name = name
                                   }]
    addEntry _ = error "Malformed line in CSV"



@@ 74,48 72,46 @@ readCabinPlan file = do

-- Generate cabin sheet.
colorize :: String -> Html
colorize "RED" = (font << "RED") ! [color "red"]
colorize "BLUE" = (font << "BLUE") ! [color "blue"]
colorize "GREEN" = (font << "GREEN") ! [color "green"]
colorize "HOT BUNK" = (font << "HOT BUNK") ! [color "purple"]
colorize other = toHtml other
colorize "RED" = (Html.font << "RED") ! [Html.color Html.red]
colorize "BLUE" = (Html.font << "BLUE") ! [Html.color Html.blue]
colorize "GREEN" = (Html.font << "GREEN") ! [Html.color Html.green]
colorize "HOT BUNK" = (Html.font << "HOT BUNK") ! [Html.color Html.purple]
colorize other = Html.toHtml other

makeCabinSheet :: String -> [CabinEntry] -> String
makeCabinSheet cabin entries =
    doctype ++ (prettyHtml $ thehtml << (theHead +++ theBody)) where
    doctype ++ Html.prettyHtml (Html.thehtml << (theHead +++ theBody)) where
        doctype = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n"
        size = length entries
        smallCabin = size <= 5
        bigNames = any ((>= 15) . length . Main.name) entries
        bigNames = any ((>= 15) . length . _name) entries
        fontSize
            | smallCabin = "6"
            | bigNames   = "5"
            | otherwise  = "4"

        title = (printf "BUNK PLAN %s" cabin) :: String
        theHead = header << thetitle << title
        theH1 = (h1 << title) ! [align "center"]
        title = printf "BUNK PLAN %s" cabin :: String
        theHead = Html.header << Html.thetitle << title
        theH1 = (Html.h1 << title) ! [Html.align "center"]

        spacer = if smallCabin then iterate (br +++) br !! 3 else noHtml

        headingCell label = th
                            << center
                            << (font << underline << label) ! [color navy]
        headingCell label = Html.th
          << Html.center
          << (Html.font << Html.underline << label) ! [Html.color Html.navy]
        headingRow = foldl1 (+++) $ map headingCell ["BUNK", "WATCH", "NAME"]
        cell label = td << center << label
        row entry = tr << ((cell $ bunk entry)
                           +++ (cell $ colorize $ watch entry)
                           +++ (cell $ Main.name entry))
        cell label = Html.td << Html.center << label
        row entry = Html.tr << (cell (_bunk entry)
                           +++ cell (colorize $ _watch entry)
                           +++ cell (_name entry))
        theRows = map row entries
        theTable = (table << (headingRow +++ theRows)) ! [cellpadding 5,
                                                          cellspacing 40]
        content = center << ((font << bold << theTable)
                             ! [Text.Html.size fontSize])
        theBody = body << (theH1 +++ content)
        theTable = (Html.table << (headingRow +++ theRows))
          ! [Html.cellpadding 5, Html.cellspacing 40]
        content = Html.center << ((Html.font << Html.bold << theTable)
                             ! [Html.size fontSize])
        theBody = Html.body << (theH1 +++ content)

-- Turn the input filename into an output filename.
makeFileName :: FilePath -> String -> FilePath
makeFileName template name = (dropExtension template) ++ "-" ++ name ++ ".html"
makeFileName template name = dropExtension template ++ "-" ++ name ++ ".html"

printCabinSheet :: FilePath -> String -> [CabinEntry] -> IO ()
printCabinSheet template cabin entries =

A cabinsheets/Setup.hs => cabinsheets/Setup.hs +2 -0
@@ 0,0 1,2 @@
import Distribution.Simple
main = defaultMain

A cabinsheets/cabinsheets.cabal => cabinsheets/cabinsheets.cabal +25 -0
@@ 0,0 1,25 @@
cabal-version:       >=1.10

name:                cabinsheets
version:             0.1.0.0
synopsis:            Generate cabin sheets from a CSV
description:         Generate cabin sheets from a CSV.
license:             AGPL-3-or-later
license-file:        COPYING
author:              Jack Kelly
maintainer:          jack@jackkelly.name
copyright:           Copyright (C) 2012  Jack Kelly
category:            Application
build-type:          Simple
extra-source-files:  CHANGELOG.md, README

executable cabinsheets
  main-is:             Cabinsheets.hs
  build-depends:       base >=4.12 && <4.13
                     , containers >= 0.6.0.1 && < 0.7
                     , csv >= 0.1.2 && < 0.2
                     , filepath >= 1.4.2.1 && < 1.5
                     , html >= 1.0.1.2 && < 1.1
                     , parsec >= 3.1.13.0 && < 3.2
  default-language:    Haskell2010
  ghc-options:         -Wall -threaded

A cabinsheets/cabinsheets.nix => cabinsheets/cabinsheets.nix +15 -0
@@ 0,0 1,15 @@
{ mkDerivation, base, containers, csv, filepath, html, parsec
, stdenv
}:
mkDerivation {
  pname = "cabinsheets";
  version = "0.1.0.0";
  src = ./.;
  isLibrary = false;
  isExecutable = true;
  executableHaskellDepends = [
    base containers csv filepath html parsec
  ];
  description = "Generate cabin sheets from a CSV";
  license = stdenv.lib.licenses.agpl3Plus;
}

A cabinsheets/default.nix => cabinsheets/default.nix +15 -0
@@ 0,0 1,15 @@
{ nixpkgs ? import ../nix/nixpkgs.nix
, compiler ? "default"
, doBenchmark ? false
}:

let
  inherit (nixpkgs) pkgs;

  haskellPackages = if compiler == "default"
    then pkgs.haskellPackages
    else pkgs.haskell.packages.${compiler};

  variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id;
in
  variant (haskellPackages.callPackage ./cabinsheets.nix {})

A cabinsheets/shell.nix => cabinsheets/shell.nix +13 -0
@@ 0,0 1,13 @@
{ nixpkgs ? import ../nix/nixpkgs.nix
, compiler ? "default"
, doBenchmark ? false
}:
let
  inherit (nixpkgs) pkgs;
  env = (import ./. { inherit nixpkgs compiler doBenchmark; }).env;
in
  env.overrideAttrs (oldAttrs: {
    buildInputs = with pkgs.haskellPackages; oldAttrs.buildInputs ++ [
      cabal-install cabal2nix ghcid
    ];
  })