fiddle with verbose stuff

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
+  withVerbose verbose do
-  printV $ "options" :- opts
+    printV $ "options" := opts
-  main2 mode
+    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) ->
+    Left (pos, err) ->
-      fail $ printf "%s:%i:%i: %s" file posLine posColumn 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

make-pages/make-pages.cabal

@@ -34,6 +34,7 @@ executable make-pages
     OverloadedStrings,
     PatternSynonyms,
     QuasiQuotes,
+    RankNTypes,
     TypeSynonymInstances,
     ViewPatterns
   build-depends: