Use Strict Text for Parsing. (#422)
* Benchmark Prelude files * Add issue 108 example * Some cleaning up * Remove printing of files * Add bounds * Clean cabal formatting * Using strict Text instead of lazy Text * Fixing compilation errors * Update tests * Cleanup * Revert benchmark merge * Update comments to replace the mention of Builder to Text
This commit is contained in:
Fintan Halpenny
GitHub
parent
6f626c96bc
commit
8bd410f8f5
|
|
@ -37,8 +37,6 @@ import qualified Paths_dhall as Meta
|
|||
|
||||
import qualified Control.Exception
|
||||
import qualified Data.Text.IO
|
||||
import qualified Data.Text.Lazy
|
||||
import qualified Data.Text.Lazy.IO
|
||||
import qualified Data.Text.Prettyprint.Doc as Pretty
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
|
||||
import qualified Options.Applicative
|
||||
|
|
@ -96,9 +94,8 @@ main = do
|
|||
Control.Exception.handle handler (do
|
||||
case inplace of
|
||||
Just file -> do
|
||||
strictText <- Data.Text.IO.readFile file
|
||||
let lazyText = Data.Text.Lazy.fromStrict strictText
|
||||
(header, expr) <- case exprAndHeaderFromText "(stdin)" lazyText of
|
||||
text <- Data.Text.IO.readFile file
|
||||
(header, expr) <- case exprAndHeaderFromText "(stdin)" text of
|
||||
Left err -> Control.Exception.throwIO err
|
||||
Right x -> return x
|
||||
|
||||
|
|
@ -108,7 +105,7 @@ main = do
|
|||
Data.Text.IO.hPutStrLn handle "" )
|
||||
Nothing -> do
|
||||
System.IO.hSetEncoding System.IO.stdin System.IO.utf8
|
||||
inText <- Data.Text.Lazy.IO.getContents
|
||||
inText <- Data.Text.IO.getContents
|
||||
|
||||
(header, expr) <- case exprAndHeaderFromText "(stdin)" inText of
|
||||
Left err -> Control.Exception.throwIO err
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ import System.Exit (exitFailure, exitSuccess)
|
|||
import qualified Paths_dhall as Meta
|
||||
|
||||
import qualified Control.Exception
|
||||
import qualified Data.Text.Lazy.IO
|
||||
import qualified Data.Text.IO
|
||||
import qualified Dhall.TypeCheck
|
||||
import qualified Options.Applicative
|
||||
import qualified System.IO
|
||||
|
|
@ -69,7 +69,7 @@ main = do
|
|||
if explain
|
||||
then Control.Exception.throwIO (DetailedTypeError e)
|
||||
else do
|
||||
Data.Text.Lazy.IO.hPutStrLn stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
|
||||
Data.Text.IO.hPutStrLn stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
|
||||
Control.Exception.throwIO e
|
||||
|
||||
handler1 (Imported ps e) = do
|
||||
|
|
@ -78,7 +78,7 @@ main = do
|
|||
if explain
|
||||
then Control.Exception.throwIO (Imported ps (DetailedTypeError e))
|
||||
else do
|
||||
Data.Text.Lazy.IO.hPutStrLn stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
|
||||
Data.Text.IO.hPutStrLn stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
|
||||
Control.Exception.throwIO (Imported ps e)
|
||||
|
||||
handler2 e = do
|
||||
|
|
@ -89,7 +89,7 @@ main = do
|
|||
|
||||
handle (do
|
||||
System.IO.hSetEncoding System.IO.stdin System.IO.utf8
|
||||
inText <- Data.Text.Lazy.IO.getContents
|
||||
inText <- Data.Text.IO.getContents
|
||||
|
||||
expr <- case exprFromText "(stdin)" inText of
|
||||
Left err -> Control.Exception.throwIO err
|
||||
|
|
@ -101,4 +101,4 @@ main = do
|
|||
Left err -> Control.Exception.throwIO err
|
||||
Right _ -> return ()
|
||||
|
||||
Data.Text.Lazy.IO.putStrLn (hashExpressionToCode (normalize expr')) )
|
||||
Data.Text.IO.putStrLn (hashExpressionToCode (normalize expr')) )
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ import Control.Monad.State.Class ( MonadState, get, modify )
|
|||
import Control.Monad.State.Strict ( evalStateT )
|
||||
import Data.List ( foldl' )
|
||||
|
||||
import qualified Data.Text.Lazy as LazyText
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Prettyprint.Doc as Pretty
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty ( renderIO )
|
||||
import qualified Dhall.Context
|
||||
|
|
@ -74,7 +74,7 @@ parseAndLoad
|
|||
=> String -> m ( Dhall.Expr Dhall.Src Dhall.X )
|
||||
parseAndLoad src = do
|
||||
parsed <-
|
||||
case Dhall.exprFromText "(stdin)" ( LazyText.pack src ) of
|
||||
case Dhall.exprFromText "(stdin)" ( Text.pack src ) of
|
||||
Left e ->
|
||||
liftIO ( throwIO e )
|
||||
|
||||
|
|
@ -158,7 +158,7 @@ addBinding :: ( MonadIO m, MonadState Env m ) => [String] -> m ()
|
|||
addBinding (k : "=" : srcs) = do
|
||||
let
|
||||
varName =
|
||||
LazyText.pack k
|
||||
Text.pack k
|
||||
|
||||
loaded <-
|
||||
parseAndLoad ( unwords srcs )
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ import System.IO (Handle)
|
|||
import qualified Paths_dhall as Meta
|
||||
|
||||
import qualified Control.Exception
|
||||
import qualified Data.Text.Lazy.IO
|
||||
import qualified Data.Text.IO
|
||||
import qualified Data.Text.Prettyprint.Doc as Pretty
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
|
||||
import qualified Dhall.Core
|
||||
|
|
@ -96,7 +96,7 @@ throws (Right a) = return a
|
|||
|
||||
getExpression :: IO (Expr Src Import)
|
||||
getExpression = do
|
||||
inText <- Data.Text.Lazy.IO.getContents
|
||||
inText <- Data.Text.IO.getContents
|
||||
|
||||
throws (Dhall.Parser.exprFromText "(stdin)" inText)
|
||||
|
||||
|
|
@ -128,7 +128,7 @@ main = do
|
|||
if explain
|
||||
then Control.Exception.throwIO (DetailedTypeError e)
|
||||
else do
|
||||
Data.Text.Lazy.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
|
||||
Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
|
||||
Control.Exception.throwIO e
|
||||
|
||||
handler1 (Imported ps e) = do
|
||||
|
|
@ -137,7 +137,7 @@ main = do
|
|||
if explain
|
||||
then Control.Exception.throwIO (Imported ps (DetailedTypeError e))
|
||||
else do
|
||||
Data.Text.Lazy.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
|
||||
Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
|
||||
Control.Exception.throwIO (Imported ps e)
|
||||
|
||||
handler2 e = do
|
||||
|
|
@ -161,7 +161,7 @@ main = do
|
|||
else Pretty.unAnnotateS stream
|
||||
|
||||
Pretty.renderIO h ansiStream
|
||||
Data.Text.Lazy.IO.hPutStrLn h ""
|
||||
Data.Text.IO.hPutStrLn h ""
|
||||
|
||||
handle $ case mode of
|
||||
Version -> do
|
||||
|
|
@ -176,7 +176,7 @@ main = do
|
|||
|
||||
render System.IO.stderr (Dhall.Core.normalize inferredType)
|
||||
|
||||
Data.Text.Lazy.IO.hPutStrLn System.IO.stderr mempty
|
||||
Data.Text.IO.hPutStrLn System.IO.stderr mempty
|
||||
|
||||
render System.IO.stdout (Dhall.Core.normalize resolvedExpression)
|
||||
|
||||
|
|
|
|||
49
src/Dhall.hs
49
src/Dhall.hs
|
|
@ -72,7 +72,7 @@ import Data.Functor.Contravariant (Contravariant(..))
|
|||
import Data.Monoid ((<>))
|
||||
import Data.Scientific (Scientific)
|
||||
import Data.Sequence (Seq)
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text (Text)
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Vector (Vector)
|
||||
import Data.Word (Word8, Word16, Word32, Word64)
|
||||
|
|
@ -174,7 +174,8 @@ inputWith (Type {..}) ctx n txt = do
|
|||
expr <- throws (Dhall.Parser.exprFromText "(input)" txt)
|
||||
expr' <- Dhall.Import.loadWithContext ctx n expr
|
||||
let suffix =
|
||||
( Data.Text.Lazy.Builder.toLazyText
|
||||
( Data.Text.Lazy.toStrict
|
||||
. Data.Text.Lazy.Builder.toLazyText
|
||||
. build
|
||||
) expected
|
||||
let annot = case expr' of
|
||||
|
|
@ -415,10 +416,10 @@ double = fmap Data.Scientific.toRealFloat scientific
|
|||
>>> input lazyText "\"Test\""
|
||||
"Test"
|
||||
-}
|
||||
lazyText :: Type Text
|
||||
lazyText :: Type Data.Text.Lazy.Text
|
||||
lazyText = Type {..}
|
||||
where
|
||||
extract (TextLit (Chunks [] t)) = pure (Data.Text.Lazy.Builder.toLazyText t)
|
||||
extract (TextLit (Chunks [] t)) = pure (Data.Text.Lazy.fromStrict t)
|
||||
extract _ = empty
|
||||
|
||||
expected = Text
|
||||
|
|
@ -428,7 +429,7 @@ lazyText = Type {..}
|
|||
>>> input strictText "\"Test\""
|
||||
"Test"
|
||||
-}
|
||||
strictText :: Type Data.Text.Text
|
||||
strictText :: Type Text
|
||||
strictText = fmap Data.Text.Lazy.toStrict lazyText
|
||||
|
||||
{-| Decode a `Maybe`
|
||||
|
|
@ -551,10 +552,10 @@ instance Interpret Double where
|
|||
instance {-# OVERLAPS #-} Interpret [Char] where
|
||||
autoWith _ = string
|
||||
|
||||
instance Interpret Text where
|
||||
instance Interpret Data.Text.Lazy.Text where
|
||||
autoWith _ = lazyText
|
||||
|
||||
instance Interpret Data.Text.Text where
|
||||
instance Interpret Text where
|
||||
autoWith _ = strictText
|
||||
|
||||
instance Interpret a => Interpret (Maybe a) where
|
||||
|
|
@ -649,8 +650,8 @@ instance (Constructor c1, Constructor c2, GenericInterpret f1, GenericInterpret
|
|||
nR :: M1 i c2 f2 a
|
||||
nR = undefined
|
||||
|
||||
nameL = constructorModifier (Data.Text.Lazy.pack (conName nL))
|
||||
nameR = constructorModifier (Data.Text.Lazy.pack (conName nR))
|
||||
nameL = constructorModifier (Data.Text.pack (conName nL))
|
||||
nameR = constructorModifier (Data.Text.pack (conName nR))
|
||||
|
||||
extract (UnionLit name e _)
|
||||
| name == nameL = fmap (L1 . M1) (extractL e)
|
||||
|
|
@ -670,7 +671,7 @@ instance (Constructor c, GenericInterpret (f :+: g), GenericInterpret h) => Gene
|
|||
n :: M1 i c h a
|
||||
n = undefined
|
||||
|
||||
name = constructorModifier (Data.Text.Lazy.pack (conName n))
|
||||
name = constructorModifier (Data.Text.pack (conName n))
|
||||
|
||||
extract u@(UnionLit name' e _)
|
||||
| name == name' = fmap (R1 . M1) (extractR e)
|
||||
|
|
@ -689,7 +690,7 @@ instance (Constructor c, GenericInterpret f, GenericInterpret (g :+: h)) => Gene
|
|||
n :: M1 i c f a
|
||||
n = undefined
|
||||
|
||||
name = constructorModifier (Data.Text.Lazy.pack (conName n))
|
||||
name = constructorModifier (Data.Text.pack (conName n))
|
||||
|
||||
extract u@(UnionLit name' e _)
|
||||
| name == name' = fmap (L1 . M1) (extractL e)
|
||||
|
|
@ -748,14 +749,14 @@ instance (Selector s, Interpret a) => GenericInterpret (M1 S s (K1 i a)) where
|
|||
genericAutoWith opts@(InterpretOptions {..}) = do
|
||||
name <- getSelName n
|
||||
let extract (RecordLit m) = do
|
||||
let name' = fieldModifier (Data.Text.Lazy.pack name)
|
||||
let name' = fieldModifier (Data.Text.pack name)
|
||||
e <- Data.HashMap.Strict.InsOrd.lookup name' m
|
||||
fmap (M1 . K1) (extract' e)
|
||||
extract _ = Nothing
|
||||
let expected =
|
||||
Record (Data.HashMap.Strict.InsOrd.fromList [(key, expected')])
|
||||
where
|
||||
key = fieldModifier (Data.Text.Lazy.pack name)
|
||||
key = fieldModifier (Data.Text.pack name)
|
||||
pure (Type {..})
|
||||
where
|
||||
n :: M1 i s f a
|
||||
|
|
@ -813,18 +814,18 @@ instance Inject Bool where
|
|||
|
||||
declared = Bool
|
||||
|
||||
instance Inject Text where
|
||||
instance Inject Data.Text.Lazy.Text where
|
||||
injectWith _ = InputType {..}
|
||||
where
|
||||
embed text =
|
||||
TextLit (Chunks [] (Data.Text.Lazy.Builder.fromLazyText text))
|
||||
TextLit (Chunks [] (Data.Text.Lazy.toStrict text))
|
||||
|
||||
declared = Text
|
||||
|
||||
instance Inject Data.Text.Text where
|
||||
instance Inject Text where
|
||||
injectWith _ = InputType {..}
|
||||
where
|
||||
embed text = TextLit (Chunks [] (Data.Text.Lazy.Builder.fromText text))
|
||||
embed text = TextLit (Chunks [] text)
|
||||
|
||||
declared = Text
|
||||
|
||||
|
|
@ -961,8 +962,8 @@ instance (Constructor c1, Constructor c2, GenericInject f1, GenericInject f2) =>
|
|||
nR :: M1 i c2 f2 a
|
||||
nR = undefined
|
||||
|
||||
keyL = constructorModifier (Data.Text.Lazy.pack (conName nL))
|
||||
keyR = constructorModifier (Data.Text.Lazy.pack (conName nR))
|
||||
keyL = constructorModifier (Data.Text.pack (conName nL))
|
||||
keyR = constructorModifier (Data.Text.pack (conName nR))
|
||||
|
||||
InputType embedL declaredL = evalState (genericInjectWith options) 1
|
||||
InputType embedR declaredR = evalState (genericInjectWith options) 1
|
||||
|
|
@ -979,7 +980,7 @@ instance (Constructor c, GenericInject (f :+: g), GenericInject h) => GenericInj
|
|||
nR :: M1 i c h a
|
||||
nR = undefined
|
||||
|
||||
keyR = constructorModifier (Data.Text.Lazy.pack (conName nR))
|
||||
keyR = constructorModifier (Data.Text.pack (conName nR))
|
||||
|
||||
declared = Union (Data.HashMap.Strict.InsOrd.insert keyR declaredR ktsL)
|
||||
|
||||
|
|
@ -998,7 +999,7 @@ instance (Constructor c, GenericInject f, GenericInject (g :+: h)) => GenericInj
|
|||
nL :: M1 i c f a
|
||||
nL = undefined
|
||||
|
||||
keyL = constructorModifier (Data.Text.Lazy.pack (conName nL))
|
||||
keyL = constructorModifier (Data.Text.pack (conName nL))
|
||||
|
||||
declared = Union (Data.HashMap.Strict.InsOrd.insert keyL declaredL ktsR)
|
||||
|
||||
|
|
@ -1049,7 +1050,7 @@ instance GenericInject U1 where
|
|||
|
||||
instance (Selector s, Inject a) => GenericInject (M1 S s (K1 i a)) where
|
||||
genericInjectWith opts@(InterpretOptions {..}) = do
|
||||
name <- fieldModifier . Data.Text.Lazy.pack <$> getSelName n
|
||||
name <- fieldModifier . Data.Text.pack <$> getSelName n
|
||||
let embed (M1 (K1 x)) =
|
||||
RecordLit (Data.HashMap.Strict.InsOrd.singleton name (embedIn x))
|
||||
let declared =
|
||||
|
|
@ -1102,7 +1103,7 @@ newtype RecordType a =
|
|||
( Data.Functor.Product.Product
|
||||
( Control.Applicative.Const
|
||||
( Data.HashMap.Strict.InsOrd.InsOrdHashMap
|
||||
Data.Text.Lazy.Text
|
||||
Text
|
||||
( Expr Src X )
|
||||
)
|
||||
)
|
||||
|
|
@ -1127,7 +1128,7 @@ record ( RecordType ( Data.Functor.Product.Pair ( Control.Applicative.Const fiel
|
|||
|
||||
|
||||
-- | Parse a single field of a record.
|
||||
field :: Data.Text.Lazy.Text -> Type a -> RecordType a
|
||||
field :: Text -> Type a -> RecordType a
|
||||
field key valueType =
|
||||
let
|
||||
extractBody expr = do
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ module Dhall.Context (
|
|||
, toList
|
||||
) where
|
||||
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text (Text)
|
||||
import Prelude hiding (lookup)
|
||||
|
||||
{-| A @(Context a)@ associates `Text` labels with values of type @a@. Each
|
||||
|
|
|
|||
|
|
@ -66,8 +66,7 @@ import Data.Scientific (Scientific)
|
|||
import Data.Semigroup (Semigroup(..))
|
||||
import Data.Sequence (Seq, ViewL(..), ViewR(..))
|
||||
import Data.Set (Set)
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text.Lazy.Builder (Builder)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Prettyprint.Doc (Pretty)
|
||||
import Data.Traversable
|
||||
import {-# SOURCE #-} Dhall.Pretty.Internal
|
||||
|
|
@ -105,7 +104,7 @@ import qualified Data.Text.Prettyprint.Doc as Pretty
|
|||
data Const = Type | Kind deriving (Show, Eq, Bounded, Enum)
|
||||
|
||||
instance Buildable Const where
|
||||
build = buildConst
|
||||
build = Builder.fromText . buildConst
|
||||
|
||||
{-| Internal representation of a directory that stores the path components in
|
||||
reverse order
|
||||
|
|
@ -273,7 +272,7 @@ instance IsString Var where
|
|||
fromString str = V (fromString str) 0
|
||||
|
||||
instance Buildable Var where
|
||||
build = buildVar
|
||||
build = Builder.fromText . buildVar
|
||||
|
||||
-- | Syntax tree for expressions
|
||||
data Expr s a
|
||||
|
|
@ -546,7 +545,7 @@ instance IsString (Expr s a) where
|
|||
fromString str = Var (fromString str)
|
||||
|
||||
-- | The body of an interpolated @Text@ literal
|
||||
data Chunks s a = Chunks [(Builder, Expr s a)] Builder
|
||||
data Chunks s a = Chunks [(Text, Expr s a)] Text
|
||||
deriving (Functor, Foldable, Traversable, Show, Eq)
|
||||
|
||||
instance Data.Semigroup.Semigroup (Chunks s a) where
|
||||
|
|
@ -578,7 +577,7 @@ instance IsString (Chunks s a) where
|
|||
|
||||
-- | Generates a syntactically valid Dhall program
|
||||
instance Buildable a => Buildable (Expr s a) where
|
||||
build = buildExpr
|
||||
build = Builder.fromText . buildExpr
|
||||
|
||||
instance Pretty a => Pretty (Expr s a) where
|
||||
pretty = Pretty.unAnnotate . prettyExpr
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ import Data.Scientific (Scientific)
|
|||
import Data.Semigroup
|
||||
import Data.Set (Set)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Prettyprint.Doc (Doc, Pretty)
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Dhall.Core (Const(..), Expr(..), Var(..))
|
||||
|
|
|
|||
|
|
@ -126,7 +126,7 @@ import Data.CaseInsensitive (CI)
|
|||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Map (Map)
|
||||
import Data.Semigroup (sconcat, (<>))
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Lazy.Builder (Builder)
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
#else
|
||||
|
|
@ -166,10 +166,11 @@ import qualified Data.List as List
|
|||
import qualified Data.HashMap.Strict.InsOrd
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text.Encoding
|
||||
import qualified Data.Text.Lazy as Text
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lazy
|
||||
import qualified Data.Text.Lazy.Builder as Builder
|
||||
import qualified Data.Text.Lazy.Encoding
|
||||
import qualified Data.Text.Lazy.IO
|
||||
import qualified Data.Text.IO
|
||||
import qualified Dhall.Core
|
||||
import qualified Dhall.Parser
|
||||
import qualified Dhall.Context
|
||||
|
|
@ -183,7 +184,7 @@ import qualified Text.Parser.Combinators
|
|||
import qualified Text.Parser.Token
|
||||
|
||||
builderToString :: Builder -> String
|
||||
builderToString = Text.unpack . Builder.toLazyText
|
||||
builderToString = Data.Text.Lazy.unpack . Builder.toLazyText
|
||||
|
||||
-- | An import failed because of a cycle in the import graph
|
||||
newtype Cycle = Cycle
|
||||
|
|
@ -445,10 +446,8 @@ toHeader
|
|||
:: Expr s a
|
||||
-> Maybe (CI Data.ByteString.ByteString, Data.ByteString.ByteString)
|
||||
toHeader (RecordLit m) = do
|
||||
TextLit (Chunks [] keyBuilder ) <- Data.HashMap.Strict.InsOrd.lookup "header" m
|
||||
TextLit (Chunks [] valueBuilder) <- Data.HashMap.Strict.InsOrd.lookup "value" m
|
||||
let keyText = Text.toStrict (Builder.toLazyText keyBuilder )
|
||||
let valueText = Text.toStrict (Builder.toLazyText valueBuilder)
|
||||
TextLit (Chunks [] keyText ) <- Data.HashMap.Strict.InsOrd.lookup "header" m
|
||||
TextLit (Chunks [] valueText) <- Data.HashMap.Strict.InsOrd.lookup "value" m
|
||||
let keyBytes = Data.Text.Encoding.encodeUtf8 keyText
|
||||
let valueBytes = Data.Text.Encoding.encodeUtf8 valueText
|
||||
return (Data.CaseInsensitive.mk keyBytes, valueBytes)
|
||||
|
|
@ -540,14 +539,14 @@ exprFromImport (Import {..}) = do
|
|||
then return ()
|
||||
else throwIO (MissingFile path)
|
||||
|
||||
text <- Data.Text.Lazy.IO.readFile path
|
||||
text <- Data.Text.IO.readFile path
|
||||
|
||||
return (path, text)
|
||||
|
||||
URL prefix file suffix maybeHeaders -> do
|
||||
m <- needManager
|
||||
|
||||
let fileText = Builder.toLazyText (build file)
|
||||
let fileText = Data.Text.Lazy.toStrict $ Builder.toLazyText (build file)
|
||||
let url = Text.unpack (prefix <> fileText <> suffix)
|
||||
|
||||
request <- liftIO (HTTP.parseUrlThrow url)
|
||||
|
|
@ -570,7 +569,8 @@ exprFromImport (Import {..}) = do
|
|||
)
|
||||
)
|
||||
let suffix_ =
|
||||
( Builder.toLazyText
|
||||
( Data.Text.Lazy.toStrict
|
||||
. Builder.toLazyText
|
||||
. build
|
||||
) expected
|
||||
let annot = case expr of
|
||||
|
|
@ -605,7 +605,7 @@ exprFromImport (Import {..}) = do
|
|||
|
||||
case Data.Text.Lazy.Encoding.decodeUtf8' bytes of
|
||||
Left err -> liftIO (throwIO err)
|
||||
Right text -> return (url, text)
|
||||
Right text -> return (url, Data.Text.Lazy.toStrict text)
|
||||
|
||||
Env env -> liftIO $ do
|
||||
x <- System.Environment.lookupEnv (Text.unpack env)
|
||||
|
|
@ -628,7 +628,7 @@ exprFromImport (Import {..}) = do
|
|||
return expr
|
||||
|
||||
RawText -> do
|
||||
return (TextLit (Chunks [] (build text)))
|
||||
return (TextLit (Chunks [] text))
|
||||
|
||||
-- | Resolve all imports within an expression using a custom typing context and
|
||||
-- `Import`-resolving callback in arbitrary `MonadCatch` monad.
|
||||
|
|
@ -736,10 +736,10 @@ load = loadWithContext Dhall.Context.empty (const Nothing)
|
|||
|
||||
-- | Hash a fully resolved expression
|
||||
hashExpression :: Expr s X -> (Crypto.Hash.Digest SHA256)
|
||||
hashExpression expr = Crypto.Hash.hashlazy actualBytes
|
||||
hashExpression expr = Crypto.Hash.hash actualBytes
|
||||
where
|
||||
text = Dhall.Core.pretty (Dhall.Core.normalize expr)
|
||||
actualBytes = Data.Text.Lazy.Encoding.encodeUtf8 text
|
||||
actualBytes = Data.Text.Encoding.encodeUtf8 text
|
||||
|
||||
{-| Convenience utility to hash a fully resolved expression and return the
|
||||
base-16 encoded hash with the @sha256:@ prefix
|
||||
|
|
|
|||
|
|
@ -31,8 +31,7 @@ import Data.Semigroup (Semigroup(..))
|
|||
import Data.Sequence (ViewL(..))
|
||||
import Data.Set (Set)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text.Lazy.Builder (Builder)
|
||||
import Data.Text (Text)
|
||||
import Data.Void (Void)
|
||||
import Dhall.Core
|
||||
import Formatting.Buildable (Buildable(..))
|
||||
|
|
@ -45,7 +44,6 @@ import qualified Control.Monad
|
|||
import qualified Crypto.Hash
|
||||
import qualified Data.ByteArray.Encoding
|
||||
import qualified Data.ByteString
|
||||
import qualified Data.ByteString.Lazy
|
||||
import qualified Data.Char
|
||||
import qualified Data.HashMap.Strict.InsOrd
|
||||
import qualified Data.HashSet
|
||||
|
|
@ -54,9 +52,7 @@ import qualified Data.List.NonEmpty
|
|||
import qualified Data.Sequence
|
||||
import qualified Data.Set
|
||||
import qualified Data.Text
|
||||
import qualified Data.Text.Lazy
|
||||
import qualified Data.Text.Lazy.Builder
|
||||
import qualified Data.Text.Lazy.Encoding
|
||||
import qualified Data.Text.Encoding
|
||||
import qualified Text.Megaparsec
|
||||
import qualified Text.Megaparsec.Char
|
||||
import qualified Text.Parser.Char
|
||||
|
|
@ -126,9 +122,9 @@ instance Text.Parser.Char.CharParsing Parser where
|
|||
|
||||
anyChar = Text.Megaparsec.Char.anyChar
|
||||
|
||||
string = fmap Data.Text.Lazy.unpack . Text.Megaparsec.Char.string . fromString
|
||||
string = fmap Data.Text.unpack . Text.Megaparsec.Char.string . fromString
|
||||
|
||||
text = fmap Data.Text.Lazy.toStrict . Text.Megaparsec.Char.string . Data.Text.Lazy.fromStrict
|
||||
text = Text.Megaparsec.Char.string
|
||||
|
||||
instance TokenParsing Parser where
|
||||
someSpace =
|
||||
|
|
@ -166,9 +162,8 @@ star p = plus p <|> pure mempty
|
|||
plus :: (Alternative f, Monoid a) => f a -> f a
|
||||
plus p = mappend <$> p <*> star p
|
||||
|
||||
satisfy :: (Char -> Bool) -> Parser Builder
|
||||
satisfy predicate =
|
||||
fmap Data.Text.Lazy.Builder.singleton (Text.Parser.Char.satisfy predicate)
|
||||
satisfy :: (Char -> Bool) -> Parser Text
|
||||
satisfy = fmap Data.Text.singleton . Text.Parser.Char.satisfy
|
||||
|
||||
blockComment :: Parser ()
|
||||
blockComment = do
|
||||
|
|
@ -266,7 +261,7 @@ simpleLabel = try (do
|
|||
c <- Text.Parser.Char.satisfy headCharacter
|
||||
cs <- many (Text.Parser.Char.satisfy tailCharacter)
|
||||
let string = c:cs
|
||||
let text = Data.Text.Lazy.pack string
|
||||
let text = Data.Text.pack string
|
||||
Control.Monad.guard (not (Data.HashSet.member text reservedIdentifiers))
|
||||
return text )
|
||||
where
|
||||
|
|
@ -279,7 +274,7 @@ backtickLabel = do
|
|||
_ <- Text.Parser.Char.char '`'
|
||||
t <- some (Text.Parser.Char.satisfy predicate)
|
||||
_ <- Text.Parser.Char.char '`'
|
||||
return (Data.Text.Lazy.pack t)
|
||||
return (Data.Text.pack t)
|
||||
where
|
||||
predicate c = alpha c || digit c || elem c ("-/_:." :: String)
|
||||
|
||||
|
|
@ -328,7 +323,7 @@ doubleQuotedChunk embedded =
|
|||
|
||||
unescapedCharacter = do
|
||||
c <- Text.Parser.Char.satisfy predicate
|
||||
return (Chunks [] (Data.Text.Lazy.Builder.singleton c))
|
||||
return (Chunks [] (Data.Text.singleton c))
|
||||
where
|
||||
predicate c =
|
||||
('\x20' <= c && c <= '\x21' )
|
||||
|
|
@ -349,7 +344,7 @@ doubleQuotedChunk embedded =
|
|||
, tab
|
||||
, unicode
|
||||
]
|
||||
return (Chunks [] (Data.Text.Lazy.Builder.singleton c))
|
||||
return (Chunks [] (Data.Text.singleton c))
|
||||
where
|
||||
quotationMark = Text.Parser.Char.char '"'
|
||||
|
||||
|
|
@ -392,26 +387,25 @@ doubleQuotedLiteral embedded = do
|
|||
--
|
||||
-- This also doesn't include the surrounding quotes since they would interfere
|
||||
-- with the whitespace detection
|
||||
buildChunks :: Chunks s a -> Builder
|
||||
buildChunks :: Chunks s a -> Text
|
||||
buildChunks (Chunks a b) = foldMap buildChunk a <> escapeText b
|
||||
where
|
||||
buildChunk :: (Text, Expr s a) -> Text
|
||||
buildChunk (c, _) = escapeText c <> "${x}"
|
||||
|
||||
dedent :: Chunks Src a -> Chunks Src a
|
||||
dedent chunks0 = process chunks0
|
||||
where
|
||||
builder0 = buildChunks chunks0
|
||||
text0 = buildChunks chunks0
|
||||
|
||||
text0 = Data.Text.Lazy.Builder.toLazyText builder0
|
||||
lines0 = Data.Text.lines text0
|
||||
|
||||
lines0 = Data.Text.Lazy.lines text0
|
||||
|
||||
isEmpty = Data.Text.Lazy.all Data.Char.isSpace
|
||||
isEmpty = Data.Text.all Data.Char.isSpace
|
||||
|
||||
nonEmptyLines = filter (not . isEmpty) lines0
|
||||
|
||||
indentLength line =
|
||||
Data.Text.Lazy.length (Data.Text.Lazy.takeWhile Data.Char.isSpace line)
|
||||
Data.Text.length (Data.Text.takeWhile Data.Char.isSpace line)
|
||||
|
||||
shortestIndent = case nonEmptyLines of
|
||||
[] -> 0
|
||||
|
|
@ -424,22 +418,18 @@ dedent chunks0 = process chunks0
|
|||
-- This is the trim function we use up until the first variable
|
||||
-- interpolation, dedenting all lines
|
||||
trimBegin =
|
||||
build
|
||||
. Data.Text.Lazy.intercalate "\n"
|
||||
. map (Data.Text.Lazy.drop shortestIndent)
|
||||
. Data.Text.Lazy.splitOn "\n"
|
||||
. Data.Text.Lazy.Builder.toLazyText
|
||||
Data.Text.intercalate "\n"
|
||||
. map (Data.Text.drop shortestIndent)
|
||||
. Data.Text.splitOn "\n"
|
||||
|
||||
-- This is the trim function we use after each variable interpolation
|
||||
-- where we indent each line except the first line (since it's not a true
|
||||
-- beginning of a line)
|
||||
trimContinue builder = build (Data.Text.Lazy.intercalate "\n" lines_)
|
||||
trimContinue text = Data.Text.intercalate "\n" lines_
|
||||
where
|
||||
text = Data.Text.Lazy.Builder.toLazyText builder
|
||||
|
||||
lines_ = case Data.Text.Lazy.splitOn "\n" text of
|
||||
lines_ = case Data.Text.splitOn "\n" text of
|
||||
[] -> []
|
||||
l:ls -> l:map (Data.Text.Lazy.drop shortestIndent) ls
|
||||
l:ls -> l:map (Data.Text.drop shortestIndent) ls
|
||||
|
||||
-- This is the loop that drives whether or not to use `trimBegin` or
|
||||
-- `trimContinue`. We call this function with `trimBegin`, but after the
|
||||
|
|
@ -464,7 +454,7 @@ singleQuoteContinue embedded =
|
|||
]
|
||||
where
|
||||
escapeSingleQuotes = do
|
||||
_ <- "'''" :: Parser Builder
|
||||
_ <- "'''" :: Parser Text
|
||||
b <- singleQuoteContinue embedded
|
||||
return ("''" <> b)
|
||||
|
||||
|
|
@ -787,10 +777,10 @@ pathCharacter c =
|
|||
|
||||
pathComponent :: Parser Text
|
||||
pathComponent = do
|
||||
_ <- "/" :: Parser Builder
|
||||
_ <- "/" :: Parser Text
|
||||
string <- some (Text.Parser.Char.satisfy pathCharacter)
|
||||
|
||||
return (Data.Text.Lazy.pack string)
|
||||
return (Data.Text.pack string)
|
||||
|
||||
file_ :: Parser File
|
||||
file_ = do
|
||||
|
|
@ -811,19 +801,19 @@ localRaw =
|
|||
]
|
||||
where
|
||||
parentPath = do
|
||||
_ <- ".." :: Parser Builder
|
||||
_ <- ".." :: Parser Text
|
||||
File (Directory segments) final <- file_
|
||||
|
||||
return (Local Here (File (Directory (segments ++ [".."])) final))
|
||||
|
||||
herePath = do
|
||||
_ <- "." :: Parser Builder
|
||||
_ <- "." :: Parser Text
|
||||
file <- file_
|
||||
|
||||
return (Local Here file)
|
||||
|
||||
homePath = do
|
||||
_ <- "~" :: Parser Builder
|
||||
_ <- "~" :: Parser Text
|
||||
file <- file_
|
||||
|
||||
return (Local Home file)
|
||||
|
|
@ -839,43 +829,40 @@ local = do
|
|||
whitespace
|
||||
return a
|
||||
|
||||
scheme :: Parser Builder
|
||||
scheme :: Parser Text
|
||||
scheme = "http" <> option "s"
|
||||
|
||||
httpRaw :: Parser (Text, File, Text)
|
||||
httpRaw = do
|
||||
prefix <- scheme <> "://" <> authority
|
||||
prefixText <- scheme <> "://" <> authority
|
||||
file <- file_
|
||||
suffix <- option ("?" <> query) <> option ("#" <> fragment)
|
||||
|
||||
let prefixText = Data.Text.Lazy.Builder.toLazyText prefix
|
||||
let suffixText = Data.Text.Lazy.Builder.toLazyText suffix
|
||||
suffixText <- option ("?" <> query) <> option ("#" <> fragment)
|
||||
|
||||
return (prefixText, file, suffixText)
|
||||
|
||||
authority :: Parser Builder
|
||||
authority :: Parser Text
|
||||
authority = option (try (userinfo <> "@")) <> host <> option (":" <> port)
|
||||
|
||||
userinfo :: Parser Builder
|
||||
userinfo :: Parser Text
|
||||
userinfo = star (satisfy predicate <|> pctEncoded)
|
||||
where
|
||||
predicate c = unreserved c || subDelims c || c == ':'
|
||||
|
||||
host :: Parser Builder
|
||||
host :: Parser Text
|
||||
host = choice [ ipLiteral, ipV4Address, regName ]
|
||||
|
||||
port :: Parser Builder
|
||||
port :: Parser Text
|
||||
port = star (satisfy digit)
|
||||
|
||||
ipLiteral :: Parser Builder
|
||||
ipLiteral :: Parser Text
|
||||
ipLiteral = "[" <> (ipV6Address <|> ipVFuture) <> "]"
|
||||
|
||||
ipVFuture :: Parser Builder
|
||||
ipVFuture :: Parser Text
|
||||
ipVFuture = "v" <> plus (satisfy hexdig) <> "." <> plus (satisfy predicate)
|
||||
where
|
||||
predicate c = unreserved c || subDelims c || c == ':'
|
||||
|
||||
ipV6Address :: Parser Builder
|
||||
ipV6Address :: Parser Text
|
||||
ipV6Address =
|
||||
choice
|
||||
[ try alternative0
|
||||
|
|
@ -919,16 +906,16 @@ ipV6Address =
|
|||
alternative8 =
|
||||
option (range 0 6 (h16 <> ":") <> h16) <> "::"
|
||||
|
||||
h16 :: Parser Builder
|
||||
h16 :: Parser Text
|
||||
h16 = range 1 3 (satisfy hexdig)
|
||||
|
||||
ls32 :: Parser Builder
|
||||
ls32 :: Parser Text
|
||||
ls32 = (h16 <> ":" <> h16) <|> ipV4Address
|
||||
|
||||
ipV4Address :: Parser Builder
|
||||
ipV4Address :: Parser Text
|
||||
ipV4Address = decOctet <> "." <> decOctet <> "." <> decOctet <> "." <> decOctet
|
||||
|
||||
decOctet :: Parser Builder
|
||||
decOctet :: Parser Text
|
||||
decOctet =
|
||||
choice
|
||||
[ try alternative4
|
||||
|
|
@ -954,27 +941,27 @@ decOctet =
|
|||
where
|
||||
predicate c = '\x30' <= c && c <= '\x35'
|
||||
|
||||
regName :: Parser Builder
|
||||
regName :: Parser Text
|
||||
regName = star (satisfy predicate <|> pctEncoded)
|
||||
where
|
||||
predicate c = unreserved c || subDelims c
|
||||
|
||||
pchar :: Parser Builder
|
||||
pchar :: Parser Text
|
||||
pchar = satisfy predicate <|> pctEncoded
|
||||
where
|
||||
predicate c = unreserved c || subDelims c || c == ':' || c == '@'
|
||||
|
||||
query :: Parser Builder
|
||||
query :: Parser Text
|
||||
query = star (pchar <|> satisfy predicate)
|
||||
where
|
||||
predicate c = c == '/' || c == '?'
|
||||
|
||||
fragment :: Parser Builder
|
||||
fragment :: Parser Text
|
||||
fragment = star (pchar <|> satisfy predicate)
|
||||
where
|
||||
predicate c = c == '/' || c == '?'
|
||||
|
||||
pctEncoded :: Parser Builder
|
||||
pctEncoded :: Parser Text
|
||||
pctEncoded = "%" <> count 2 (satisfy hexdig)
|
||||
|
||||
unreserved :: Char -> Bool
|
||||
|
|
@ -1000,27 +987,25 @@ env = do
|
|||
whitespace
|
||||
return (Env a)
|
||||
where
|
||||
alternative0 = do
|
||||
a <- bashEnvironmentVariable
|
||||
return (Data.Text.Lazy.Builder.toLazyText a)
|
||||
alternative0 = bashEnvironmentVariable
|
||||
|
||||
alternative1 = do
|
||||
_ <- Text.Parser.Char.char '"'
|
||||
a <- posixEnvironmentVariable
|
||||
_ <- Text.Parser.Char.char '"'
|
||||
return (Data.Text.Lazy.Builder.toLazyText a)
|
||||
return a
|
||||
|
||||
bashEnvironmentVariable :: Parser Builder
|
||||
bashEnvironmentVariable :: Parser Text
|
||||
bashEnvironmentVariable = satisfy predicate0 <> star (satisfy predicate1)
|
||||
where
|
||||
predicate0 c = alpha c || c == '_'
|
||||
|
||||
predicate1 c = alpha c || digit c || c == '_'
|
||||
|
||||
posixEnvironmentVariable :: Parser Builder
|
||||
posixEnvironmentVariable :: Parser Text
|
||||
posixEnvironmentVariable = plus posixEnvironmentVariableCharacter
|
||||
|
||||
posixEnvironmentVariableCharacter :: Parser Builder
|
||||
posixEnvironmentVariableCharacter :: Parser Text
|
||||
posixEnvironmentVariableCharacter =
|
||||
("\\" <> satisfy predicate0) <|> satisfy predicate1
|
||||
where
|
||||
|
|
@ -1547,7 +1532,7 @@ toMap kvs = do
|
|||
then pure v
|
||||
else
|
||||
Text.Parser.Combinators.unexpected
|
||||
("duplicate field: " ++ Data.Text.Lazy.unpack k)
|
||||
("duplicate field: " ++ Data.Text.unpack k)
|
||||
Data.HashMap.Strict.InsOrd.traverseWithKey action m
|
||||
where
|
||||
fromListWith combine = Data.List.foldl' snoc nil
|
||||
|
|
@ -1576,11 +1561,9 @@ importHashed_ = do
|
|||
where
|
||||
importHash_ = do
|
||||
_ <- Text.Parser.Char.text "sha256:"
|
||||
builder <- count 64 (satisfy hexdig <?> "hex digit")
|
||||
text <- count 64 (satisfy hexdig <?> "hex digit")
|
||||
whitespace
|
||||
let lazyText = Data.Text.Lazy.Builder.toLazyText builder
|
||||
let lazyBytes16 = Data.Text.Lazy.Encoding.encodeUtf8 lazyText
|
||||
let strictBytes16 = Data.ByteString.Lazy.toStrict lazyBytes16
|
||||
let strictBytes16 = Data.Text.Encoding.encodeUtf8 text
|
||||
strictBytes <- case Data.ByteArray.Encoding.convertFromBase Base16 strictBytes16 of
|
||||
Left string -> fail string
|
||||
Right strictBytes -> return (strictBytes :: Data.ByteString.ByteString)
|
||||
|
|
@ -1633,7 +1616,7 @@ exprAndHeaderFromText
|
|||
-> Either ParseError (Text, Expr Src Import)
|
||||
exprAndHeaderFromText delta text = case result of
|
||||
Left errInfo -> Left (ParseError { unwrap = errInfo, input = text })
|
||||
Right (txt, r) -> Right (Data.Text.Lazy.dropWhileEnd (/= '\n') txt, r)
|
||||
Right (txt, r) -> Right (Data.Text.dropWhileEnd (/= '\n') txt, r)
|
||||
where
|
||||
parser = do
|
||||
(bytes, _) <- Text.Megaparsec.match whitespace
|
||||
|
|
|
|||
|
|
@ -61,8 +61,7 @@ import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
|
|||
import Data.Monoid ((<>))
|
||||
import Data.Scientific (Scientific)
|
||||
import Data.Set (Set)
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text.Lazy.Builder (Builder)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Prettyprint.Doc (Doc, Pretty, space)
|
||||
import Formatting.Buildable (Buildable(..))
|
||||
import Numeric.Natural (Natural)
|
||||
|
|
@ -74,7 +73,8 @@ import qualified Data.HashMap.Strict.InsOrd
|
|||
import qualified Data.HashSet
|
||||
import qualified Data.List
|
||||
import qualified Data.Set
|
||||
import qualified Data.Text.Lazy as Text
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lazy
|
||||
import qualified Data.Text.Lazy.Builder as Builder
|
||||
import qualified Data.Text.Prettyprint.Doc as Pretty
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
|
||||
|
|
@ -313,25 +313,21 @@ prettyChunks (Chunks a b) =
|
|||
short =
|
||||
literal "\"" <> foldMap prettyChunk a <> literal (prettyText b <> "\"")
|
||||
|
||||
hasNewLine builder = Text.any (== '\n') lazyText
|
||||
where
|
||||
lazyText = Builder.toLazyText builder
|
||||
hasNewLine = Text.any (== '\n')
|
||||
|
||||
prettyMultilineChunk (c, d) =
|
||||
prettyMultilineBuilder c <> dollar <> lbrace <> prettyExprA d <> rbrace
|
||||
|
||||
prettyMultilineBuilder builder = literal (mconcat docs)
|
||||
where
|
||||
lazyText = Builder.toLazyText (escapeSingleQuotedText builder)
|
||||
|
||||
lazyLines = Text.splitOn "\n" lazyText
|
||||
lazyLines = Text.splitOn "\n" (escapeSingleQuotedText builder)
|
||||
|
||||
docs =
|
||||
Data.List.intersperse Pretty.hardline (fmap Pretty.pretty lazyLines)
|
||||
|
||||
prettyChunk (c, d) = prettyText c <> syntax "${" <> prettyExprA d <> syntax rbrace
|
||||
|
||||
prettyText t = literal (Pretty.pretty (Builder.toLazyText (escapeText t)))
|
||||
prettyText t = literal (Pretty.pretty (escapeText t))
|
||||
|
||||
prettyConst :: Const -> Doc Ann
|
||||
prettyConst Type = builtin "Type"
|
||||
|
|
@ -826,56 +822,54 @@ prettyUnionLit a b c =
|
|||
|
||||
-- | Pretty-print a value
|
||||
pretty :: Pretty a => a -> Text
|
||||
pretty = Pretty.renderLazy . Pretty.layoutPretty options . Pretty.pretty
|
||||
pretty = Pretty.renderStrict . Pretty.layoutPretty options . Pretty.pretty
|
||||
where
|
||||
options = Pretty.LayoutOptions { Pretty.layoutPageWidth = Pretty.Unbounded }
|
||||
|
||||
-- | Builder corresponding to the @label@ token in "Dhall.Parser"
|
||||
buildLabel :: Text -> Builder
|
||||
-- | Text corresponding to the @label@ token in "Dhall.Parser"
|
||||
buildLabel :: Text -> Text
|
||||
buildLabel l = case Text.uncons l of
|
||||
Just (h, t)
|
||||
| headCharacter h && Text.all tailCharacter t && not (Data.HashSet.member l reservedIdentifiers)
|
||||
-> build l
|
||||
_ -> "`" <> build l <> "`"
|
||||
-> l
|
||||
_ -> "`" <> l <> "`"
|
||||
|
||||
|
||||
-- | Builder corresponding to the @number@ token in "Dhall.Parser"
|
||||
buildNumber :: Integer -> Builder
|
||||
buildNumber a = build (show a)
|
||||
-- | Text corresponding to the @number@ token in "Dhall.Parser"
|
||||
buildNumber :: Integer -> Text
|
||||
buildNumber = Text.pack . show
|
||||
|
||||
-- | Builder corresponding to the @natural@ token in "Dhall.Parser"
|
||||
buildNatural :: Natural -> Builder
|
||||
buildNatural a = build (show a)
|
||||
-- | Text corresponding to the @natural@ token in "Dhall.Parser"
|
||||
buildNatural :: Natural -> Text
|
||||
buildNatural = Text.pack . show
|
||||
|
||||
-- | Builder corresponding to the @double@ token in "Dhall.Parser"
|
||||
buildScientific :: Scientific -> Builder
|
||||
buildScientific = build . show
|
||||
-- | Text corresponding to the @double@ token in "Dhall.Parser"
|
||||
buildScientific :: Scientific -> Text
|
||||
buildScientific = Text.pack . show
|
||||
|
||||
-- | Builder corresponding to the @text@ token in "Dhall.Parser"
|
||||
buildChunks :: Buildable a => Chunks s a -> Builder
|
||||
-- | Text corresponding to the @text@ token in "Dhall.Parser"
|
||||
buildChunks :: Buildable a => Chunks s a -> Text
|
||||
buildChunks (Chunks a b) = "\"" <> foldMap buildChunk a <> escapeText b <> "\""
|
||||
where
|
||||
buildChunk (c, d) = escapeText c <> "${" <> buildExprA d <> "}"
|
||||
|
||||
-- | Escape a `Builder` literal using Dhall's escaping rules for single-quoted
|
||||
-- | Escape a `Text` literal using Dhall's escaping rules for single-quoted
|
||||
-- @Text@
|
||||
escapeSingleQuotedText :: Builder -> Builder
|
||||
escapeSingleQuotedText :: Text -> Text
|
||||
escapeSingleQuotedText inputBuilder = outputBuilder
|
||||
where
|
||||
inputText = Builder.toLazyText inputBuilder
|
||||
outputText = substitute "${" "''${" (substitute "''" "'''" inputBuilder)
|
||||
|
||||
outputText = substitute "${" "''${" (substitute "''" "'''" inputText)
|
||||
|
||||
outputBuilder = Builder.fromLazyText outputText
|
||||
outputBuilder = outputText
|
||||
|
||||
substitute before after = Text.intercalate after . Text.splitOn before
|
||||
|
||||
{-| Escape a `Builder` literal using Dhall's escaping rules
|
||||
|
||||
{-| Escape a `Text` literal using Dhall's escaping rules
|
||||
|
||||
Note that the result does not include surrounding quotes
|
||||
-}
|
||||
escapeText :: Builder -> Builder
|
||||
escapeText a = Builder.fromLazyText (Text.concatMap adapt text)
|
||||
escapeText :: Text -> Text
|
||||
escapeText text = Text.concatMap adapt text
|
||||
where
|
||||
adapt c
|
||||
| '\x20' <= c && c <= '\x21' = Text.singleton c
|
||||
|
|
@ -905,20 +899,18 @@ escapeText a = Builder.fromLazyText (Text.concatMap adapt text)
|
|||
| n < 10 = Data.Char.chr (Data.Char.ord '0' + n)
|
||||
| otherwise = Data.Char.chr (Data.Char.ord 'A' + n - 10)
|
||||
|
||||
text = Builder.toLazyText a
|
||||
|
||||
-- | Builder corresponding to the @expr@ parser in "Dhall.Parser"
|
||||
buildExpr :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @expr@ parser in "Dhall.Parser"
|
||||
buildExpr :: Buildable a => Expr s a -> Text
|
||||
buildExpr = buildExprA
|
||||
|
||||
-- | Builder corresponding to the @exprA@ parser in "Dhall.Parser"
|
||||
buildExprA :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprA@ parser in "Dhall.Parser"
|
||||
buildExprA :: Buildable a => Expr s a -> Text
|
||||
buildExprA (Annot a b) = buildExprB a <> " : " <> buildExprA b
|
||||
buildExprA (Note _ b) = buildExprA b
|
||||
buildExprA a = buildExprB a
|
||||
|
||||
-- | Builder corresponding to the @exprB@ parser in "Dhall.Parser"
|
||||
buildExprB :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprB@ parser in "Dhall.Parser"
|
||||
buildExprB :: Buildable a => Expr s a -> Text
|
||||
buildExprB (Lam a b c) =
|
||||
"λ("
|
||||
<> buildLabel a
|
||||
|
|
@ -975,91 +967,91 @@ buildExprB (Note _ b) =
|
|||
buildExprB a =
|
||||
buildExprC a
|
||||
|
||||
-- | Builder corresponding to the @exprC@ parser in "Dhall.Parser"
|
||||
buildExprC :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC@ parser in "Dhall.Parser"
|
||||
buildExprC :: Buildable a => Expr s a -> Text
|
||||
buildExprC = buildExprC0
|
||||
|
||||
-- | Builder corresponding to the @exprC0@ parser in "Dhall.Parser"
|
||||
buildExprC0 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC0@ parser in "Dhall.Parser"
|
||||
buildExprC0 :: Buildable a => Expr s a -> Text
|
||||
buildExprC0 (BoolOr a b) = buildExprC1 a <> " || " <> buildExprC0 b
|
||||
buildExprC0 (Note _ b) = buildExprC0 b
|
||||
buildExprC0 a = buildExprC1 a
|
||||
|
||||
-- | Builder corresponding to the @exprC1@ parser in "Dhall.Parser"
|
||||
buildExprC1 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC1@ parser in "Dhall.Parser"
|
||||
buildExprC1 :: Buildable a => Expr s a -> Text
|
||||
buildExprC1 (TextAppend a b) = buildExprC2 a <> " ++ " <> buildExprC1 b
|
||||
buildExprC1 (Note _ b) = buildExprC1 b
|
||||
buildExprC1 a = buildExprC2 a
|
||||
|
||||
-- | Builder corresponding to the @exprC2@ parser in "Dhall.Parser"
|
||||
buildExprC2 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC2@ parser in "Dhall.Parser"
|
||||
buildExprC2 :: Buildable a => Expr s a -> Text
|
||||
buildExprC2 (NaturalPlus a b) = buildExprC3 a <> " + " <> buildExprC2 b
|
||||
buildExprC2 (Note _ b) = buildExprC2 b
|
||||
buildExprC2 a = buildExprC3 a
|
||||
|
||||
-- | Builder corresponding to the @exprC3@ parser in "Dhall.Parser"
|
||||
buildExprC3 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC3@ parser in "Dhall.Parser"
|
||||
buildExprC3 :: Buildable a => Expr s a -> Text
|
||||
buildExprC3 (ListAppend a b) = buildExprC4 a <> " # " <> buildExprC3 b
|
||||
buildExprC3 (Note _ b) = buildExprC3 b
|
||||
buildExprC3 a = buildExprC4 a
|
||||
|
||||
-- | Builder corresponding to the @exprC4@ parser in "Dhall.Parser"
|
||||
buildExprC4 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC4@ parser in "Dhall.Parser"
|
||||
buildExprC4 :: Buildable a => Expr s a -> Text
|
||||
buildExprC4 (BoolAnd a b) = buildExprC5 a <> " && " <> buildExprC4 b
|
||||
buildExprC4 (Note _ b) = buildExprC4 b
|
||||
buildExprC4 a = buildExprC5 a
|
||||
|
||||
-- | Builder corresponding to the @exprC5@ parser in "Dhall.Parser"
|
||||
buildExprC5 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC5@ parser in "Dhall.Parser"
|
||||
buildExprC5 :: Buildable a => Expr s a -> Text
|
||||
buildExprC5 (Combine a b) = buildExprC6 a <> " ∧ " <> buildExprC5 b
|
||||
buildExprC5 (Note _ b) = buildExprC5 b
|
||||
buildExprC5 a = buildExprC6 a
|
||||
|
||||
-- | Builder corresponding to the @exprC6@ parser in "Dhall.Parser"
|
||||
buildExprC6 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC6@ parser in "Dhall.Parser"
|
||||
buildExprC6 :: Buildable a => Expr s a -> Text
|
||||
buildExprC6 (Prefer a b) = buildExprC7 a <> " ⫽ " <> buildExprC6 b
|
||||
buildExprC6 (Note _ b) = buildExprC6 b
|
||||
buildExprC6 a = buildExprC7 a
|
||||
|
||||
-- | Builder corresponding to the @exprC7@ parser in "Dhall.Parser"
|
||||
buildExprC7 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC7@ parser in "Dhall.Parser"
|
||||
buildExprC7 :: Buildable a => Expr s a -> Text
|
||||
buildExprC7 (CombineTypes a b) = buildExprC8 a <> " ⩓ " <> buildExprC7 b
|
||||
buildExprC7 (Note _ b) = buildExprC7 b
|
||||
buildExprC7 a = buildExprC8 a
|
||||
|
||||
-- | Builder corresponding to the @exprC8@ parser in "Dhall.Parser"
|
||||
buildExprC8 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC8@ parser in "Dhall.Parser"
|
||||
buildExprC8 :: Buildable a => Expr s a -> Text
|
||||
buildExprC8 (NaturalTimes a b) = buildExprC9 a <> " * " <> buildExprC8 b
|
||||
buildExprC8 (Note _ b) = buildExprC8 b
|
||||
buildExprC8 a = buildExprC9 a
|
||||
|
||||
-- | Builder corresponding to the @exprC9@ parser in "Dhall.Parser"
|
||||
buildExprC9 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC9@ parser in "Dhall.Parser"
|
||||
buildExprC9 :: Buildable a => Expr s a -> Text
|
||||
buildExprC9 (BoolEQ a b) = buildExprC10 a <> " == " <> buildExprC9 b
|
||||
buildExprC9 (Note _ b) = buildExprC9 b
|
||||
buildExprC9 a = buildExprC10 a
|
||||
|
||||
-- | Builder corresponding to the @exprC10@ parser in "Dhall.Parser"
|
||||
buildExprC10 :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprC10@ parser in "Dhall.Parser"
|
||||
buildExprC10 :: Buildable a => Expr s a -> Text
|
||||
buildExprC10 (BoolNE a b) = buildExprD a <> " != " <> buildExprC10 b
|
||||
buildExprC10 (Note _ b) = buildExprC10 b
|
||||
buildExprC10 a = buildExprD a
|
||||
|
||||
-- | Builder corresponding to the @exprD@ parser in "Dhall.Parser"
|
||||
buildExprD :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprD@ parser in "Dhall.Parser"
|
||||
buildExprD :: Buildable a => Expr s a -> Text
|
||||
buildExprD (App a b) = buildExprD a <> " " <> buildExprE b
|
||||
buildExprD (Constructors b) = "constructors " <> buildExprE b
|
||||
buildExprD (Note _ b) = buildExprD b
|
||||
buildExprD a = buildExprE a
|
||||
|
||||
-- | Builder corresponding to the @exprE@ parser in "Dhall.Parser"
|
||||
buildExprE :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprE@ parser in "Dhall.Parser"
|
||||
buildExprE :: Buildable a => Expr s a -> Text
|
||||
buildExprE (Field a b) = buildExprE a <> "." <> buildLabel b
|
||||
buildExprE (Note _ b) = buildExprE b
|
||||
buildExprE a = buildExprF a
|
||||
|
||||
-- | Builder corresponding to the @exprF@ parser in "Dhall.Parser"
|
||||
buildExprF :: Buildable a => Expr s a -> Builder
|
||||
-- | Text corresponding to the @exprF@ parser in "Dhall.Parser"
|
||||
buildExprF :: Buildable a => Expr s a -> Text
|
||||
buildExprF (Var a) =
|
||||
buildVar a
|
||||
buildExprF (Const k) =
|
||||
|
|
@ -1138,71 +1130,71 @@ buildExprF (UnionLit a b c) =
|
|||
buildExprF (ListLit Nothing b) =
|
||||
"[" <> buildElems (Data.Foldable.toList b) <> "]"
|
||||
buildExprF (Embed a) =
|
||||
build a
|
||||
Data.Text.Lazy.toStrict . Builder.toLazyText $ build a
|
||||
buildExprF (Note _ b) =
|
||||
buildExprF b
|
||||
buildExprF a =
|
||||
"(" <> buildExprA a <> ")"
|
||||
|
||||
-- | Builder corresponding to the @const@ parser in "Dhall.Parser"
|
||||
buildConst :: Const -> Builder
|
||||
-- | Text corresponding to the @const@ parser in "Dhall.Parser"
|
||||
buildConst :: Const -> Text
|
||||
buildConst Type = "Type"
|
||||
buildConst Kind = "Kind"
|
||||
|
||||
-- | Builder corresponding to the @var@ parser in "Dhall.Parser"
|
||||
buildVar :: Var -> Builder
|
||||
-- | Text corresponding to the @var@ parser in "Dhall.Parser"
|
||||
buildVar :: Var -> Text
|
||||
buildVar (V x 0) = buildLabel x
|
||||
buildVar (V x n) = buildLabel x <> "@" <> buildNumber n
|
||||
|
||||
-- | Builder corresponding to the @elems@ parser in "Dhall.Parser"
|
||||
buildElems :: Buildable a => [Expr s a] -> Builder
|
||||
-- | Text corresponding to the @elems@ parser in "Dhall.Parser"
|
||||
buildElems :: Buildable a => [Expr s a] -> Text
|
||||
buildElems [] = ""
|
||||
buildElems [a] = buildExprA a
|
||||
buildElems (a:bs) = buildExprA a <> ", " <> buildElems bs
|
||||
|
||||
-- | Builder corresponding to the @recordLit@ parser in "Dhall.Parser"
|
||||
buildRecordLit :: Buildable a => InsOrdHashMap Text (Expr s a) -> Builder
|
||||
-- | Text corresponding to the @recordLit@ parser in "Dhall.Parser"
|
||||
buildRecordLit :: Buildable a => InsOrdHashMap Text (Expr s a) -> Text
|
||||
buildRecordLit a | Data.HashMap.Strict.InsOrd.null a =
|
||||
"{=}"
|
||||
buildRecordLit a =
|
||||
"{ " <> buildFieldValues (Data.HashMap.Strict.InsOrd.toList a) <> " }"
|
||||
|
||||
-- | Builder corresponding to the @fieldValues@ parser in "Dhall.Parser"
|
||||
buildFieldValues :: Buildable a => [(Text, Expr s a)] -> Builder
|
||||
-- | Text corresponding to the @fieldValues@ parser in "Dhall.Parser"
|
||||
buildFieldValues :: Buildable a => [(Text, Expr s a)] -> Text
|
||||
buildFieldValues [] = ""
|
||||
buildFieldValues [a] = buildFieldValue a
|
||||
buildFieldValues (a:bs) = buildFieldValue a <> ", " <> buildFieldValues bs
|
||||
|
||||
-- | Builder corresponding to the @fieldValue@ parser in "Dhall.Parser"
|
||||
buildFieldValue :: Buildable a => (Text, Expr s a) -> Builder
|
||||
-- | Text corresponding to the @fieldValue@ parser in "Dhall.Parser"
|
||||
buildFieldValue :: Buildable a => (Text, Expr s a) -> Text
|
||||
buildFieldValue (a, b) = buildLabel a <> " = " <> buildExprA b
|
||||
|
||||
-- | Builder corresponding to the @record@ parser in "Dhall.Parser"
|
||||
buildRecord :: Buildable a => InsOrdHashMap Text (Expr s a) -> Builder
|
||||
-- | Text corresponding to the @record@ parser in "Dhall.Parser"
|
||||
buildRecord :: Buildable a => InsOrdHashMap Text (Expr s a) -> Text
|
||||
buildRecord a | Data.HashMap.Strict.InsOrd.null a =
|
||||
"{}"
|
||||
buildRecord a =
|
||||
"{ " <> buildFieldTypes (Data.HashMap.Strict.InsOrd.toList a) <> " }"
|
||||
|
||||
-- | Builder corresponding to the @fieldTypes@ parser in "Dhall.Parser"
|
||||
buildFieldTypes :: Buildable a => [(Text, Expr s a)] -> Builder
|
||||
-- | Text corresponding to the @fieldTypes@ parser in "Dhall.Parser"
|
||||
buildFieldTypes :: Buildable a => [(Text, Expr s a)] -> Text
|
||||
buildFieldTypes [] = ""
|
||||
buildFieldTypes [a] = buildFieldType a
|
||||
buildFieldTypes (a:bs) = buildFieldType a <> ", " <> buildFieldTypes bs
|
||||
|
||||
-- | Builder corresponding to the @fieldType@ parser in "Dhall.Parser"
|
||||
buildFieldType :: Buildable a => (Text, Expr s a) -> Builder
|
||||
-- | Text corresponding to the @fieldType@ parser in "Dhall.Parser"
|
||||
buildFieldType :: Buildable a => (Text, Expr s a) -> Text
|
||||
buildFieldType (a, b) = buildLabel a <> " : " <> buildExprA b
|
||||
|
||||
-- | Builder corresponding to the @union@ parser in "Dhall.Parser"
|
||||
buildUnion :: Buildable a => InsOrdHashMap Text (Expr s a) -> Builder
|
||||
-- | Text corresponding to the @union@ parser in "Dhall.Parser"
|
||||
buildUnion :: Buildable a => InsOrdHashMap Text (Expr s a) -> Text
|
||||
buildUnion a | Data.HashMap.Strict.InsOrd.null a =
|
||||
"<>"
|
||||
buildUnion a =
|
||||
"< " <> buildAlternativeTypes (Data.HashMap.Strict.InsOrd.toList a) <> " >"
|
||||
|
||||
-- | Builder corresponding to the @alternativeTypes@ parser in "Dhall.Parser"
|
||||
buildAlternativeTypes :: Buildable a => [(Text, Expr s a)] -> Builder
|
||||
-- | Text corresponding to the @alternativeTypes@ parser in "Dhall.Parser"
|
||||
buildAlternativeTypes :: Buildable a => [(Text, Expr s a)] -> Text
|
||||
buildAlternativeTypes [] =
|
||||
""
|
||||
buildAlternativeTypes [a] =
|
||||
|
|
@ -1210,14 +1202,14 @@ buildAlternativeTypes [a] =
|
|||
buildAlternativeTypes (a:bs) =
|
||||
buildAlternativeType a <> " | " <> buildAlternativeTypes bs
|
||||
|
||||
-- | Builder corresponding to the @alternativeType@ parser in "Dhall.Parser"
|
||||
buildAlternativeType :: Buildable a => (Text, Expr s a) -> Builder
|
||||
-- | Text corresponding to the @alternativeType@ parser in "Dhall.Parser"
|
||||
buildAlternativeType :: Buildable a => (Text, Expr s a) -> Text
|
||||
buildAlternativeType (a, b) = buildLabel a <> " : " <> buildExprA b
|
||||
|
||||
-- | Builder corresponding to the @unionLit@ parser in "Dhall.Parser"
|
||||
-- | Text corresponding to the @unionLit@ parser in "Dhall.Parser"
|
||||
buildUnionLit
|
||||
:: Buildable a
|
||||
=> Text -> Expr s a -> InsOrdHashMap Text (Expr s a) -> Builder
|
||||
=> Text -> Expr s a -> InsOrdHashMap Text (Expr s a) -> Text
|
||||
buildUnionLit a b c
|
||||
| Data.HashMap.Strict.InsOrd.null c =
|
||||
"< "
|
||||
|
|
|
|||
|
|
@ -1,10 +1,9 @@
|
|||
module Dhall.Pretty.Internal where
|
||||
|
||||
import Data.Scientific (Scientific)
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text.Lazy.Builder (Builder)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Prettyprint.Doc (Pretty, Doc)
|
||||
import Formatting.Buildable (Buildable)
|
||||
import Formatting.Buildable (Buildable(..))
|
||||
import Numeric.Natural (Natural)
|
||||
import Prelude
|
||||
|
||||
|
|
@ -12,20 +11,20 @@ import {-# SOURCE #-} Dhall.Core
|
|||
|
||||
data Ann
|
||||
|
||||
buildConst :: Const -> Builder
|
||||
buildConst :: Const -> Text
|
||||
|
||||
buildVar :: Var -> Builder
|
||||
buildVar :: Var -> Text
|
||||
|
||||
buildExpr :: Buildable a => Expr s a -> Builder
|
||||
buildExpr :: Buildable a => Expr s a -> Text
|
||||
|
||||
prettyExpr :: Pretty a => Expr s a -> Doc Ann
|
||||
|
||||
buildNatural :: Natural -> Builder
|
||||
buildNatural :: Natural -> Text
|
||||
|
||||
buildNumber :: Integer -> Builder
|
||||
buildNumber :: Integer -> Text
|
||||
|
||||
buildScientific :: Scientific -> Builder
|
||||
buildScientific :: Scientific -> Text
|
||||
|
||||
pretty :: Pretty a => a -> Text
|
||||
|
||||
escapeText :: Builder -> Builder
|
||||
escapeText :: Text -> Text
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ import Data.Foldable (forM_, toList)
|
|||
import Data.Monoid ((<>))
|
||||
import Data.Sequence (Seq, ViewL(..))
|
||||
import Data.Set (Set)
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Lazy.Builder (Builder)
|
||||
import Data.Text.Prettyprint.Doc (Doc, Pretty(..))
|
||||
import Data.Traversable (forM)
|
||||
|
|
@ -39,7 +39,8 @@ import qualified Data.Foldable
|
|||
import qualified Data.HashMap.Strict.InsOrd
|
||||
import qualified Data.Sequence
|
||||
import qualified Data.Set
|
||||
import qualified Data.Text.Lazy as Text
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lazy
|
||||
import qualified Data.Text.Lazy.Builder as Builder
|
||||
import qualified Data.Text.Prettyprint.Doc as Pretty
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
|
||||
|
|
@ -54,7 +55,7 @@ traverseWithIndex_ k xs =
|
|||
Data.Foldable.sequenceA_ (Data.Sequence.mapWithIndex k xs)
|
||||
|
||||
docToLazyText :: Doc a -> Text
|
||||
docToLazyText = Pretty.renderLazy . Pretty.layoutPretty opts
|
||||
docToLazyText = Pretty.renderStrict . Pretty.layoutPretty opts
|
||||
where
|
||||
opts = Pretty.LayoutOptions { Pretty.layoutPageWidth = Pretty.Unbounded }
|
||||
|
||||
|
|
@ -3460,14 +3461,14 @@ data TypeError s a = TypeError
|
|||
} deriving (Typeable)
|
||||
|
||||
instance (Buildable a, Buildable s, Eq a, Pretty a) => Show (TypeError s a) where
|
||||
show = Text.unpack . Builder.toLazyText . build
|
||||
show = Data.Text.Lazy.unpack . Builder.toLazyText . build
|
||||
|
||||
instance (Buildable a, Buildable s, Eq a, Pretty a, Typeable a, Typeable s) => Exception (TypeError s a)
|
||||
|
||||
instance (Buildable a, Buildable s, Eq a, Pretty a) => Buildable (TypeError s a) where
|
||||
build (TypeError ctx expr msg)
|
||||
= "\n"
|
||||
<> ( if Text.null (Builder.toLazyText (buildContext ctx))
|
||||
<> ( if Data.Text.Lazy.null (Builder.toLazyText (buildContext ctx))
|
||||
then ""
|
||||
else buildContext ctx <> "\n"
|
||||
)
|
||||
|
|
@ -3478,7 +3479,7 @@ instance (Buildable a, Buildable s, Eq a, Pretty a) => Buildable (TypeError s a)
|
|||
|
||||
buildContext =
|
||||
build
|
||||
. Text.unlines
|
||||
. Data.Text.Lazy.unlines
|
||||
. map (Builder.toLazyText . buildKV)
|
||||
. reverse
|
||||
. Dhall.Context.toList
|
||||
|
|
@ -3494,14 +3495,14 @@ newtype DetailedTypeError s a = DetailedTypeError (TypeError s a)
|
|||
deriving (Typeable)
|
||||
|
||||
instance (Buildable a, Buildable s, Eq a, Pretty a) => Show (DetailedTypeError s a) where
|
||||
show = Text.unpack . Builder.toLazyText . build
|
||||
show = Data.Text.Lazy.unpack . Builder.toLazyText . build
|
||||
|
||||
instance (Buildable a, Buildable s, Eq a, Pretty a, Typeable a, Typeable s) => Exception (DetailedTypeError s a)
|
||||
|
||||
instance (Buildable a, Buildable s, Eq a, Pretty a) => Buildable (DetailedTypeError s a) where
|
||||
build (DetailedTypeError (TypeError ctx expr msg))
|
||||
= "\n"
|
||||
<> ( if Text.null (Builder.toLazyText (buildContext ctx))
|
||||
<> ( if Data.Text.Lazy.null (Builder.toLazyText (buildContext ctx))
|
||||
then ""
|
||||
else buildContext ctx <> "\n"
|
||||
)
|
||||
|
|
@ -3514,7 +3515,7 @@ instance (Buildable a, Buildable s, Eq a, Pretty a) => Buildable (DetailedTypeEr
|
|||
|
||||
buildContext =
|
||||
build
|
||||
. Text.unlines
|
||||
. Data.Text.Lazy.unlines
|
||||
. map (Builder.toLazyText . buildKV)
|
||||
. reverse
|
||||
. Dhall.Context.toList
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ import Test.Tasty (TestTree)
|
|||
|
||||
import qualified Control.Exception
|
||||
import qualified Data.Text
|
||||
import qualified Data.Text.Lazy.IO
|
||||
import qualified Data.Text.IO
|
||||
import qualified Data.Text.Prettyprint.Doc
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.Text
|
||||
import qualified Dhall.Parser
|
||||
|
|
@ -55,7 +55,7 @@ should name basename =
|
|||
Data.Text.unpack ("./tests/format/" <> basename <> "A.dhall")
|
||||
let outputFile =
|
||||
Data.Text.unpack ("./tests/format/" <> basename <> "B.dhall")
|
||||
inputText <- Data.Text.Lazy.IO.readFile inputFile
|
||||
inputText <- Data.Text.IO.readFile inputFile
|
||||
|
||||
expr <- case Dhall.Parser.exprFromText mempty inputText of
|
||||
Left err -> Control.Exception.throwIO err
|
||||
|
|
@ -63,9 +63,9 @@ should name basename =
|
|||
|
||||
let doc = Data.Text.Prettyprint.Doc.pretty expr
|
||||
let docStream = Data.Text.Prettyprint.Doc.layoutSmart opts doc
|
||||
let actualText = Data.Text.Prettyprint.Doc.Render.Text.renderLazy docStream
|
||||
let actualText = Data.Text.Prettyprint.Doc.Render.Text.renderStrict docStream
|
||||
|
||||
expectedText <- Data.Text.Lazy.IO.readFile outputFile
|
||||
expectedText <- Data.Text.IO.readFile outputFile
|
||||
|
||||
let message =
|
||||
"The formatted expression did not match the expected output"
|
||||
|
|
|
|||
|
|
@ -4,12 +4,12 @@
|
|||
module Normalization (normalizationTests) where
|
||||
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text (Text)
|
||||
import Dhall.Core (Expr)
|
||||
import Dhall.TypeCheck (X)
|
||||
|
||||
import qualified Control.Exception
|
||||
import qualified Data.Text.Lazy
|
||||
import qualified Data.Text
|
||||
import qualified Dhall.Core
|
||||
import qualified Dhall.Import
|
||||
import qualified Dhall.Parser
|
||||
|
|
@ -19,7 +19,7 @@ import Dhall.Core
|
|||
import Dhall.Context
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
import Util
|
||||
import Util
|
||||
|
||||
normalizationTests :: TestTree
|
||||
normalizationTests =
|
||||
|
|
@ -201,11 +201,11 @@ customization =
|
|||
|
||||
simpleCustomization :: TestTree
|
||||
simpleCustomization = testCase "simpleCustomization" $ do
|
||||
let tyCtx = insert "min" (Pi "_" Natural (Pi "_" Natural Natural)) empty
|
||||
let tyCtx = insert "min" (Pi "_" Natural (Pi "_" Natural Natural)) empty
|
||||
valCtx e = case e of
|
||||
(App (App (Var (V "min" 0)) (NaturalLit x)) (NaturalLit y)) -> Just (NaturalLit (min x y))
|
||||
_ -> Nothing
|
||||
e <- codeWith tyCtx "min (min 11 12) 8 + 1"
|
||||
e <- codeWith tyCtx "min (min 11 12) 8 + 1"
|
||||
assertNormalizesToWith valCtx e "9"
|
||||
|
||||
nestedReduction :: TestTree
|
||||
|
|
@ -217,7 +217,7 @@ nestedReduction = testCase "doubleReduction" $ do
|
|||
valCtx e = case e of
|
||||
(App (App (Var (V "min" 0)) (NaturalLit x)) (NaturalLit y)) -> Just (NaturalLit (min x y))
|
||||
(App (Var (V "wurble" 0)) (NaturalLit x)) -> Just
|
||||
(App (Var (V "fiveorless" 0)) (NaturalPlus (NaturalLit x) (NaturalLit 2)))
|
||||
(App (Var (V "fiveorless" 0)) (NaturalPlus (NaturalLit x) (NaturalLit 2)))
|
||||
(App (Var (V "fiveorless" 0)) (NaturalLit x)) -> Just
|
||||
(App (App (Var (V "min" 0)) (NaturalLit x)) (NaturalPlus (NaturalLit 3) (NaturalLit 2)))
|
||||
_ -> Nothing
|
||||
|
|
@ -226,7 +226,7 @@ nestedReduction = testCase "doubleReduction" $ do
|
|||
|
||||
should :: Text -> Text -> TestTree
|
||||
should name basename =
|
||||
Test.Tasty.HUnit.testCase (Data.Text.Lazy.unpack name) $ do
|
||||
Test.Tasty.HUnit.testCase (Data.Text.unpack name) $ do
|
||||
let actualCode = "./tests/normalization/" <> basename <> "A.dhall"
|
||||
let expectedCode = "./tests/normalization/" <> basename <> "B.dhall"
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ import Test.Tasty (TestTree)
|
|||
|
||||
import qualified Control.Exception
|
||||
import qualified Data.Text
|
||||
import qualified Data.Text.Lazy.IO
|
||||
import qualified Data.Text.IO
|
||||
import qualified Dhall.Parser
|
||||
import qualified Test.Tasty
|
||||
import qualified Test.Tasty.HUnit
|
||||
|
|
@ -138,7 +138,7 @@ parserTests =
|
|||
|
||||
shouldParse :: Text -> FilePath -> TestTree
|
||||
shouldParse name path = Test.Tasty.HUnit.testCase (Data.Text.unpack name) (do
|
||||
text <- Data.Text.Lazy.IO.readFile path
|
||||
text <- Data.Text.IO.readFile path
|
||||
case Dhall.Parser.exprFromText mempty text of
|
||||
Left err -> Control.Exception.throwIO err
|
||||
Right _ -> return () )
|
||||
|
|
|
|||
|
|
@ -3,11 +3,11 @@
|
|||
module TypeCheck where
|
||||
|
||||
import Data.Monoid (mempty, (<>))
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Text (Text)
|
||||
import Test.Tasty (TestTree)
|
||||
|
||||
import qualified Control.Exception
|
||||
import qualified Data.Text.Lazy
|
||||
import qualified Data.Text
|
||||
import qualified Dhall.Core
|
||||
import qualified Dhall.Import
|
||||
import qualified Dhall.Parser
|
||||
|
|
@ -47,7 +47,7 @@ typecheckTests =
|
|||
|
||||
should :: Text -> Text -> TestTree
|
||||
should name basename =
|
||||
Test.Tasty.HUnit.testCase (Data.Text.Lazy.unpack name) $ do
|
||||
Test.Tasty.HUnit.testCase (Data.Text.unpack name) $ do
|
||||
let actualCode = "./tests/typecheck/" <> basename <> "A.dhall"
|
||||
let expectedCode = "./tests/typecheck/" <> basename <> "B.dhall"
|
||||
|
||||
|
|
|
|||
|
|
@ -16,7 +16,6 @@ import qualified Control.Exception
|
|||
import qualified Data.Functor
|
||||
import Data.Bifunctor (first)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.Lazy
|
||||
import qualified Dhall.Core
|
||||
import Dhall.Core (Expr, Normalizer)
|
||||
import qualified Dhall.Context
|
||||
|
|
@ -28,19 +27,18 @@ import qualified Dhall.TypeCheck
|
|||
import Dhall.TypeCheck (X)
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
normalize' :: Expr Src X -> Data.Text.Lazy.Text
|
||||
normalize' :: Expr Src X -> Text
|
||||
normalize' = Dhall.Core.pretty . Dhall.Core.normalize
|
||||
|
||||
normalizeWith' :: Normalizer X -> Expr Src X -> Data.Text.Lazy.Text
|
||||
normalizeWith' :: Normalizer X -> Expr Src X -> Text
|
||||
normalizeWith' ctx = Dhall.Core.pretty . Dhall.Core.normalizeWith ctx
|
||||
|
||||
code :: Data.Text.Text -> IO (Expr Src X)
|
||||
code :: Text -> IO (Expr Src X)
|
||||
code = codeWith Dhall.Context.empty
|
||||
|
||||
codeWith :: Context (Expr Src X) -> Data.Text.Text -> IO (Expr Src X)
|
||||
codeWith ctx strictText = do
|
||||
let lazyText = Data.Text.Lazy.fromStrict strictText
|
||||
expr0 <- case Dhall.Parser.exprFromText mempty lazyText of
|
||||
codeWith :: Context (Expr Src X) -> Text -> IO (Expr Src X)
|
||||
codeWith ctx expr = do
|
||||
expr0 <- case Dhall.Parser.exprFromText mempty expr of
|
||||
Left parseError -> Control.Exception.throwIO parseError
|
||||
Right expr0 -> return expr0
|
||||
expr1 <- Dhall.Import.load expr0
|
||||
|
|
@ -49,19 +47,19 @@ codeWith ctx strictText = do
|
|||
Right _ -> return ()
|
||||
return expr1
|
||||
|
||||
equivalent :: Data.Text.Text -> Data.Text.Text -> IO ()
|
||||
equivalent :: Text -> Text -> IO ()
|
||||
equivalent text0 text1 = do
|
||||
expr0 <- fmap Dhall.Core.normalize (Util.code text0) :: IO (Expr X X)
|
||||
expr1 <- fmap Dhall.Core.normalize (Util.code text1) :: IO (Expr X X)
|
||||
assertEqual "Expressions are not equivalent" expr0 expr1
|
||||
|
||||
assertNormalizesTo :: Expr Src X -> Data.Text.Lazy.Text -> IO ()
|
||||
assertNormalizesTo e expected = do
|
||||
assertNormalizesTo :: Expr Src X -> Text -> IO ()
|
||||
assertNormalizesTo e expected = do
|
||||
assertBool msg (not $ Dhall.Core.isNormalized e)
|
||||
normalize' e @?= expected
|
||||
where msg = "Given expression is already in normal form"
|
||||
|
||||
assertNormalizesToWith :: Normalizer X -> Expr Src X -> Data.Text.Lazy.Text -> IO ()
|
||||
assertNormalizesToWith :: Normalizer X -> Expr Src X -> Text -> IO ()
|
||||
assertNormalizesToWith ctx e expected = do
|
||||
assertBool msg (not $ Dhall.Core.isNormalizedWith ctx (first (const ()) e))
|
||||
normalizeWith' ctx e @?= expected
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user