blog/blog-meta/lib/YAML.hs

53 lines
1.4 KiB
Haskell
Raw Normal View History

2022-03-29 21:15:13 -04:00
module YAML (module YAML, module Data.YAML, untagged) where
2021-07-23 21:35:02 -04:00
2022-03-29 21:15:13 -04:00
import Data.YAML
import Data.YAML.Event (untagged)
2021-07-23 21:35:02 -04:00
import Data.Text (Text)
import qualified Data.Text as Text
import Misc
import Data.ByteString (ByteString)
2024-09-15 11:39:52 -04:00
import qualified Data.ByteString.Char8 as BS8
2021-07-23 21:35:02 -04:00
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
2022-03-29 21:15:13 -04:00
readHeader :: FilePath -> IO (Node Pos)
2021-07-23 21:35:02 -04:00
readHeader file = IO.withFile file IO.ReadMode \h -> do
2024-09-15 11:39:52 -04:00
ln <- BS8.hGetLine h
2021-07-23 21:35:02 -04:00
if (ln /= "---") then
fail $ file <> ": no header"
else
2022-03-29 21:15:13 -04:00
unwrap file . decode1 =<< linesUntil "..." h
2021-07-23 21:35:02 -04:00
-- | 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
2024-09-15 11:39:52 -04:00
l <- BS8.hGetLine h
2021-07-23 21:35:02 -04:00
if l == end then
return $ LazyBS.fromChunks $ reverse acc
else
go (l <> "\n" : acc)