{-# LANGUAGE OverloadedStrings #-}
module Dhall.Util
( snip
, snipDoc
, insert
, _ERROR
, Censor(..)
, Input(..)
, Output(..)
, getExpression
, getExpressionAndHeader
, getExpressionAndHeaderFromStdinText
, Header(..)
) where
import Control.Exception (Exception(..))
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bifunctor (first)
import Data.Monoid ((<>))
import Data.String (IsString)
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Doc, Pretty)
import Dhall.Parser (ParseError, Header(..))
import Dhall.Pretty (Ann)
import Dhall.Syntax (Expr, Import)
import Dhall.Src (Src)
import qualified Control.Exception
import qualified Data.Text
import qualified Data.Text.IO
import qualified Data.Text.Prettyprint.Doc as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
import qualified Dhall.Parser
import qualified Dhall.Pretty
snip :: Text -> Text
snip text
| length ls <= numberOfLinesOfContext * 2 + 1 = text
| otherwise =
if Data.Text.last text == '\n' then preview else Data.Text.init preview
where
numberOfLinesOfContext = 20
ls = Data.Text.lines text
header = take numberOfLinesOfContext ls
footer = takeEnd numberOfLinesOfContext ls
excerpt = filter (Data.Text.any (/= ' ')) (header <> footer)
leadingSpaces =
Data.Text.length . Data.Text.takeWhile (== ' ')
minSpaces = minimum (map leadingSpaces excerpt)
maxLength = maximum (map Data.Text.length excerpt)
separator =
Data.Text.replicate minSpaces " "
<> Data.Text.replicate (maxLength - minSpaces) "="
preview =
Data.Text.unlines header
<> separator <> "\n"
<> Data.Text.unlines footer
snipDoc :: Doc Ann -> Doc a
snipDoc doc = Pretty.align (Pretty.pretty (snip text))
where
stream = Dhall.Pretty.layout doc
ansiStream = fmap Dhall.Pretty.annToAnsiStyle stream
text = Pretty.Terminal.renderStrict ansiStream
takeEnd :: Int -> [a] -> [a]
takeEnd n l = go (drop n l) l
where
go (_:xs) (_:ys) = go xs ys
go _ r = r
insert :: Pretty a => a -> Doc Ann
insert expression =
"↳ " <> Pretty.align (snipDoc (Pretty.pretty expression))
_ERROR :: IsString string => string
_ERROR = "\ESC[1;31mError\ESC[0m"
get :: (String -> Text -> Either ParseError a) -> Censor -> InputOrTextFromStdin -> IO a
get parser censor input = do
inText <- do
case input of
Input_ (InputFile file) -> Data.Text.IO.readFile file
Input_ StandardInput -> Data.Text.IO.getContents
StdinText text -> pure text
let name =
case input of
Input_ (InputFile file) -> file
Input_ StandardInput -> "(stdin)"
StdinText _ -> "(stdin)"
let result = parser name inText
let censoredResult =
case censor of
NoCensor -> result
Censor -> first Dhall.Parser.censor result
throws censoredResult
throws :: (Exception e, MonadIO io) => Either e a -> io a
throws (Left e) = liftIO (Control.Exception.throwIO e)
throws (Right r) = return r
data Censor = NoCensor | Censor
data Input = StandardInput | InputFile FilePath
data InputOrTextFromStdin = Input_ Input | StdinText Text
data Output = StandardOutput | OutputFile FilePath
getExpression :: Censor -> Input -> IO (Expr Src Import)
getExpression censor = get Dhall.Parser.exprFromText censor . Input_
getExpressionAndHeader :: Censor -> Input -> IO (Header, Expr Src Import)
getExpressionAndHeader censor = get Dhall.Parser.exprAndHeaderFromText censor . Input_
getExpressionAndHeaderFromStdinText :: Censor -> Text -> IO (Header, Expr Src Import)
getExpressionAndHeaderFromStdinText censor = get Dhall.Parser.exprAndHeaderFromText censor . StdinText