diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | flake.nix | 4 | ||||
| -rw-r--r-- | nix/overlay.nix | 1 | ||||
| -rw-r--r-- | package.yaml | 4 | ||||
| -rw-r--r-- | src/Data/Name.hs | 76 | ||||
| -rw-r--r-- | src/Data/Person.hs | 31 | ||||
| -rw-r--r-- | src/Hakyll/TeX/BibTeX.hs | 2 | ||||
| -rw-r--r-- | src/Prolog.hs | 28 | ||||
| -rw-r--r-- | src/WWW/HW.hs | 2 | ||||
| -rw-r--r-- | www-main.cabal | 5 | ||||
| -rw-r--r-- | www/teaching/index.md | 2 |
11 files changed, 148 insertions, 8 deletions
@@ -1,3 +1,4 @@ dist-newstyle/* result .direnv +.cache/* @@ -17,8 +17,8 @@ }; in { packages = { - inherit (pkgs) site; - default = pkgs.site; + inherit (pkgs) www-main; + default = pkgs.www-main; }; devShells.default = pkgs.haskellPackages.shellFor { diff --git a/nix/overlay.nix b/nix/overlay.nix index 8c6baf4..150cafb 100644 --- a/nix/overlay.nix +++ b/nix/overlay.nix @@ -6,6 +6,7 @@ final: prev: let ../app ../src ../package.yaml + ../templates # ../www-main.cabal ]; }; diff --git a/package.yaml b/package.yaml index 8eee7f6..69298f2 100644 --- a/package.yaml +++ b/package.yaml @@ -41,6 +41,7 @@ library: - bibtex - binary - blaze-html + - blaze-markup - bytestring - email-validate - exceptions @@ -55,12 +56,11 @@ library: - process - slugger - string-conv - # - system - text - uri-encode executables: - site: + www-main: main: Main.hs source-dirs: app ghc-options: diff --git a/src/Data/Name.hs b/src/Data/Name.hs new file mode 100644 index 0000000..9572709 --- /dev/null +++ b/src/Data/Name.hs @@ -0,0 +1,76 @@ +module Data.Name + ( Name (..) + , Name_ + -- * Parsers + , readNameLFM + , readNameFML + -- * Writers + , renderNameLFM + , renderNameFML + ) where + +import Prolog +import Data.Char (isSpace) +import Data.List qualified as L +import Data.Text qualified as T + + +data Name a = Name + { lastName :: !a + , firstName :: !a + , middleName :: !(Maybe a) + } deriving (Eq, Functor, Foldable, Generic, Generic1, Ord, Show, Traversable) + +type Name_ = Name StrictText + +instance Binary a => Binary (Name a) + +instance Applicative Name where + pure a = Name a a (pure a) + Name l f m <*> Name l' f' m' = Name (l l') (f f') (m <*> m') + + +readNameLFM :: Alternative m => StrictText -> m Name_ +readNameLFM t = T.map (\c -> if c == '~' then ' ' else c) <<$>> + case T.break (== ',') t of + (l, fm) + | T.null l -> empty + | otherwise -> case T.dropWhile ((||) <$> isSpace <*> (== ',')) fm of + fm' + | T.null fm' -> empty + | otherwise -> case T.break isSpace fm' of + (f, m) -> pure $ Name l f $ case T.dropWhile isSpace m of + x | T.null x -> Nothing + | otherwise -> Just x + +readNameFML :: Alternative m => StrictText -> m Name_ +readNameFML t = T.map (\c -> if c == '~' then ' ' else c) <<$>> + case T.words t of + [] -> empty + (f:xs) -> case unsnoc xs of + Nothing -> empty + Just (m, l) -> pure $ Name f l $ case m of + [] -> Nothing + _ -> Just $ T.unwords m + +showNameLFM :: Name_ -> StrictText +showNameLFM (Name l f m) = stt l <> ", " <> stt f <> maybe "" (\x -> " " <> stt x) m + +showNameFML :: Name_ -> StrictText +showNameFML (Name l f m) = stt f <> maybe " " (\x -> " " <> stt x <> " ") m <> stt l + +renderNameLFM :: (Semigroup a, IsString a) => Name a -> a +renderNameLFM (Name l f m) = l <> ", " <> f <> maybe "" (\x -> " " <> x) m + +renderNameFML :: (Semigroup a, IsString a) => Name a -> a +renderNameFML (Name l f m) = f <> maybe " " (\x -> " " <> x <> " ") m <> l + +-- Helpers + +unsnoc :: [a] -> Maybe ([a],a) +unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing +{-# INLINABLE unsnoc #-} + +stt :: StrictText -> StrictText +stt = T.map $ \c -> if isSpace c then '~' else c +{-# INLINABLE stt #-} diff --git a/src/Data/Person.hs b/src/Data/Person.hs new file mode 100644 index 0000000..a649c07 --- /dev/null +++ b/src/Data/Person.hs @@ -0,0 +1,31 @@ +module Data.Person + ( Person (..) + , personHtml + , personFromName + , Name (..) + , URI + ) where + +import Prolog +import Data.Name +import Network.URI (URI) +import Text.Blaze +import Text.Blaze.Html +import Text.Blaze.Html5 (a) +import Text.Blaze.Html5.Attributes (href) + +data Person a = Person + { name :: !(Name a) + , webpage :: !(Maybe URI) + , aliases :: ![Name a] + } deriving (Eq, Functor, Foldable, Generic, Ord, Show, Traversable) + +instance Binary a => Binary (Person a) + +personHtml :: (ToMarkup a) => Person a -> Html +personHtml (Person n w _) = + let withLink = maybe id (\x -> a ! href (toValue x)) w + in withLink $ renderNameFML $ toMarkup <$> n + +personFromName :: Name a -> Person a +personFromName n = Person n Nothing [n] diff --git a/src/Hakyll/TeX/BibTeX.hs b/src/Hakyll/TeX/BibTeX.hs index ddf9166..a3adce7 100644 --- a/src/Hakyll/TeX/BibTeX.hs +++ b/src/Hakyll/TeX/BibTeX.hs @@ -33,7 +33,7 @@ instance Writable [B.T] where compileBibtex :: (StringConv s String) => Item s -> Compiler (Item BibTeX) compileBibtex = compileParsec_ p . fmap toSL where - p = B.skippingLeadingSpace $ B.file <* P.eof + p = B.skippingLeadingSpace $ B.file <* P.space <* P.eof bibtexCompiler :: Compiler (Item BibTeX) bibtexCompiler = getResourceBody >>= compileBibtex diff --git a/src/Prolog.hs b/src/Prolog.hs index 4b3c666..a6ac1b5 100644 --- a/src/Prolog.hs +++ b/src/Prolog.hs @@ -21,6 +21,7 @@ module Prolog -- * Types , Binary , Generic + , Generic1 , Generically (..) , MonadThrow (..) , Exception (..) @@ -76,8 +77,10 @@ import Data.String.Conv import Data.Text qualified as T import Data.Text.Lazy qualified as TL import GHC.Generics +import Network.URI import Hakyll qualified as H +import Text.Blaze import Text.Blaze.Html import Text.Blaze.Html.Renderer.Pretty as BS import Text.Blaze.Html.Renderer.Text as BT @@ -147,6 +150,8 @@ instance Binary L.MathType instance Binary L.Measure instance Binary L.TeXArg instance Binary L.LaTeX +instance Binary URIAuth +instance Binary URI instance H.Writable L.LaTeX where write p = L.renderFile p . H.itemBody @@ -188,3 +193,26 @@ instance StringConv Html B.ByteString where instance StringConv Html BL.ByteString where strConv _ = BB.renderHtml + +instance StringConv URI String where + strConv _ = show + +instance StringConv URI T.Text where + strConv l = strConv l . show + +instance StringConv URI TL.Text where + strConv l = strConv l . show + +instance StringConv URI B.ByteString where + strConv l = strConv l . show + +instance StringConv URI BL.ByteString where + strConv l = strConv l . show + +instance ToMarkup URI where + toMarkup = toMarkup . show + preEscapedToMarkup = preEscapedToMarkup . show + +instance ToValue URI where + toValue = toValue . show + preEscapedToValue = preEscapedToValue . show diff --git a/src/WWW/HW.hs b/src/WWW/HW.hs index 0740fe6..aaa8b3f 100644 --- a/src/WWW/HW.hs +++ b/src/WWW/HW.hs @@ -3,7 +3,7 @@ module WWW.HW , removeSolutions ) where -import Prolog +-- import Prolog import Text.LaTeX.Base.Syntax diff --git a/www-main.cabal b/www-main.cabal index adbb3f5..688bdeb 100644 --- a/www-main.cabal +++ b/www-main.cabal @@ -14,6 +14,8 @@ build-type: Simple library exposed-modules: + Data.Name + Data.Person Hakyll.Core.Identifier.Pattorn Hakyll.Error Hakyll.Parsec @@ -51,6 +53,7 @@ library , bibtex , binary , blaze-html + , blaze-markup , bytestring , comonad , email-validate @@ -69,7 +72,7 @@ library , uri-encode default-language: GHC2021 -executable site +executable www-main main-is: Main.hs other-modules: Paths_www_main diff --git a/www/teaching/index.md b/www/teaching/index.md index 89682cd..5565d24 100644 --- a/www/teaching/index.md +++ b/www/teaching/index.md @@ -66,7 +66,7 @@ Fall 2015 ## Iowa State University (2014--2015) Spring 2015 -* **Math 267: Elementary Differential Equations and Laplace Transforms** (TA for Steve Butler) +* **Math 267: Elementary Differential Equations and Laplace Transforms** (TA for Miriam Castillo-Gil) Fall 2014 * **Math 165: Calculus I** (TA for Heather Bolles) |