blog/blog-meta/lib/YAML.hs

52 lines
1.4 KiB
Haskell

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 as BS
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 <- BS.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 <- BS.hGetLine h
if l == end then
return $ LazyBS.fromChunks $ reverse acc
else
go (l <> "\n" : acc)