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

-- | Shared utility functions

module Dhall.Util
    ( snip
    , snipDoc
    , insert
    , _ERROR
    , Censor(..)
    , Input(..)
    , PossiblyTransitiveInput(..)
    , Transitivity(..)
    , OutputMode(..)
    , Output(..)
    , getExpression
    , getExpressionAndHeader
    , getExpressionAndHeaderFromStdinText
    , Header(..)
    , CheckFailed(..)
    ) where

import Control.Exception         (Exception (..))
import Control.Monad.IO.Class    (MonadIO (..))
import Data.Bifunctor            (first)
import Data.String               (IsString)
import Data.Text                 (Text)
import Data.Text.Prettyprint.Doc (Doc, Pretty)
import Dhall.Parser              (Header (..), ParseError)
import Dhall.Pretty              (Ann)
import Dhall.Src                 (Src)
import Dhall.Syntax              (Expr, Import)

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] -> 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
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 = Text
text
    | Bool
otherwise =
         if Text -> Char
Data.Text.last Text
text Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then Text
preview else Text -> Text
Data.Text.init Text
preview
  where
    numberOfLinesOfContext :: Int
numberOfLinesOfContext = Int
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
/= Char
' ')) ([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
== Char
' ')

    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 -> 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) Text
"="

    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 Int
80 Text
separator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\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 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 Int
n [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 (a
_:[a]
xs) (a
_:[a]
ys) = [a] -> [a] -> [a]
go [a]
xs [a]
ys
    go [a]
_ [a]
r = [a]
r

-- | Function to insert an aligned pretty expression
insert :: Pretty a => a -> Doc Ann
insert :: a -> Doc Ann
insert a
expression =
    Doc Ann
"↳ " 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 = string
"\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 String -> Text -> Either ParseError a
parser Censor
censor InputOrTextFromStdin
input = do
    Text
inText <-
        case InputOrTextFromStdin
input of
            Input_ (InputFile String
file) -> String -> IO Text
Data.Text.IO.readFile String
file
            Input_ Input
StandardInput    -> IO Text
Data.Text.IO.getContents
            StdinText 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 String
file) -> String
file
                Input_ Input
StandardInput    -> String
"(input)"
                StdinText Text
_             -> String
"(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
                Censor
NoCensor -> Either ParseError a
result
                Censor
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) = 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 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

{-| For utilities that may want to process transitive dependencies, like
    @dhall freeze@
-}
data PossiblyTransitiveInput
    = NonTransitiveStandardInput
    | PossiblyTransitiveInputFile FilePath Transitivity

{-| Specifies whether or not an input's transitive dependencies should also be
    processed.  Transitive dependencies are restricted to relative file imports.
-}
data Transitivity
    = NonTransitive
    -- ^ Do not process transitive dependencies
    | Transitive
    -- ^ Process transitive dependencies in the same way

-- | 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{Text
modified :: Text
command :: Text
modified :: CheckFailed -> Text
command :: CheckFailed -> Text
..} =
         String
forall string. IsString string => string
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": ❰dhall " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
command_ String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" --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
<> String
" --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
<> String
" 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
<> String
".\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 = (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 =
    (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 =
    (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