More basic modules for errors and parsers

12 files changed, 306 insertions, 11 deletions

diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..632651e
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,9 @@
+module Main where
+
+import Prolog
+import Hakyll
+import WWW.Base (baseHakyll, domain)
+
+main :: IO ()
+main = baseHakyll domain $ do
+    undefined
diff --git a/flake.lock b/flake.lock
new file mode 100644
index 0000000..b020c5b
--- /dev/null
+++ b/flake.lock
@@ -0,0 +1,76 @@
+{
+  "nodes": {
+    "flake-utils": {
+      "inputs": {
+        "systems": "systems"
+      },
+      "locked": {
+        "lastModified": 1731533236,
+        "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "nix-filter": {
+      "locked": {
+        "lastModified": 1731533336,
+        "narHash": "sha256-oRam5PS1vcrr5UPgALW0eo1m/5/pls27Z/pabHNy2Ms=",
+        "owner": "numtide",
+        "repo": "nix-filter",
+        "rev": "f7653272fd234696ae94229839a99b73c9ab7de0",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "nix-filter",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1735751299,
+        "narHash": "sha256-oebhj7Bb7TrF6A6TH9QbX2ucN5mRv3KpkLkQJjzcpkM=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "8dc007594783cee54e245399021bc509cd10e435",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "flake-utils": "flake-utils",
+        "nix-filter": "nix-filter",
+        "nixpkgs": "nixpkgs"
+      }
+    },
+    "systems": {
+      "locked": {
+        "lastModified": 1681028828,
+        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+        "owner": "nix-systems",
+        "repo": "default",
+        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nix-systems",
+        "repo": "default",
+        "type": "github"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}
diff --git a/flake.nix b/flake.nix
index 1405803..af28c99 100644
--- a/flake.nix
+++ b/flake.nix
@@ -22,11 +22,13 @@
       };
 
       devShells.default = pkgs.haskellPackages.shellFor {
-        packages = p: [ p.www-main ];
+        packages = _: [];
+        # packages = p: [ p.www-main ];
         withHoogle = true;
         buildInputs = with pkgs.haskellPackages; [
           cabal-install
           hpack
+          pkgs.zlib
         ];
       };
     });
diff --git a/nix/overlay.nix b/nix/overlay.nix
index c8ec384..82c1d72 100644
--- a/nix/overlay.nix
+++ b/nix/overlay.nix
@@ -17,7 +17,7 @@ in {
   site = prev.symlinkJoin {
     name = "site";
     paths = [
-      (final.haskell.lib.compose.justStaticExecutables final.haksellPackages.www-main)
+      (final.haskell.lib.compose.justStaticExecutables final.haskellPackages.www-main)
       prev.rsync
     ];
   };
diff --git a/package.yaml b/package.yaml
index c180a88..550010e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -37,6 +37,8 @@ default-extensions:
 library:
   source-dirs: src
   dependencies:
+    - comonad
+    - bibtex
     - binary
     - blaze-html
     - bytestring
@@ -44,13 +46,13 @@ library:
     - filepath
     - hakyll
     - HaTeX
-    - latex-formulae-hakyll
     - mtl
     - network-uri
     - pandoc
     - parsec
+    - process
     - string-conv
-    - system
+    # - system
     - text
     - uri-encode
 
diff --git a/src/Hakyll/Error.hs b/src/Hakyll/Error.hs
new file mode 100644
index 0000000..3ca29d3
--- /dev/null
+++ b/src/Hakyll/Error.hs
@@ -0,0 +1,70 @@
+module Hakyll.Error
+    ( ErrorConv (..)
+    , throwErr
+    , CompilerError
+    ) where
+
+import Prolog
+import Text.Parsec.Error
+
+class ErrorConv c err where
+    toErr :: c -> err
+
+type CompilerError c = ErrorConv c [String]
+
+instance ErrorCnv err err where
+    toErr = id
+
+-- instance Functor f => ErrorCnv c err => ErrorCnv (f c) (f err) where
+--     toErr = fmap toErr
+
+instance Applicative f => ErrorCnv c err => ErrorCnv c (f err) where
+    toErr = pure . toErr
+
+throwErr :: (MonadError err m, ErrorConv c err) => c -> m a
+throwErr = throwError . toErr
+
+liftErr :: (MonadError err m, ErrorConv c err) => Either c a -> m a
+liftErr = either throwErr pure
+
+squashErr :: (MonadError err m, ErrorConv c err) => m (Either c a) -> m a
+squashErr = (>>= liftErr)
+
+instance ErrorConv Message String where
+    toErr = messageString
+
+instance ErrorConv ParseError [String] where
+    toErr = fmap messageString . errorMessages
+
+
+-- class CompilerError c where
+--     toCompilerError :: c -> [String]
+--     default toCompilerError :: Exception c => c -> [String]
+--     toCompilerError = pure . displayException
+
+--     toCompilerErrors :: [c] -> [String]
+--     toCompilerErrors = (>>= toCompilerError)
+
+-- instance CompilerError c => CompilerError [c] where
+--     toCompilerError = toCompilerErrors
+
+
+-- throwCompilerError :: (MonadError [String] m, CompilerError c) => c -> m a
+-- throwCompilerError = throwError . toCompilerError
+
+-- liftCompilerError :: (MonadError [String] m, CompilerError c) => Either c a -> m a
+-- liftCompilerError = either throwError pure
+
+-- squashCompilerError :: (MonadError [String] m, CompilerError c) => m (Either c a) -> m a
+-- squashCompilerError = (>>= liftCompilerError)
+
+-- instance CompilerError Char where
+--     toCompilerError = pure . pure
+--     toCompilerErrors = pure
+
+-- instance CompilerError Message where
+--     toCompilerError = pure . messageString
+--     toCompilerErrors = fmap messageString
+
+-- instance CompilerError ParseError where
+--     toCompilerError = toCompilerErrors . errorMessages
diff --git a/src/Hakyll/Parsec/Parsec.hs b/src/Hakyll/Parsec/Parsec.hs
new file mode 100644
index 0000000..cac653c
--- /dev/null
+++ b/src/Hakyll/Parsec/Parsec.hs
@@ -0,0 +1,20 @@
+module Hakyll.Parsec.Parsec
+    ( compileParsec
+    , compileParsec_
+    , evalParsec
+    ) where
+
+import Prolog
+import Hakyll
+import Text.Parsec
+import Text.Parsec.Error
+import Hakyll.Error
+
+-- evalParsec :: (MonadError [String] m) => Either ParseError a -> m a
+-- evalParsec = either (throwError . fmap messageString . errorMessages) pure
+
+compileParsec :: (MonadError [String] m, Stream s Identity t) => Parsec s u a -> u -> Item s -> m (Item a)
+compileParsec p u itm@(Item i _) = traverse (liftErr . runParser p u (show i)) itm
+
+compileParsec_ :: (MonadError [String] m, Stream s Identity t) => Parsec s () a -> Item s -> m (Item a)
+compileParsec_ p = compileParsec p ()
diff --git a/src/Hakyll/TeX/BibTeX.hs b/src/Hakyll/TeX/BibTeX.hs
index b085dfa..434ca54 100644
--- a/src/Hakyll/TeX/BibTeX.hs
+++ b/src/Hakyll/TeX/BibTeX.hs
@@ -13,7 +13,8 @@ import Text.BibTeX.Entry qualified as B
 import Text.BibTeX.Format qualified as B
 import Text.BibTeX.Parse qualified as B
 import Text.Parsec qualified as P
-import Text.Parsec.Error qualified as P
+
+import Hakyll.Parsec.Parsec
 
 type BibTeX = B.T
 
@@ -28,7 +29,7 @@ instance Writable [B.T] where
 
 
 compileBibtex :: (StringConv s String) => Item s -> Compiler (Item [B.T])
-compileBibtex (Item i b) = either (throwError . fmap P.messageString . P.errorMessages) (pure . Item i) $ P.parse p (show i) (toSL b)
+compileBibtex = compileParsec_ p . fmap toSL
     where
         p = B.skippingLeadingSpace $ B.file <* P.eof
 
diff --git a/src/Hakyll/TeX/HaTeX.hs b/src/Hakyll/TeX/HaTeX.hs
index 9b83c62..c71ad09 100644
--- a/src/Hakyll/TeX/HaTeX.hs
+++ b/src/Hakyll/TeX/HaTeX.hs
@@ -6,10 +6,12 @@ module Hakyll.TeX.HaTeX
 import Prolog
 
 import Hakyll
+import Hakyll.Error
+-- import Hakyll.Parsec.Parsec
 import Text.LaTeX.Base.Parser
 
-compileHatex :: (StringConv s Text, Traversable t) => t s -> Compiler (t LaTeX)
-compileHatex = traverse $ either (throwError . fmap messageString . errorMessages) pure . parseLaTeX . toSL
+compileHatex :: (StringConv s Text, Traversable t, MonadError [String] m) => t s -> m (t LaTeX)
+compileHatex = traverse $ liftErr . parseLaTeX . toSL
 
 hatexCompiler :: Compiler (Item LaTeX)
 hatexCompiler = getResourceLBS >>= compileHatex
diff --git a/src/Hakyll/TeX/LaTeX.hs b/src/Hakyll/TeX/LaTeX.hs
index 8f6d5cc..66f3ba5 100644
--- a/src/Hakyll/TeX/LaTeX.hs
+++ b/src/Hakyll/TeX/LaTeX.hs
@@ -8,11 +8,11 @@ import Prolog
 
 import Hakyll
 
-rubberPipe :: [String] -> LazyByteString -> Compiler LazyByteString
-rubberPipe = unixFilterLBS "rubber-pipe"
+rubberPipe :: (StringConv s LazyByteString) => [String] -> s -> Compiler LazyByteString
+rubberPipe args = unixFilterLBS "rubber-pipe" args . toSL
 
 compileLatexPdf :: (StringConv s LazyByteString, Traversable t) => t s -> Compiler (t LazyByteString)
-compileLatexPdf = traverse $ rubberPipe [ "--pdf" ] . toSL
+compileLatexPdf = traverse $ rubberPipe [ "--pdf" ]
 
 latexPdfCompiler :: Compiler (Item LazyByteString)
 latexPdfCompiler = getResourceLBS >>= compileLatexPdf
diff --git a/src/Prolog.hs b/src/Prolog.hs
index 70545c9..a688063 100644
--- a/src/Prolog.hs
+++ b/src/Prolog.hs
@@ -36,18 +36,22 @@ module Prolog
     , toSL
     , convS
     , convSL
+    , renderTo
+    , fromStringlike
     -- * Utils
     , (<<$>>)
     , (<<<$>>>)
     , (<<&>>)
     , (-->)
     , (-/>)
+    , (>>=?)
     , foreach
     , liftMaybe
     , squashMaybe
     ) where
 
 import Control.Applicative
+import Control.Comonad
 import Control.Monad
 import Control.Monad.Catch
 import Control.Monad.Except
@@ -110,6 +114,12 @@ infixr 0 -/>
 (-/>) = (-->) . fmap not
 {-# INLINE (-/>) #-}
 
+(>>=?) :: (Monad m, Monoid w) => m (Maybe a) -> (a -> m w) -> m w
+infixl 1 >>=?
+x >>=? f = x >>= maybe (pure mempty) f
+{-# INLINE (>>=?) #-}
+
+
 liftMaybe :: Alternative m => Maybe a -> m a
 liftMaybe = maybe empty pure
 {-# INLINE liftMaybe #-}
@@ -118,6 +128,13 @@ squashMaybe :: Alternative m => m (Maybe a) -> m a
 squashmaybe = (>>= liftMaybe)
 {-# INLINE squashMaybe #-}
 
+renderTo :: (StringConv T.Text s, L.Render r) => r -> s
+renderTo = toSL . L.render
+{-# INLINE renderTo #-}
+
+fromStringlike :: (IsString s, StringConv t String) => t -> s
+fromStringlike = fromString . toSL
+{-# INLINE fromStringlike #-}
 
 -- Orphan instances
 
@@ -134,6 +151,9 @@ instance H.Writable L.LaTeX where
 instance Contravariant H.Context where
     contramap f (H.Context c) = H.Context $ \x xs -> c x xs . fmap f
 
+instance Comonad H.Item where
+    extract = H.itemBody
+    duplicate = join (<$)
 
 instance StringConv L.LaTeX T.Text where
     strConv _ = L.render
diff --git a/www-main.cabal b/www-main.cabal
new file mode 100644
index 0000000..4f84d0a
--- /dev/null
+++ b/www-main.cabal
@@ -0,0 +1,93 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.36.1.
+--
+-- see: https://github.com/sol/hpack
+
+name:           www-main
+version:        0.1.0.0
+author:         Chris Wells
+maintainer:     chris@mathematicaster.org
+copyright:      2024 Chris Wells
+license:        MIT
+build-type:     Simple
+
+library
+  exposed-modules:
+      Hakyll.Core.Identifier.Pattorn
+      Hakyll.Error
+      Hakyll.Parsec.Parsec
+      Hakyll.TeX.BibTeX
+      Hakyll.TeX.HaTeX
+      Hakyll.TeX.LaTeX
+      Hakyll.TeX.TikZ
+      Prolog
+      WWW.Base
+      WWW.HW
+  other-modules:
+      Paths_www_main
+  hs-source-dirs:
+      src
+  default-extensions:
+      BangPatterns
+      DeriveGeneric
+      DeriveLift
+      DerivingStrategies
+      DefaultSignatures
+      FunctionalDependencies
+      GADTs
+      LambdaCase
+      MultiWayIf
+      OverloadedStrings
+      PatternSynonyms
+      TypeFamilies
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      HaTeX
+    , base >=4.7 && <5
+    , bibtex
+    , binary
+    , blaze-html
+    , bytestring
+    , comonad
+    , email-validate
+    , filepath
+    , hakyll
+    , mtl
+    , network-uri
+    , pandoc
+    , parsec
+    , process
+    , string-conv
+    , text
+    , uri-encode
+  default-language: GHC2021
+
+executable site
+  main-is: Main.hs
+  other-modules:
+      Paths_www_main
+  hs-source-dirs:
+      app
+  default-extensions:
+      BangPatterns
+      DeriveGeneric
+      DeriveLift
+      DerivingStrategies
+      DefaultSignatures
+      FunctionalDependencies
+      GADTs
+      LambdaCase
+      MultiWayIf
+      OverloadedStrings
+      PatternSynonyms
+      TypeFamilies
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded
+  build-depends:
+      base >=4.7 && <5
+    , hakyll
+    , hakyll-images
+    , hakyll-sass
+    , hjsmin
+    , www-main
+  default-language: GHC2021