    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards   #-}

    -- | Shared utility functions

    module Dhall.Util
        ( snip
        , snipDoc
        , insert
        , _ERROR
        , Censor(..)
        , Input(..)
        , OutputMode(..)
        , Output(..)
        , getExpression
        , getExpressionAndHeader
        , getExpressionAndHeaderFromStdinText
        , Header(..)
        , CheckFailed(..)
        ) 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

    -- | Utility function to cut out the interior of a large text block
    snip :: Text -> Text
    snip :: Text -> Text
    snip text :: Text
    text
        | [Text] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    ls Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    numberOfLinesOfContext Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * 2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 = Text
    text
        | Bool
    otherwise =
             if Text -> Char
    Data.Text.last Text
    text Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\n' then Text
    preview else Text -> Text
    Data.Text.init Text
    preview
      where
        numberOfLinesOfContext :: Int
    numberOfLinesOfContext = 20

        ls :: [Text]
    ls = Text -> [Text]
    Data.Text.lines Text
    text

        header :: [Text]
    header = Int -> [Text] -> [Text]
    forall a. Int -> [a] -> [a]
    take Int
    numberOfLinesOfContext [Text]
    ls

        footer :: [Text]
    footer = Int -> [Text] -> [Text]
    forall a. Int -> [a] -> [a]
    takeEnd Int
    numberOfLinesOfContext [Text]
    ls

        excerpt :: [Text]
    excerpt = (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Char -> Bool) -> Text -> Bool
    Data.Text.any (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ' ')) ([Text]
    header [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <> [Text]
    footer)

        leadingSpaces :: Text -> Int
    leadingSpaces =
            Text -> Int
    Data.Text.length (Text -> Int) -> (Text -> Text) -> Text -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> Text -> Text
    Data.Text.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == ' ')

        minSpaces :: Int
    minSpaces = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ((Text -> Int) -> [Text] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Int
    leadingSpaces [Text]
    excerpt)

        maxLength :: Int
    maxLength = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ((Text -> Int) -> [Text] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Int
    Data.Text.length [Text]
    excerpt)

        separator :: Text
    separator =
                Int -> Text -> Text
    Data.Text.replicate Int
    minSpaces " "
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>  Int -> Text -> Text
    Data.Text.replicate (Int
    maxLength Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    minSpaces) "="

        preview :: Text
    preview =
                [Text] -> Text
    Data.Text.unlines [Text]
    header
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>  Int -> Text -> Text
    Data.Text.take 80 Text
    separator Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "\n"
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>  [Text] -> Text
    Data.Text.unlines [Text]
    footer

    {-| Like `snip`, but for `Doc`s

        Note that this has to be opinionated and render ANSI color codes, but that
        should be fine because we don't use this in a non-interactive context
    -}
    snipDoc :: Doc Ann -> Doc a
    snipDoc :: Doc Ann -> Doc a
    snipDoc doc :: Doc Ann
    doc = Doc a -> Doc a
    forall ann. Doc ann -> Doc ann
    Pretty.align (Text -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    Pretty.pretty (Text -> Text
    snip Text
    text))
      where
        stream :: SimpleDocStream Ann
    stream = Doc Ann -> SimpleDocStream Ann
    forall ann. Doc ann -> SimpleDocStream ann
    Dhall.Pretty.layout Doc Ann
    doc

        ansiStream :: SimpleDocStream AnsiStyle
    ansiStream = (Ann -> AnsiStyle)
    -> SimpleDocStream Ann -> SimpleDocStream AnsiStyle
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Ann -> AnsiStyle
    Dhall.Pretty.annToAnsiStyle SimpleDocStream Ann
    stream

        text :: Text
    text = SimpleDocStream AnsiStyle -> Text
    Pretty.Terminal.renderStrict SimpleDocStream AnsiStyle
    ansiStream

    takeEnd :: Int -> [a] -> [a]
    takeEnd :: Int -> [a] -> [a]
    takeEnd n :: Int
    n l :: [a]
    l = [a] -> [a] -> [a]
    forall a a. [a] -> [a] -> [a]
    go (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    n [a]
    l) [a]
    l
      where
        go :: [a] -> [a] -> [a]
    go (_:xs :: [a]
    xs) (_:ys :: [a]
    ys) = [a] -> [a] -> [a]
    go [a]
    xs [a]
    ys
        go _ r :: [a]
    r = [a]
    r

    -- | Function to insert an aligned pretty expression
    insert :: Pretty a => a -> Doc Ann
    insert :: a -> Doc Ann
    insert expression :: a
    expression =
        "↳ " Doc Ann -> Doc Ann -> Doc Ann
    forall a. Semigroup a => a -> a -> a
    <> Doc Ann -> Doc Ann
    forall ann. Doc ann -> Doc ann
    Pretty.align (Doc Ann -> Doc Ann
    forall a. Doc Ann -> Doc a
    snipDoc (a -> Doc Ann
    forall a ann. Pretty a => a -> Doc ann
    Pretty.pretty a
    expression))

    -- | Prefix used for error messages
    _ERROR :: IsString string => string
    _ERROR :: string
    _ERROR = "\ESC[1;31mError\ESC[0m"

    get
        :: (String -> Text -> Either ParseError a)
        -> Censor
        -> InputOrTextFromStdin
        -> IO a
    get :: (String -> Text -> Either ParseError a)
    -> Censor -> InputOrTextFromStdin -> IO a
    get parser :: String -> Text -> Either ParseError a
    parser censor :: Censor
    censor input :: InputOrTextFromStdin
    input = do
        Text
    inText <- do
            case InputOrTextFromStdin
    input of
                Input_ (InputFile file :: String
    file) -> String -> IO Text
    Data.Text.IO.readFile String
    file
                Input_ StandardInput    -> IO Text
    Data.Text.IO.getContents
                StdinText text :: Text
    text          -> Text -> IO Text
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Text
    text

        let name :: String
    name =
                case InputOrTextFromStdin
    input of
                    Input_ (InputFile file :: String
    file) -> String
    file
                    Input_ StandardInput    -> "(input)"
                    StdinText _             -> "(input)"

        let result :: Either ParseError a
    result = String -> Text -> Either ParseError a
    parser String
    name Text
    inText

        let censoredResult :: Either ParseError a
    censoredResult =
                case Censor
    censor of
                    NoCensor -> Either ParseError a
    result
                    Censor   -> (ParseError -> ParseError)
    -> Either ParseError a -> Either ParseError a
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first ParseError -> ParseError
    Dhall.Parser.censor Either ParseError a
    result

        Either ParseError a -> IO a
    forall e (io :: * -> *) a.
    (Exception e, MonadIO io) =>
    Either e a -> io a
    throws Either ParseError a
    censoredResult

    {-| Convenience utility for converting `Either`-based exceptions to `IO`-based
        exceptions
    -}
    throws :: (Exception e, MonadIO io) => Either e a -> io a
    throws :: Either e a -> io a
    throws (Left  e :: e
    e) = IO a -> io a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (e -> IO a
    forall e a. Exception e => e -> IO a
    Control.Exception.throwIO e
    e)
    throws (Right r :: a
    r) = a -> io a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r

    -- | Set to `Censor` if you want to censor error text that might include secrets
    data Censor = NoCensor | Censor

    -- | Path to input
    data Input = StandardInput | InputFile FilePath

    -- | Path to input or raw input text, necessary since we can't read STDIN twice
    data InputOrTextFromStdin = Input_ Input | StdinText Text

    -- | Path to output
    data Output = StandardOutput | OutputFile FilePath

    {-| Some command-line subcommands can either `Write` their input or `Check`
        that the input has already been modified.  This type is shared between them
        to record that choice.
    -}
    data OutputMode = Write | Check

    -- | Exception thrown when the @--check@ flag to a command-line subcommand fails
    data CheckFailed = CheckFailed { CheckFailed -> Text
    command :: Text, CheckFailed -> Text
    modified :: Text }

    instance Exception CheckFailed

    instance Show CheckFailed where
        show :: CheckFailed -> String
    show CheckFailed{..} =
             String
    forall string. IsString string => string
    _ERROR String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ": ❰dhall " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    command_ String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> " --check❱ failed\n\
            \\n\
            \You ran ❰dhall " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    command_ String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> " --check❱, but the input appears to have not\n\
            \been " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    modified_ String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> " before, or was changed since the last time the input\n\
            \was " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    modified_ String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ".\n"
          where
            modified_ :: String
    modified_ = Text -> String
    Data.Text.unpack Text
    modified

            command_ :: String
    command_ = Text -> String
    Data.Text.unpack Text
    command

    -- | Convenient utility for retrieving an expression
    getExpression :: Censor -> Input -> IO (Expr Src Import)
    getExpression :: Censor -> Input -> IO (Expr Src Import)
    getExpression censor :: Censor
    censor = (String -> Text -> Either ParseError (Expr Src Import))
    -> Censor -> InputOrTextFromStdin -> IO (Expr Src Import)
    forall a.
    (String -> Text -> Either ParseError a)
    -> Censor -> InputOrTextFromStdin -> IO a
    get String -> Text -> Either ParseError (Expr Src Import)
    Dhall.Parser.exprFromText Censor
    censor (InputOrTextFromStdin -> IO (Expr Src Import))
    -> (Input -> InputOrTextFromStdin) -> Input -> IO (Expr Src Import)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Input -> InputOrTextFromStdin
    Input_

    -- | Convenient utility for retrieving an expression along with its header
    getExpressionAndHeader :: Censor -> Input -> IO (Header, Expr Src Import)
    getExpressionAndHeader :: Censor -> Input -> IO (Header, Expr Src Import)
    getExpressionAndHeader censor :: Censor
    censor =
        (String -> Text -> Either ParseError (Header, Expr Src Import))
    -> Censor -> InputOrTextFromStdin -> IO (Header, Expr Src Import)
    forall a.
    (String -> Text -> Either ParseError a)
    -> Censor -> InputOrTextFromStdin -> IO a
    get String -> Text -> Either ParseError (Header, Expr Src Import)
    Dhall.Parser.exprAndHeaderFromText Censor
    censor (InputOrTextFromStdin -> IO (Header, Expr Src Import))
    -> (Input -> InputOrTextFromStdin)
    -> Input
    -> IO (Header, Expr Src Import)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Input -> InputOrTextFromStdin
    Input_

    -- | Convenient utility for retrieving an expression along with its header from
    -- | text already read from STDIN (so it's not re-read)
    getExpressionAndHeaderFromStdinText :: Censor -> Text -> IO (Header, Expr Src Import)
    getExpressionAndHeaderFromStdinText :: Censor -> Text -> IO (Header, Expr Src Import)
    getExpressionAndHeaderFromStdinText censor :: Censor
    censor =
        (String -> Text -> Either ParseError (Header, Expr Src Import))
    -> Censor -> InputOrTextFromStdin -> IO (Header, Expr Src Import)
    forall a.
    (String -> Text -> Either ParseError a)
    -> Censor -> InputOrTextFromStdin -> IO a
    get String -> Text -> Either ParseError (Header, Expr Src Import)
    Dhall.Parser.exprAndHeaderFromText Censor
    censor (InputOrTextFromStdin -> IO (Header, Expr Src Import))
    -> (Text -> InputOrTextFromStdin)
    -> Text
    -> IO (Header, Expr Src Import)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> InputOrTextFromStdin
    StdinText