a lot of stylin and a little scriptin

make-pages/Info.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fdefer-typed-holes #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 module Info
   (Info (..), Artist (..), Image (..), Link (..),
@@ -27,11 +28,11 @@ data Info =
     date        :: !Day,
     title       :: !(Maybe Text),
     artist      :: !(Maybe Artist), -- nothing = me, obv
-    warning     :: !(Maybe Text),
     tags        :: ![Text],
     nsfwTags    :: ![Text],
     description :: !(Maybe Text),
     images      :: ![Image],
+    background  :: !(Maybe Text),
     thumb'      :: !(Maybe FilePath),
     links       :: ![Link]
   }
@@ -46,9 +47,10 @@ data Artist =
 
 data Image =
   Image {
-    label :: !Text,
-    path  :: !FilePath,
-    nsfw  :: !Bool
+    label   :: !Text,
+    path    :: !FilePath,
+    nsfw    :: !Bool,
+    warning :: !(Maybe Text)
   }
   deriving (Eq, Show)
 
@@ -80,11 +82,11 @@ instance FromYAML Info where
     Info <$> m .:  "date"
          <*> m .:? "title"
          <*> m .:? "artist"
-         <*> m .:? "warning"
          <*> m .:? "tags" .!= []
          <*> m .:? "nsfw-tags" .!= []
          <*> m .:? "description"
          <*> m .:  "images"
+         <*> m .:? "background"
          <*> m .:? "thumb"
          <*> m .:? "links" .!= []
 
@@ -95,10 +97,29 @@ instance FromYAML Artist where
       Artist <$> m .: "name" <*> m .:? "url"
 
 instance FromYAML Image where
-  parseYAML = labelledOptNsfw Image "path" "path"
+  parseYAML y = do
+    Pair label rest <- parseYAML y
+    asStr label rest <|> asObj label rest
+   where
+    asStr label = YAML.withStr "path" \(Text.unpack -> path) ->
+      pure $ Image {label, path, nsfw = False, warning = Nothing}
+    asObj label = YAML.withMap "image info" \m -> do
+      path    <- m .:  "path"
+      nsfw    <- m .:? "nsfw" .!= False
+      warning <- m .:? "warning"
+      pure $ Image {label, path, nsfw, warning}
 
 instance FromYAML Link where
-  parseYAML = labelledOptNsfw Link "url" "url"
+  parseYAML y = do
+    Pair title rest <- parseYAML y
+    asStr title rest <|> asObj title rest
+   where
+    asStr title = YAML.withStr "url" \url ->
+      pure $ Link {title, url, nsfw = False}
+    asObj title = YAML.withMap "link info" \m -> do
+      url  <- m .:  "url"
+      nsfw <- m .:? "nsfw" .!= False
+      pure $ Link {title, url, nsfw}
 
 
 data GalleryInfo =
@@ -166,33 +187,6 @@ instance (FromYAML a, FromYAML b) => FromYAML (Pair a b) where
         _        -> fail "expected exactly one pair"
 
 
-data OptNsfw a = NoNsfw !a | WithNsfw !a !Bool
-
-appOptNsfw :: (a -> Bool -> b) -> OptNsfw a -> b
-appOptNsfw f (NoNsfw   x)   = f x False
-appOptNsfw f (WithNsfw x n) = f x n
-
-labelledOptNsfw :: FromYAML a
-                => (Text -> a -> Bool -> b)
-                -> String -- ^ name in \"expected\" message
-                -> Text   -- ^ field name
-                -> YAML.Node YAML.Pos -> YAML.Parser b
-labelledOptNsfw f name field y = do
-  Pair l n' <- parseYAML y
-  n <- parseOptNsfw name field n'
-  pure $ appOptNsfw (f l) n
-
-parseOptNsfw :: FromYAML a
-             => String -- ^ name in \"expected\" message
-             -> Text   -- ^ field name
-             -> YAML.Node YAML.Pos -> YAML.Parser (OptNsfw a)
-parseOptNsfw name field y = yes y <|> no y where
-  yes = YAML.withMap (name <> " & nsfw") \m ->
-    WithNsfw <$> m .: field
-             <*> m .:? "nsfw" .!= False
-  no = fmap NoNsfw . parseYAML
-
-
 instance FromYAML Day where
   parseYAML = YAML.withStr "date" \str ->
     case readMaybe $ Text.unpack str of