blog/blog-meta/lib/YAML.hs

{-# OPTIONS_GHC -Wno-orphans #-}
module YAML (module YAML, module Data.YAML, untagged) where

import Data.YAML
import Data.YAML.Event (untagged)
import Data.Text (Text)
import qualified Data.Text as Text
import Misc
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LazyBS
import qualified System.IO as IO


str' :: String -> Node ()
str' = str . Text.pack

str :: Text -> Node ()
str = Scalar () . SStr

obj :: Mapping () -> Node ()
obj = Mapping () untagged

(##=) :: (ToYAML b) => Text -> b -> (Node (), Node ())
(##=) = (#=)

(#=) :: (ToYAML a, ToYAML b) => a -> b -> (Node (), Node ())
k #= v = (toYAML k, toYAML v)

list :: ToYAML a => [a] -> Node ()
list = Sequence () untagged . map toYAML


-- | read a chunk from the beginning of the file between a
-- @---@ and a @...@. throw an exception if there isn't one
readHeader :: FilePath -> IO (Node Pos)
readHeader file = IO.withFile file IO.ReadMode \h -> do
  ln <- BS8.hGetLine h
  if (ln /= "---") then
    fail $ file <> ": no header"
  else
    unwrap file . decode1 =<< linesUntil "..." h

-- | read all the lines from a handle until the given terminator. return the
-- lines read, excluding the terminator
linesUntil :: ByteString -> IO.Handle -> IO LazyBS.ByteString
linesUntil end h = go [] where
  go acc = do
    l <- BS8.hGetLine h
    if l == end then
      return $ LazyBS.fromChunks $ reverse acc
    else
      go ("\n" : l : acc)

instance FromYAML IsoDate where parseYAML = withStr "iso date" parseIsoDate