diff --git a/make-pages/Main.hs b/make-pages/Main.hs index b62e1dc..6c06e20 100644 --- a/make-pages/Main.hs +++ b/make-pages/Main.hs @@ -8,7 +8,6 @@ import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.IO as Text import System.IO (hPrint, stderr) import System.FilePath (makeRelative) -import Text.Printf (printf) import Control.Monad import Options @@ -23,17 +22,24 @@ import qualified Text.PrettyPrint as PP type HasVerbose = (?verbose :: Bool) +withVerbose :: Bool -> (HasVerbose => a) -> a +withVerbose v x = let ?verbose = v in x + +printV :: (Show a, HasVerbose) => a -> IO () +printV x = when ?verbose $ hPrint stderr x + + main :: IO () main = do opts@(Options {verbose, mode}) <- parseOptions - let ?verbose = verbose - printV $ "options" :- opts - main2 mode + withVerbose verbose do + printV $ "options" := opts + main2 mode main2 :: HasVerbose => ModeOptions -> IO () main2 (SinglePage {file, nsfw, output}) = do info <- readYAML file - printV $ "contents" :- info + printV $ "contents" := info let page = make nsfw info writeOutput output page @@ -42,15 +48,15 @@ main2 (GalleryPage {}) = do main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do info <- readYAML file - printV $ "contents" :- info + printV $ "contents" := info let path = makeRelative dataDir file - printV $ "path" :- path + printV $ "path" := path let deps = dependSingle path info prefix buildDir nsfw writeOutput output deps +main2 (DependGallery {}) = do + error "surprise! this doesn't exist yet" -printV :: (Show a, HasVerbose) => a -> IO () -printV x = when ?verbose $ hPrint stderr x readYAML :: YAML.FromYAML a => FilePath -> IO a readYAML file = ByteString.readFile file >>= decode1Must file @@ -59,17 +65,18 @@ decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a decode1Must file txt = case YAML.decode1 txt of Right val -> pure val - Left (YAML.Pos {posLine, posColumn}, err) -> - fail $ printf "%s:%i:%i: %s" file posLine posColumn err + Left (pos, err) -> + fail $ file ++ ":" ++ YAML.prettyPosWithSource pos txt " error:" ++ err writeOutput :: Maybe FilePath -> Text -> IO () writeOutput (Just f) = Text.writeFile f writeOutput Nothing = Text.putStrLn -data Tag a = String :- a + +data Tag a = String := a instance Show a => Show (Tag a) where - show (tag :- a) = + show (tag := a) = #ifdef PRETTY_VERBOSE PP.render $ PP.hang (PP.text tag <> ":") 2 (PP.ppDoc a) #else diff --git a/make-pages/make-pages.cabal b/make-pages/make-pages.cabal index 33a9e65..49c115d 100644 --- a/make-pages/make-pages.cabal +++ b/make-pages/make-pages.cabal @@ -34,6 +34,7 @@ executable make-pages OverloadedStrings, PatternSynonyms, QuasiQuotes, + RankNTypes, TypeSynonymInstances, ViewPatterns build-depends: