82 lines
2.5 KiB
Haskell
Executable File
82 lines
2.5 KiB
Haskell
Executable File
#!/usr/bin/env stack
|
|
-- stack runghc --package libyaml --package aeson --package unordered-containers --package text
|
|
|
|
{-# LANGUAGE OverloadedStrings
|
|
, LambdaCase
|
|
, PackageImports
|
|
, NamedFieldPuns
|
|
, RecordWildCards
|
|
#-}
|
|
|
|
import "libyaml" Text.Libyaml
|
|
import Control.Monad.Trans.Resource
|
|
import Data.Conduit
|
|
import qualified Data.Conduit.List as C
|
|
|
|
import qualified Data.Aeson as JSON
|
|
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Char8 as CBS
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
|
|
import qualified Data.HashMap.Lazy as HashMap
|
|
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as Text
|
|
import qualified Data.Text.IO as Text
|
|
import qualified Data.Text.Encoding as Text
|
|
|
|
import Text.Printf
|
|
import System.IO (stderr)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
Just packageJSON <- JSON.decode <$> LBS.readFile "package.json"
|
|
let
|
|
newVersion :: Text
|
|
Just (JSON.String newVersion) = HashMap.lookup ("version" :: Text) packageJSON
|
|
|
|
updatePackageYaml newVersion
|
|
|
|
|
|
updatePackageYaml :: Text -> IO ()
|
|
updatePackageYaml newVersion = do
|
|
(oldVersion, start, end) <- runResourceT . runConduit . (.|) (decodeFileMarked "package.yaml") $ do
|
|
awaitUntil $ \case
|
|
MarkedEvent{ yamlEvent = EventMappingStart _ _ _ } -> True
|
|
_ -> False
|
|
awaitUntil $ \case
|
|
MarkedEvent{ yamlEvent = EventScalar s _ _ _ }
|
|
| s == "version" -> True
|
|
_ -> False
|
|
_ <- await -- Throw away "version: "
|
|
Just MarkedEvent{ yamlEvent = EventScalar oldVersion' _ _ _, .. } <- await
|
|
let oldVersion = Text.decodeUtf8 oldVersion'
|
|
return (oldVersion, yamlStartMark, yamlEndMark)
|
|
|
|
encNewVersion <- runResourceT . runConduit . (.| encode) $ C.sourceList
|
|
[ EventStreamStart
|
|
, EventDocumentStart
|
|
, EventScalar (Text.encodeUtf8 newVersion) NoTag Any Nothing
|
|
, EventDocumentEnd
|
|
, EventStreamEnd
|
|
]
|
|
|
|
hPrintf stderr "package.yaml: %s -> %s\n" oldVersion newVersion
|
|
|
|
packageYaml <- BS.readFile "package.yaml"
|
|
BS.writeFile "package.yaml" . mconcat $
|
|
[ BS.take (fromIntegral $ yamlIndex start) packageYaml
|
|
, Text.encodeUtf8 . Text.strip $ Text.decodeUtf8 encNewVersion
|
|
, BS.drop (fromIntegral $ yamlIndex end) packageYaml
|
|
]
|
|
where
|
|
awaitUntil :: Monad m => (i -> Bool) -> ConduitM i o m ()
|
|
awaitUntil pred = do
|
|
nextIn <- await
|
|
case nextIn of
|
|
Nothing -> error "Ran out of input in awaitUntil"
|
|
Just inp
|
|
| pred inp -> leftover inp
|
|
Just _ -> awaitUntil pred
|