|
| 1 | +{-# LANGUAGE OverloadedStrings #-} |
| 2 | + |
| 3 | +module Dhall.Freeze ( |
| 4 | + freeze |
| 5 | + , hashImport |
| 6 | + ) where |
| 7 | + |
| 8 | +import Dhall.Core |
| 9 | +import Dhall.Import (load, hashExpression) |
| 10 | +import Dhall.Parser (exprAndHeaderFromText, Src) |
| 11 | +import Dhall.Pretty (annToAnsiStyle) |
| 12 | + |
| 13 | +import System.Console.ANSI (hSupportsANSI) |
| 14 | +import Data.Monoid ((<>)) |
| 15 | +import Data.Maybe (fromMaybe) |
| 16 | +import Data.Text |
| 17 | + |
| 18 | +import qualified Data.Text.Prettyprint.Doc as Pretty |
| 19 | +import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty |
| 20 | +import qualified Control.Exception |
| 21 | +import qualified Data.Text.IO |
| 22 | +import qualified System.IO |
| 23 | + |
| 24 | +opts :: Pretty.LayoutOptions |
| 25 | +opts = |
| 26 | + Pretty.defaultLayoutOptions |
| 27 | + { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 } |
| 28 | + |
| 29 | +readInput :: Maybe FilePath -> IO Text |
| 30 | +readInput = maybe fromStdin Data.Text.IO.readFile |
| 31 | + where |
| 32 | + fromStdin = System.IO.hSetEncoding System.IO.stdin System.IO.utf8 >> Data.Text.IO.getContents |
| 33 | + |
| 34 | +hashImport :: Import -> IO Import |
| 35 | +hashImport import_ = do |
| 36 | + expression <- Dhall.Import.load (Embed import_) |
| 37 | + let expressionHash = Just (Dhall.Import.hashExpression expression) |
| 38 | + let newImportHashed = (importHashed import_) { hash = expressionHash } |
| 39 | + return $ import_ { importHashed = newImportHashed } |
| 40 | + |
| 41 | +parseExpr :: String -> Text -> IO (Text, Expr Src Import) |
| 42 | +parseExpr src txt = |
| 43 | + case exprAndHeaderFromText src txt of |
| 44 | + Left err -> Control.Exception.throwIO err |
| 45 | + Right x -> return x |
| 46 | + |
| 47 | +freezeExpr :: (Text, Expr s Import) -> IO (Text, Expr s Import) |
| 48 | +freezeExpr (t, e) = do |
| 49 | + e' <- traverse hashImport e |
| 50 | + return (t, e') |
| 51 | + |
| 52 | +writeExpr :: Maybe FilePath -> (Text, Expr s Import) -> IO () |
| 53 | +writeExpr inplace (header, expr) = do |
| 54 | + let doc = Pretty.pretty header <> Pretty.pretty expr |
| 55 | + let layoutOptions = opts |
| 56 | + let stream = Pretty.layoutSmart layoutOptions doc |
| 57 | + |
| 58 | + case inplace of |
| 59 | + Just f -> |
| 60 | + System.IO.withFile f System.IO.WriteMode (\h -> |
| 61 | + Pretty.renderIO h (annToAnsiStyle <$> stream)) |
| 62 | + |
| 63 | + Nothing -> do |
| 64 | + supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout |
| 65 | + if supportsANSI |
| 66 | + then |
| 67 | + Pretty.renderIO System.IO.stdout (annToAnsiStyle <$> Pretty.layoutSmart opts doc) |
| 68 | + else |
| 69 | + Pretty.renderIO System.IO.stdout (Pretty.layoutSmart opts (Pretty.unAnnotate doc)) |
| 70 | + |
| 71 | +freeze :: Maybe FilePath -> IO () |
| 72 | +freeze inplace = do |
| 73 | + expr <- readInput inplace |
| 74 | + parseExpr srcInfo expr >>= freezeExpr >>= writeExpr inplace |
| 75 | + where |
| 76 | + srcInfo = fromMaybe "(stdin)" inplace |
0 commit comments