{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE RecordWildCards #-}

{-| This module contains the core calculus for the Dhall language.

    Dhall is essentially a fork of the @morte@ compiler but with more built-in
    functionality, better error messages, and Haskell integration
-}

module Dhall.Core (
    -- * Syntax
      Const(..)
    , Directory(..)
    , File(..)
    , FilePrefix(..)
    , Import(..)
    , ImportHashed(..)
    , ImportMode(..)
    , ImportType(..)
    , URL(..)
    , Scheme(..)
    , DhallDouble(..)
    , Var(..)
    , Binding(..)
    , makeBinding
    , Chunks(..)
    , PreferAnnotation(..)
    , RecordField(..)
    , makeRecordField
    , FunctionBinding(..)
    , makeFunctionBinding
    , FieldSelection (..)
    , makeFieldSelection
    , WithComponent (..)
    , Expr(..)

    -- * Normalization
    , alphaNormalize
    , normalize
    , normalizeWith
    , normalizeWithM
    , Normalizer
    , NormalizerM
    , ReifiedNormalizer (..)
    , judgmentallyEqual
    , subst
    , shift
    , isNormalized
    , isNormalizedWith
    , denote
    , renote
    , shallowDenote
    , freeIn

    -- * Pretty-printing
    , pretty

    -- * Optics
    , subExpressions
    , subExpressionsWith
    , chunkExprs
    , bindingExprs
    , recordFieldExprs
    , functionBindingExprs

    -- * Let-blocks
    , multiLet
    , wrapInLets
    , MultiLet(..)

    -- * Miscellaneous
    , internalError
    , reservedIdentifiers
    , escapeText
    , pathCharacter
    , throws
    , Eval.textShow
    , censorExpression
    , censorText
    ) where

import Control.Exception      (Exception)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Text              (Text)
import Dhall.Normalize
import Dhall.Pretty.Internal
import Dhall.Src              (Src (..))
import Dhall.Syntax
import Instances.TH.Lift      ()
import Lens.Family            (over)
import Prettyprinter          (Pretty)

import qualified Control.Exception
import qualified Data.Text
import qualified Dhall.Eval         as Eval

-- | Pretty-print a value
pretty :: Pretty a => a -> Text
pretty :: a -> Text
pretty = a -> Text
forall a. Pretty a => a -> Text
pretty_
{-# INLINE pretty #-}

{-| Escape a `Data.Text.Text` literal using Dhall's escaping rules

    Note that the result does not include surrounding quotes
-}
escapeText :: Text -> Text
escapeText :: Text -> Text
escapeText = Text -> Text
escapeText_
{-# INLINE escapeText #-}


{-| Utility used to implement the @--censor@ flag, by:

    * Replacing all `Src` text with spaces
    * Replacing all `Dhall.Syntax.Text` literals inside type errors with spaces
-}
censorExpression :: Expr Src a -> Expr Src a
censorExpression :: Expr Src a -> Expr Src a
censorExpression (TextLit Chunks Src a
chunks) = Chunks Src a -> Expr Src a
forall s a. Chunks s a -> Expr s a
TextLit (Chunks Src a -> Chunks Src a
forall a. Chunks Src a -> Chunks Src a
censorChunks Chunks Src a
chunks)
censorExpression (Note Src
src     Expr Src a
e) = Src -> Expr Src a -> Expr Src a
forall s a. s -> Expr s a -> Expr s a
Note (Src -> Src
censorSrc Src
src) (Expr Src a -> Expr Src a
forall a. Expr Src a -> Expr Src a
censorExpression Expr Src a
e)
censorExpression  Expr Src a
e               = ASetter (Expr Src a) (Expr Src a) (Expr Src a) (Expr Src a)
-> (Expr Src a -> Expr Src a) -> Expr Src a -> Expr Src a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Expr Src a) (Expr Src a) (Expr Src a) (Expr Src a)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions Expr Src a -> Expr Src a
forall a. Expr Src a -> Expr Src a
censorExpression Expr Src a
e

censorChunks :: Chunks Src a -> Chunks Src a
censorChunks :: Chunks Src a -> Chunks Src a
censorChunks (Chunks [(Text, Expr Src a)]
xys Text
z) = [(Text, Expr Src a)] -> Text -> Chunks Src a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(Text, Expr Src a)]
xys' Text
z'
  where
    z' :: Text
z' = Text -> Text
censorText Text
z

    xys' :: [(Text, Expr Src a)]
xys' = [ (Text -> Text
censorText Text
x, Expr Src a -> Expr Src a
forall a. Expr Src a -> Expr Src a
censorExpression Expr Src a
y) | (Text
x, Expr Src a
y) <- [(Text, Expr Src a)]
xys ]

{-| Utility used to censor `Data.Text.Text` by replacing all characters with a
    space
-}
censorText :: Text -> Text
censorText :: Text -> Text
censorText = (Char -> Char) -> Text -> Text
Data.Text.map (\Char
_ -> Char
' ')

censorSrc :: Src -> Src
censorSrc :: Src -> Src
censorSrc (Src { srcText :: Src -> Text
srcText = Text
oldText, SourcePos
srcEnd :: Src -> SourcePos
srcStart :: Src -> SourcePos
srcEnd :: SourcePos
srcStart :: SourcePos
.. }) = Src :: SourcePos -> SourcePos -> Text -> Src
Src { srcText :: Text
srcText = Text
newText, SourcePos
srcEnd :: SourcePos
srcStart :: SourcePos
srcEnd :: SourcePos
srcStart :: SourcePos
.. }
  where
    newText :: Text
newText = Text -> Text
censorText Text
oldText

{-| 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
{-# INLINABLE throws #-}

{- $setup
>>> import qualified Codec.Serialise
>>> import qualified Dhall.Binary
>>> import Data.SpecialValues
>>> import Test.QuickCheck (Arbitrary(..), oneof, elements)
>>> :{
  instance Arbitrary DhallDouble where
    arbitrary = fmap DhallDouble (oneof [ arbitrary, elements specialValues ])
:}
-}