{-# 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