tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

format-fragment.hs (1901B)

      1 -- Historical Main.hs fragment; not a standalone module.
      2 -- Formatting policy lives entirely in consumers.format. The host transports
      3 -- UTF-8 source as data, checks Result, and owns file replacement/check status.
      4 runScpFormat :: TricuArgs -> IO ()
      5 runScpFormat opts = do
      6   when (formatWrite opts && formatCheck opts) $
      7     die "tricu scp format: --write and --check are mutually exclusive"
      8   when (formatWrite opts) $ do
      9     symbolic <- pathIsSymbolicLink (formatInput opts)
     10     when symbolic $ die "tricu scp format: --write refuses symbolic links"
     11   bytes <- BS.readFile (formatInput opts)
     12   source <- either (die . ("Invalid UTF-8: " ++) . show) pure (TE.decodeUtf8' bytes)
     13   formatter <- SCP.loadBootstrapExport (formatBootstrap opts) "consumers.format" "formatScp"
     14   formatted <- case apply formatter (ofString $ T.unpack source) of
     15     Fork (Stem Leaf) (Fork text Leaf) ->
     16       either (die . ("Invalid formatter output: " ++)) pure (toString text)
     17     Fork Leaf (Fork problem _) -> die $ "SCP syntax error: " ++ formatT Decode problem
     18     _ -> die "Invalid formatter Result"
     19   let output = TE.encodeUtf8 (T.pack formatted)
     20   _ <- evaluate (BS.length output)
     21   if formatCheck opts
     22     then unless (output == bytes) $ die $ formatInput opts ++ ": needs formatting"
     23     else if formatWrite opts
     24       then when (output /= bytes) $ do
     25         let path = formatInput opts
     26         permissions <- fileMode <$> getFileStatus path
     27         bracketOnError (openBinaryTempFile (takeDirectory path) ".scp-format-")
     28           (\(temporary, handle) -> do
     29             hClose handle `catch` (\(_ :: IOException) -> pure ())
     30             removeFile temporary `catch` (\(_ :: IOException) -> pure ()))
     31           (\(temporary, handle) -> do
     32             BS.hPut handle output
     33             hClose handle
     34             setFileMode temporary permissions
     35             renameFile temporary path)
     36       else BS.putStr output